Listing of file='GBS1020A' on disk='vmedia/701-2616C.wvd.zip'
# Sector 48, program filename = 'GBS1020A' 0010 REM GBS1020A, RELEASE 2.0, (06/01/79) THIS PROGRAM IS A COPYRIGHT PRODUCT OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED 0020 REM --------------------------------------------------------------------- 0030 REM SYSTEM & MODULE = GBS/MVP INVOICING SYSTEM, CLEAR FILES 0040 REM PROGRAM FUNCTION = CLEAR MONTHLY/Y-T-D FIGURES & OTHER FILE FIGURES 0050 REM DATE WRITTEN = 06/28/78 MK 0060 REM LAST REVISION = 08/12/79 MK 0070 REM --------------------------------------------------------------------- 0170 COM A6$8,A7$1,A8$(7)3,A8$6 0172 COM K3$1,K4$16,K5$21 0198 GOTO 4000 3996 REM ************** 3997 REM * CLEAR FILE * 3998 REM ************** 4000 Q=1 4010 LOAD T"KFAMOPEN"199,199BEG 4020 4020 SELECT @PARTS0$ 4030 A8$()=M$() 4040 A6$,A7$,K4$,K5$=" " 4050 REM SELECT FILE TO PROCESS 4060 PRINT AT(5,0,480);,"A = Customer master file" 4070 PRINT ,"B = Salesman master file" 4080 PRINT ,"C = Inventory master file" 4090 PRINT ,"D = GBS control file" 4100 PRINT ,"E = Return to menu" 4110 GOSUB '100("A,B,C,D,E","AaBbCcDdEe",1,1,"ENTER LETTER FOR SELECTED FIL E",2) 4120 IF Q6$=HEX(1F)THEN GOSUB '31 4130 K3$=Q6$ 4140 ON Q9GOTO 4160,4200,4240,4920,5760 4150 REM %SETUP FILE NAMES 4160 A6$=S$(2) 4170 A8$=A8$(1)&A8$(2) 4180 K4$="Customer master" 4190 GOTO 4280 4200 A6$=S$(6) 4210 A8$=A8$(5)&A8$(6) 4220 K4$="Salesman master" 4230 GOTO 4280 4240 A6$=S$(4) 4250 A8$=A8$(3)&A8$(4) 4260 K4$="Inventory master" 4270 REM PRINT ON CRT 4280 PRINT AT(5,0,);,"File = ";K4$ 4290 REM %CLEAR YEAR-TO-DATE? 4300 GOSUB '100("Y,N","YyNn",1,1,"CLEAR YEAR-TO-DATE (Y OR N)",2) 4310 IF Q6$=HEX(1F)THEN GOSUB '31 4320 A7$=Q6$ 4330 K5$="Monthly" 4340 IF Q6$="Y" THEN K5$=K5$&" & Y-T-D" 4350 PRINT AT(6,16);"Clear ";K5$;" figures." 4360 REM CHECK ENTRY 4370 GOSUB '100("Y,N","YyNn",1,1,"IS ENTRY OK (Y OR N)",2) 4380 IF Q6$=HEX(1F)THEN GOSUB '31 4390 IF Q6$="N"THEN 4040 4400 PRINT AT(7,16);"EXECUTING PROGRAM" 4410 REM %OPEN KFAM FILE 4420 SELECT #1<STR(A8$,,3)> 4430 SELECT #2<STR(A8$,4,3)> 4440 GOSUB '230(1,1,2,1,A6$,2," ",STR(A8$,,3),STR(A8$,4,3)) 4450 GOSUB 5700 : REM KFAM ERROR CHECK 4460 GOSUB '235(1,0) : REM FIND FIRST 4470 PRINT AT(7,16,64);"Processing record ID ";T7$;HEX(06) 4480 GOSUB 5700 : REM KFAM ERROR CHECK 4490 ON VAL(K3$)-64GOTO 4520,4620,4710 4500 GOTO 4900 4510 REM %CUSTOMER MASTER FILE 4520 IF STR(T7$,VAL(Q0$(1)),1)>" " THEN 4810 4530 GOSUB '50(2," ") 4540 P3=P3+P2 4550 M1=M1+M 4560 P2,M=0 4570 IF A7$="Y"THEN P3,M1=0 4580 DBACKSPACE #2,1S 4590 GOSUB '40(2," ") : REM REWRITE RECORD 4600 GOTO 4810 4610 REM %PROCESS SALESMAN MASTER FILE 4620 GOSUB '53(2) 4630 G1=G1+G 4640 G3=G3+G2 4650 G,G2=0 4660 IF A7$="Y"THEN G1,G3=0 4670 DBACKSPACE #2,1S 4680 GOSUB '43(2) : REM REWRITE RECORD 4690 GOTO 4810 4700 REM %PROCESS INVENTORY MASTER FILE 4710 GOSUB '52(2) 4720 H2=H2+H 4730 H4=H4+H1 4740 H3=H3+F3 4750 D3(2)=D3(2)+D3(1) 4760 H,H1,F3,D3(1)=0 4770 IF A7$="Y"THEN H2,H4,H3,D3(2)=0 4780 DBACKSPACE #2,1S 4790 GOSUB '42(2) : REM REWRITE RECORD 4800 REM %FINDNEXT 4810 GOSUB '237(1,0) 4820 IF Q$="E"THEN 4870 4830 GOSUB 5700 4840 PRINT AT(7,37,43);T7$ 4850 ON VAL(K3$)-64GOTO 4520,4620,4710 4860 GOTO 4900 4870 PRINT AT(5,0,240) 4880 GOSUB '239(1) 4890 GOSUB 5700 4900 GOTO 4040 4910 REM PROCESS GBS CONTROL FILE 4920 GOSUB '217(S$(7),7,S2,0,3," ",A8$(7),0) 4930 GOSUB 5700 : REM KFAM ERROR CHECK 4940 GOSUB '46(7,0,1) 4950 PRINT AT(5,0,);,"File = A/R Control" 4960 REM %RESET INVOICE NO.? 4970 GOSUB '100("Y,N","YyY Nn",1,1,"CLEAR/RESET INVOICE NO. (Y OR N)",2) 4980 IF Q6$=HEX(1F)THEN GOSUB '31 4990 IF Q6$="N"THEN 5110 5000 PRINT AT(6,0,80);,"RESET INVOICE NO." 5010 Q9=M(2) : REM SET DEFAULT VALUE 5020 GOSUB '100("0","99999899",8,0,"ENTER RESET VALUE FOR INVOICE NO.",0) 5030 IF Q6$=HEX(1F)THEN GOSUB '31 5040 K=Q9 5050 PRINT AT(6,34);"TO";K 5060 GOSUB '100("Y,N","YyY Nn",1,1,"IS ENTRY OK (Y OR N)",2) 5070 IF Q6$=HEX(1F)THEN GOSUB '31 5080 IF Q6$="N"THEN 4970 5090 GOSUB '36(2,K) : REM REWRITE CONTROL SECTOR 5100 REM RESET NON-REGULAR INVOICE NO.? 5110 GOSUB '100("Y,N","YyY Nn",1,1,"CLEAR/RESET NON-REGULAR INVOICE NO. (Y OR N)",2) 5120 IF Q6$=HEX(1F)THEN GOSUB '31 5130 IF Q6$="N"THEN 5260 5140 PRINT AT(6,0,80);,"RESET NON-REGULAR INVOICE NO." 5150 REM RESET NON-REGULAR INVOICE NO. 5160 Q9=M(5) : REM SET DEFAULT VALUE 5170 GOSUB '100("0","9999999",7,0,"ENTER RESET VALUE FOR NON-REGULAR INVOIC E NO.",0) 5180 IF Q6$=HEX(1F)THEN GOSUB '31 5190 K=Q9 5200 PRINT AT(6,46);"TO";K 5210 GOSUB '100("Y,N","YyY Nn",1,1,"IS ENTRY OK (Y OR N)",2) 5220 IF Q6$=HEX(1F)THEN GOSUB '31 5230 IF Q6$="N"THEN 5110 5240 GOSUB '36(5,K) : REM REWRITE CONTROL SECTOR 5250 REM CLEAR ORDER # QUESTION 5260 GOSUB '100("Y,N","YyY Nn",1,1,"CLEAR/RESET ORDER NO. (Y OR N)",2) 5270 IF Q6$=HEX(1F)THEN GOSUB '31 5280 IF Q6$="N"THEN 5490 5290 PRINT AT(6,0,80);,"RESET ORDER NO." 5300 Q9=M(4) : REM SET DEFAULT VALUE 5310 GOSUB '100("0","99999",5,0,"ENTER RESET VALUE FOR ORDER NO.",0) 5320 IF Q6$=HEX(1F)THEN GOSUB '31 5330 K=Q9 5340 REM CHECK FOR COMPLETE PRINTING OF ORDER REGISTER AND SHIPPING PAPERS 5350 IF M(9)<0 AND M(10)<0 THEN 5400 5360 PRINT AT(7,0,160) 5370 PRINT "Before order number can be changed, order register and shipping papers must be" 5380 PRINT "printed while no other terminal is performing order entry.";HEX (07) 5390 K=M(4) 5400 PRINT AT(6,32);"TO";K 5410 GOSUB '100("Y,N","YyY Nn",1,1,"IS ENTRY OK (Y OR N)",2) 5420 IF Q6$=HEX(1F)THEN GOSUB '31 5430 IF Q6$="N" THEN 5260 5440 GOSUB '36(4,K) : REM REWRITE CONTROL SECTOR - ORDER NO. 5450 GOSUB '36(9,K) : REM REWRITE CONTROL SECTOR - SPOOLER FLAG 5460 GOSUB '36(10,K) : REM REWRITE CONTROL SECTOR - SPOOLER FLAG 5470 PRINT AT(6,0,) 5480 REM CLEAR CONTROL TOTALS QUESTION 5490 GOSUB '100("Y,N","YyNn",1,1,"CLEAR CONTROL TOTALS (Y OR N)",2) 5500 IF Q6$=HEX(1F)THEN GOSUB '31 5510 IF Q6$="N" THEN 5670 5520 PRINT AT(6,0,80);,"CLEAR CONTROL TOTALS" 5530 REM CHECK ENTRY 5540 GOSUB '100("Y,N","YyNn",1,1,"IS ENTRY OK (Y OR N)",2) 5550 IF Q6$=HEX(1F)THEN GOSUB '31 5560 IF Q6$="N" THEN 5670 5570 PRINT AT(7,0);,"CLEARING SECTOR ";HEX(0D06) 5580 REM RESET CONTROL TOTALS 5590 $OPEN #7 5600 FOR I=1TO 366 5610 GOSUB '46(7,I,1) 5620 MAT M=ZER 5630 PRINT AT(7,32);I 5640 GOSUB '46(7,I,0) 5650 NEXT I 5660 $CLOSE#7 5670 GOSUB '219(S$(7),7,S2," ",0) 5680 GOTO 4900 5690 REM %KFAM ERROR CHECK 5700 GOSUB '91 5710 IF J0=0THEN RETURN 5720 REM ERROR DETECTED 5730 GOSUB '254 5740 GOSUB '239(1) 5750 REM END OF PROGRAM 5760 DEFFN'31 5770 SELECT #1<A8$(7)> 5780 DATA LOAD DC OPEN T#7,S$(7) 5790 GOSUB '219(S$(7),1,S2," ",0) 5800 COM CLEAR I 5810 LOAD TM$ 6000 REM %^SUBROUTINES 6010 REM %REWRITE CONTROL FILE - SECTOR '000' 6020 DEFFN'36(Q3,Q4) 6030 $OPEN #7 6040 GOSUB '46(7,0,1) 6050 M(Q3)=Q4 6060 GOSUB '46(7,0,0) 6070 $CLOSE#7 6080 RETURN 9000 REM %^VARIABLES 9010 REM A6$8 = STORAGE FOR FILE NAME 9020 REM A7$1 = STORAGE FOR YEAR-TO-DATE ANSWER 9030 REM K = RESET INVOICE # VALUE 9040 REM K3$1 = LETTER FOR SELECTED FILE TO PROCESS 9050 REM K4$16 = STORAGE FOR FILE NAME FOR PROMPT 9060 REM K5$16 = STORAGE FOR TYPE PROCESSING FOR PROMPT 9070 REM $ 9998 DEFFN'29"Q$=";HEX(22);"GBS1020A";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 - Clear file (end of month).";HEX(22);":SELECT#15<I0$>:$OPEN#15: SELECTLIST<I0$>(132): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':$CLOSE#15:SELECT LIST005(80)";HEX(0D)