Listing of file='OREN120B' on disk='vmedia/701-2616C.wvd.zip'
# Sector 643, program filename = 'OREN120B' 0010 REM OREN120B, RELEASE 2.3, (12/11/80) THIS PROGRAM IS A COPYRIGHT PRODUCT OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED 0020 REM --------------------------------------------------------------------- -- 0030 REM SYSTEM & MODULE = GBS/MVP ORDER ENTRY SYSTEM, POST INVOICES 0040 REM PROGRAM FUNCTION = READ INVOICE TRANSACTION FILE & UPDATE OTHER FIL ES 0050 REM DATE WRITTEN = 07/07/78 0060 REM LAST REVISION = 12/10/80 MAF 0065 REM THIS PROGRAM WAS UPDATED TO RELEASE 2.1 BY ERRATA 1119 0066 REM THIS PROGRAM WAS UPDATED TO RELEASE 2.2 BY ERRATA 1130,1154,1162 0067 REM THIS PROGRAM WAS UPDATED TO 2.3 BY ERRATA 1187 0070 REM --------------------------------------------------------------------- -- 0170 DIM G6$1,J7$1,J8$1,J9$1,K1$2 0172 DIM K0$1,K6$4,K(13) 0174 DIM K7$(4)62,Z1$(1)2,Z1(1) 0198 GOTO 4000 3996 REM **************** 3997 REM ! UPDATE FILES ! 3998 REM **************** 3999 REM 4000 SELECT @PARTS0$ 4010 PRINT AT(1,0,) 4020 J9=1 4030 O3$(),G0$(),K7$()=ALL(FF) 4040 REM %SET-UP BACK ORDER KEY FILE VARIABLES 4050 DSKIP #9,END : ERRORGOTO 4060 4060 DBACKSPACE #9,1S 4070 DATA LOAD DC #9,O3$() 4080 MAT REDIM O3$(83)3 4090 MAT SEARCH O3$(),=HEX(FF)TO Q6$STEP 3 4100 J7=INT((VAL(Q6$,2)+2)/3) 4110 DBACKSPACE #9,1S 4120 IF J7>0 THEN 4170 4130 DSKIP #9,1S 4140 O3$()=ALL(FF) 4150 J7=1 4160 REM %PROCESS INVOICE HEADER RECORD 4170 GOSUB '235(1,0) : REM FIND FIRST INVOICE REC. 4180 GOSUB 7090 4190 GOTO 4240 4200 GOSUB '237(1,0) : REM FIND A HEADER RECORD 4210 J0=0 4220 IF Q$="E"THEN 6200 4230 GOSUB 7090 4240 GOSUB '54(1,1) : REM READ A HEADER RECORD 4250 K0$=A0$ : REM SAVE BACKORDER FLAG 4255 K6$ = STR(O2$,,3)&HEX(00) : REM SAVE ORDER NUMBER 4260 A6=A0 : REM SAVE ORDER TOTAL 4270 A0,A7=0 : REM CLEAR ORDER TOTAL 4280 UNPACK(########) STR(B$,,4)TO I5 4290 PRINT AT(5,0,80);"Processing invoice no. ";I5;HEX(06) 4300 I,N6,N7,N8=0 4310 J8=1 4320 J8$=" " 4330 IF I2$="0" OR I2$="2" THEN M6=1 : ELSE M6=-1 4340 IF I2$="2" OR I2$="3" THEN M7=0 : ELSE M7=M6 4350 K=0 4360 CONVERT D3TO Q6$,(######) 4370 U9$=STR(Q6$,,2)&"/"&STR(Q6$,3,2)&"/"&STR(Q6$,5) 4380 GOSUB '121(U9$) 4390 REM %PROCESS LINE ITEMS RECORDS 4400 GOSUB '237(1,0) : REM FIND LINE ITEMS RECORD 4410 GOSUB 7090 4420 GOSUB '54(1,2) : REM READ LINE ITEMS RECORD 4430 I=I+1 : REM INCREMENT RECORD COUNT 4440 K=K+1 : REM INCREMENT LINE COUNT 4450 IF P$(I)="END"THEN 5100 : REM END OF INVOICE? 4460 IF B(I)<B5(I)AND J9$=" " THEN GOSUB 7620 : REM WRITE SHIPPING SHORTAGE 4470 REM %UPDATE INVENTORY FILE 4480 GOSUB '232(6,1,P$(I)) : REM READ INVENTORY RECORD 4490 GOSUB 7020 4500 IF J0=7 THEN 4480 4510 IF J0=3 THEN GOSUB 7310 : ELSE IF J0>0 THEN 6150 4520 GOSUB '52(7) : REM READ INVENTORY RECORD 4530 N6=N6+B(I) : REM QUANTITIES 4540 N7=N7+ROUND((B(I)*B1(I)*B2(I)/100,2) : REM LINE DISCOUNTS 4550 N8=N8+F*B(I) : REM UNIT COSTS 4560 H0=U9 : REM LAST ACTIVITY DATE 4570 IF POS(F1$<>"Z")=0THEN 4640 : REM WASH ACCOUNT? 4580 E=E-B(I)*M7 : REM DECREMENT ON HAND 4590 Q9=MIN(B5(I),B(I))*M7 4600 E3=E3-Q9 : REM DECREMENT ALLOCATED 4610 IF K0$>HEX(00) THEN E2=E2-Q9 : REM DECREMENT BACKORDERED 4620 Q9=MAX(B5(I)-B(I),0)*M7 : REM ANY BACKORDERED AMOUNT? 4630 IF K0$=HEX(00) AND B0$(I)="B" THEN E2=E2+Q9 4635 IF B0$(I)<>"B" THEN D3(1)=D3(1)+Q9 4640 F3=F3+B(I)*F*M7 : REM UPDATE COST OF SALES 4650 H=H+B(I)*M7 : REM UPDATE UNITS SOLD 4660 H1=H1+B4(I)*M7 : REM UPDATE SALES DOLLARS 4670 DBACKSPACE #7,1S 4680 GOSUB '42(7) : REM REWRITE INVENTORY 4690 GOSUB '238(6) 4700 REM %BACK ORDER PROCESSING 4710 IF B0$(I) = " " THEN 5050 : REM IS B/O FLAG ON? 4715 IF J8$=" " AND O2$=HEX(FF)THEN GOSUB 8030 : REM INVOICE CREATES ORDER! 4720 J8$ = "1" : REM BACK ORDER SWITCH 4730 REM %MOVE INVOICE VARIABLES INTO OPEN ORDER VARIABLES 4740 C3$(J8) = P1$(I) : REM PRODUCT DESCRIPTION 4750 IF ABS(B(I))+ABS(B4(I))+ABS(B1(I))=0 THEN 4860 4760 C4$(J8) = I5$ : REM STOCK LOCATION CODE 4770 C5$(J8) = "0" : REM PRICE OVERRIDE 4780 D1$(J8) = C0$(I) : REM TAXABILITY 4790 D2$(J8) = D0$(I) : REM UNIT OF MEASURE 4800 C2(J8),C3(J8) = MAX(B5(I)-B(I),0) : REM QTY ORDERED, RELEASED 4810 C4(J8) = B2(I) : REM DISCOUNT % 4820 C5(J8) = B1(I) : REM UNIT PRICE 4830 Q9=C3(J8)*C5(J8) : REM PRICE EXTENSION 4840 D2(J8) = Q9 - ROUND((Q9*C4(J8)/100,2) : REM NET AMOUNT 4850 A7=A7+D2(J8) : REM ACCUMULATE ORDER TOTAL 4860 J8 = J8 + 1 : REM ADD TO OUTPUT COUNT 4870 C2$(J8-1) = P$(I) : REM PRODUCT ID 4880 IF J8 <= O0 AND P$(I) <> "END" THEN 5050 : REM END OF BLOCK/ORDER? 4890 $UNPACK(F=HEX(6001))STR(K6$,4,1)TO Q9 4892 $PACK (F=HEX(6001))STR(K6$,4,1)FROM Q9+1 4900 GOSUB '232(2,1,K6$) : REM READ LINE ITEMS RECORD 4910 IF Q$="N" THEN GOSUB '233(2,1,K6$,0) : REM CREATE NEW LINE ITEMS 4920 IF Q$>" " THEN GOSUB 7090 4930 O2$=K6$ : REM ORDER NO. 4940 GOSUB '47(3,2) : REM WRITE NEW LINE ITEMS 4950 GOSUB '238(2) 4960 J8=1 4970 REM CLEAR ORDER FILE VARIABLES 4980 C2$(),C3$(),C4$(),C5$(),D1$(),D2$()=" " 4990 MAT C2=ZER 5000 MAT C3=ZER 5010 MAT C4=ZER 5020 MAT C5=ZER 5030 MAT D2=ZER 5040 IF P$(I) = "END" THEN 5250 : REM END OF ORDER? 5050 IF I<N0THEN 4430 : REM NEW READ CHECK 5060 I=0 5070 GOTO 4400 5080 REM %END OF LINE ITEMS - CHECK FOR BACK ORDER, DELETE REMAINING LINES 5100 K1=1 5110 IF O2$=HEX(FF) THEN 5480 : REM INVOICE FROM INVOICING? 5120 IF J8$=" " THEN 5270 : REM NO BACK ORDER? 5130 IF J7$="1" THEN 4860 : REM IS BACKORDER FILE FULL? 5140 O3$(J7)=O2$ : REM SAVE BACK ORDER NO. 5150 J7=J7+1 5160 IF J7<=83 THEN 4860 5170 J7=1 5180 GOSUB '35(9,"Backorder keys") : REM CHECK FILE SPACE 5190 MAT REDIM O3$(3)83 5200 IF Q6$="F" THEN J7$="1" : ELSE DATA SAVE DC #9,O3$() 5210 MAT REDIM O3$(83)3 5220 O3$()=ALL(FF) 5230 GOTO 4860 : REM WRITE LAST RECORD 5240 REM %DELETE ALL OR PART OF THE ORDER 5250 K1=2 5260 HEXUNPACK STR(K6$,4,1) TO Z1$(1) 5261 CONVERT Z1$(1) TO Z1(1) : Z1(1)=Z1(1)+1 5262 CONVERT Z1(1) TO Z1$(1),(##) 5263 HEXPACK STR(K6$,4,1) FROM Z1$(1) 5270 GOSUB '231(2,0,K6$) 5280 GOSUB 7020 5290 ON J0 GOTO 5350,,5350 5300 IF J0>0 THEN 6150 5310 O2$=HEX(FF) 5320 GOSUB '47(3,K1) 5325 O2$=K6$ : REM RESTORE ORDER NUMBER 5330 GOTO 5250 5340 REM SET B/O KEY, READ & UPDATE B/O SUFFIX 5350 IF J8$=" " THEN 5480 5360 K6$ = STR(O2$,,3)&HEX(00) : REM B/O KEY 5370 GOSUB '232(2,1,K6$) : REM FIND HEADER 5390 GOSUB 7090 5400 GOSUB '57(3,1) : REM READ HEADER 5410 A0=A7 : REM SAVE ORDER TOTAL 5420 ADD(A0$,01) : REM UPDATE BACKORDER SUFFIX 5430 D4$(1)="N" : REM RESET CONF. FLAG 5440 DBACKSPACE #3,1S 5450 GOSUB '47(3,1) : REM REWRITE HEADER 5460 GOSUB '238(2) 5470 REM %INVOICE TOTALS RECORD 5480 GOSUB '237(1,0) : REM FIND A TOTALS RECORD 5490 GOSUB 7090 5500 GOSUB '54(1,3) : REM READ A TOTALS RECORD 5510 REM %UPDATE CUSTOMER FILE 5520 GOSUB '232(3,1,C1$) : REM READ CUSTOMER RECORD 5530 GOSUB 7090 5540 IF J0=7 THEN 5520 5550 GOSUB '50(4," ") 5560 P2=P2+N8*M7 : REM COST OF GOODS SOLD 5570 M=M+(A-A1)*M7 : REM SALES DOLLARS 5580 B=B+D1*M6 : REM A/R BALANCE 5590 P5=U9 : REM LAST TRANSACTION DATE 5600 C0=C0+A0-A6 : REM OUTSTANDING ORDER TOTAL 5610 DBACKSPACE #4,1S 5620 GOSUB '40(4," ") : REM REWRITE CUSTOMER RECORD 5630 GOSUB '238(3) 5640 REM %ACCUMULATE CONTROL FIELDS 5650 K(1)=K(1)+A*M7 : REM GROSS SALES 5660 K(2)=K(2)+N7*M7 : REM LINE ITEM DISCOUNTS 5670 K(3)=K(3)+A1*M6 : REM INVOICE DISCOUNTS 5680 CONVERT I2$ TO Q9 5690 IF Q9>0 THEN K(7-Q9)=K(7-Q9)+D1 : REM TOTALS BY INVOICE TYPE 5700 K(7)=K(7)+(G(1)+G(2)+G(3))*M6 : REM SALES TAXES 5710 K(8)=K(8)+A2*M6 : REM FREIGHT 5720 K(9)=K(9)+D*M6 : REM SPECIAL CHARGES/CREDITS 5730 K(10)=K(10)+N6*M7 : REM UNITS SHIPPED 5740 K(11)=K(11)+N8*M7 : REM COST OF GOODS SOLD 5750 K(12)=K(12)+1 : REM NO. OF INVOICES 5760 K(13)=K(13)+D1*M6 5770 REM %UPDATE A/R FILE 5780 K=0 5790 K1=I5 5800 CONVERT G0$ TO Q9 : ERRORQ9=-1 5810 IF I2$="1" THEN I2$="4" : REM CREDIT INVOICE 5820 IF I2$>"0" AND Q9>=0 THEN I5=Q9 : ELSE K1=0 5830 CONVERT KTO K1$,(##) 5840 $PACK(F=L2$)T7$FROM C1$,I5,I2$,K1$ 5850 K=K+1 5860 GOSUB '233(4,1,T7$,0) 5870 GOSUB 7020 5880 IF J0=4THEN 5830 : REM DUPLICATE KEY 5890 IF J0>0THEN 6150 5900 REM %WRITE A/R RECORD 5910 C1$(Q)=C1$ 5920 C(Q)=I5 5930 F$(Q)=I2$ 5940 H$(Q)=K1$ 5950 A$(Q),C$(Q)=" " 5960 C1(Q),A1(Q),A2(Q)=0 5970 D(Q)=K1 5980 D1(Q)=P5 5990 A(Q)=D1 6000 GOSUB '41(5,Q) 6010 GOSUB '238(4) 6020 REM %UPDATE SALESMAN FILE 6030 GOSUB '232(5,1,N4$) : REM FIND SALESMAN'S RECORD 6040 GOSUB 7020 6050 IF J0=7THEN 6030 6060 IF J0=3 THEN GOSUB 7140 : ELSE IF J0>0 THEN 6150 6070 GOSUB '53(6) : REM READ SALESMAN'S RECORD 6080 G=G+(A-A1)*M7 : REM UPDATE SALES DOLLARS 6090 G2=G2+N8*M7 : REM COST OF GOODS SOLD 6100 DBACKSPACE #6,1S 6110 GOSUB '43(6) : REM REWRITE RECORD 6120 GOSUB '238(5) 6130 GOTO 4200 : REM READ ANOTHER INVOICE 6140 REM %ERROR EXIT 6150 M$()="Invoice transaction Open order Customer master A/R Open item Salesman master Inventory master Backorder number s Shipping shortage Maintenance Audit" 6160 IF T6=INT(T6) AND T6>=1 AND T6<=9 THEN Q7$=STR(M$(),T6*20-19,20) 6170 IF J0>0 THEN PRINT AT(1,0,80);J$(J0);" - ";Q7$;" file" 6180 GOSUB '254 6190 REM %END OF PROGRAM 6200 GOSUB '35(11,"Maintenance audit") 6210 IF Q6$<>"F"AND G0>1 THEN GOSUB '49(11) 6220 MAT REDIM O3$(3)83 6230 DATA SAVE DC #9,O3$() 6240 GOSUB '218(S$(9),9," ",0) : REM BACK ORDER NO.S - EOF 6250 IF J9>1 THEN DATA SAVE DC #10,K7$() 6260 GOSUB '218(S$(10),10," ",0) : REM SHIPPING SHORTAGE FILE 6270 IF J0=0 THEN GOSUB 7830 : REM UPDATE CONTROL FILE 6280 LOAD TM$ 7000 REM %^SUBROUTINES 7010 REM KFAM CHECK 7020 IF J0=7 THEN $BREAK 255 7030 IF J0=7 AND Q$="B" THEN RETURN 7040 J$()=ALL(20) 7050 J$(7)="RECORD BUSY" 7060 IF Q$<>" "THEN GOSUB '91 : ELSE J0=0 7070 RETURN 7080 REM KFAM ERROR CHECK 7090 GOSUB 7020 7100 IF J0<>0AND J0<>7 THEN 6150 7110 IF J0=7 THEN $BREAK 255 7120 RETURN 7130 REM %SALESMAN ID ==> WASH ACCOUNT 7140 E$=ALL("Z") 7150 E1$="Wash account" 7160 G,G1,G2,G3=0 7170 E2$=" " 7180 G2$(G0)="Salesman" 7190 G3$(G0)=N4$ 7200 GOSUB '232(5,1,E$) 7210 IF Q$=" " THEN 7480 : REM SAVE AUDIT TRAIL 7220 GOSUB 7020 7230 IF J0=7 THEN 7140 7240 IF J0<>3 THEN 6150 7250 GOSUB '233(5,1,E$,0) : REM SET-UP WASH ACCOUNT 7260 IF Q$>" " THEN GOSUB 7090 7270 GOSUB '43(6) 7280 DBACKSPACE #6,1S 7290 GOTO 7480 : REM SAVE AUDIT TRAIL 7300 REM %PRODUCT ID ==> WASH ACCOUNT 7310 F1$=ALL("Z") 7320 F2$="Wash account" 7330 E0,E,E1,E2,E3,E4,E5,F,F1,H0,H,H1,H2,H3,H4,H5,H(1),H(2),H(3),D3(1),D3( 2),C3,B5=0 7340 B4=1 7350 F$,F3$,G2$,G3$,H4$,H5$,I5$=" " 7360 G2$(G0)="Inventory" 7370 G3$(G0)=P$(I) 7380 GOSUB '232(6,1,F1$) 7390 IF Q$=" " THEN 7480 : REM SAVE AUDIT TRAIL 7400 GOSUB 7020 7410 IF J0=7 THEN 7310 7420 IF J0<>3 THEN 6150 7430 GOSUB '233(6,1,F1$,0) : REM SET-UP WASH ACCOUNT 7440 IF Q$>" " THEN GOSUB 7090 7450 GOSUB '42(7) 7460 DBACKSPACE #7,1S 7470 REM %SAVE WASH ACCOUNT INFORMATION 7480 IF G6$="1" THEN RETURN : REM FILE FULL? 7490 G0$(G0)="6" 7500 CONVERT I5 TO STR(G0$(G0),2,8),(########) 7510 CONVERT K TO STR(G0$(G0),11),(##) 7520 G1$(G0)=" " 7530 G5$(G0)="Wash account" 7540 IF G0<4 THEN RETURN 7550 G0=G0+1 7560 GOSUB '35(11,"Maintenance audit") 7570 IF Q6$="F" THEN G6$="1" : ELSE GOSUB '49(11) 7580 G0$()=ALL(FF) 7590 G0=1 7600 RETURN 7610 REM %MOVE DATA TO SHIPPING SHORTAGE FILE FIELDS 7620 Q9=VAL(Q0$(2)) 7630 Q6$=HEX(A0)&BIN(Q9)&HEX(A0)&BIN(MIN(46-Q9,24))&HEX(A003A0016002600360 036203A001) 7640 $PACK(F=Q6$)K7$(J9)FROM P$(I),P1$(I),O2$,K0$,K,B5(I),B(I),B1(I),B0$(I ) 7650 J9=J9+1 7660 IF J9<5THEN RETURN 7670 GOSUB '35(10,"Shipping shortage") 7680 IF Q6$="F" THEN J9$="1" : ELSE DATA SAVE DC #10,K7$() 7690 K7$()=ALL(FF) 7700 J9=1 7710 RETURN 7720 REM %FILE FULL CHECK 7730 DEFFN'35(N,Q6$) 7750 LIMITS T#N,Q6,Q7,Q8 7760 IF Q7-Q8>3 THEN RETURN 7780 PRINT AT(1,0,80);S$(N);" file is full - remaining records will not be saved." 7790 GOSUB '254 7800 Q6$="F" 7810 RETURN 7820 REM %UPDATE CONTROL FILE 7830 GOSUB 7990 : REM READ SECTOR '000' 7840 REM CONTROL TOTALS 7850 N8=M(3) : REM OLD A/R BALANCE 7860 M(1)=Q1 : REM LAST DATE FILE UPDATED 7870 M(3),N8=N8+K(13) : REM NEW A/R BALANCE 7880 GOSUB '46(8,0,0) 7890 REM DAILY TOTALS 7900 GOSUB '46(8,Q1,1) 7910 FOR I=1TO 12 7920 M(I)=M(I)+K(I) : REM VARIOUS & SUNDRY TOTALS 7930 NEXT I 7940 M(16)=N8 : REM A/R BALANCE 7950 GOSUB '46(8,Q1,0) 7960 $CLOSE#8 7970 RETURN 7980 REM %OPEN CONTROL FILE 7990 $OPEN #8 8000 GOSUB '46(8,0,1) : REM READ SECTOR '000' 8010 RETURN 8020 REM %ACQUIRE ORDER NO. FROM CONTROL FILE, CREATE ORDER HEADER 8030 GOSUB 7990 : REM READ SECTOR '000' 8040 IF M(4)>999998 THEN M(4)=0 : REM RESET ORDER NO.? 8050 M(4)=M(4)+1 8060 GOSUB '46(8,0,0) : REM REWRITE SECTOR '000' 8070 $CLOSE#8 8080 PACK(########)O2$FROMM(4)*100 : REM ORDER NO. 8090 GOSUB '233(2,1,O2$,0) : REM FINDNEW, ORDER FILE 8095 GOSUB 7090 8100 K6$=O2$ 8110 D4$(2)="P" : REM SHIPPING PAPERS PRINT 8120 H3$,B5$()=" " : REM CREDIT HOLD, SALES TAX 8130 D0=0 : REM INVOICE DISCOUNT % 8140 GOSUB '47(3,1) 8150 DBACKSPACE #3,1S 8160 RETURN 9000 REM %^VARIABLES 9010 REM A6 = ORDER TOTAL (ORIGINAL AMOUNT) 9020 REM A7 = NEW ORDER TOTAL (ACCUMULATED FROM BACKORDERED ITEMS) 9030 REM D9$17 = A/R KEY FOR RECORD 9040 REM G6$1 = AUDIT FILE FULL FLAG 9050 REM J7 = BACKORDER NUMBERS OUTPUT COUNTER 9060 REM J7$1 = BACKORDER NUMBERS FILE FULL FLAG 9070 REM J8 = BACKORDER OUTPUT COUNTER 9080 REM J8$1 = BACK ORDER SWITCH 9090 REM J9 = SHIPPING SHORTAGE OUTPUT COUNTER 9100 REM J9$1 = SHIPPING SHORTAGE FILE FULL FLAG 9110 REM K = ITEM LINE NO. COUNTER/SEQUENCE NO. FOR A/R KEY 9120 REM K(13) = ACCUMULATED CONTROL FILE FIELDS 9130 REM K6$4 = KFAM KEY - OPEN ORDER FILE 9140 REM K7$(4)62 = SHIPPING SHORTAGE FILE - DISK BUFFER 9150 REM N6 = SUM OF QUANTITIES ON INVOICE 9160 REM N7 = SUM OF LINE ITEMS DISCOUNTS 9170 REM N8 = SUM OF UNIT COSTS 9180 REM $ 9998 DEFFN'29"Q$=";HEX(22);"OREN120B";HEX(22);":SCRATCH TQ$:SAVET$()Q$";HEX(0D ) 9999 DEFFN'30"DIM Z$57:IF STR(I0$,,1)=HEX(20)THENI0$=HEX(323135):Z$=";HEX(22); "GBS/MVP - Post invoices.";HEX(22);":SELECT#15<I0$>:$OPEN#15:SELECTLIST<I 0$>(132): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':$CLOSE#15:SELECTLIST005(80)" ;HEX(0D)