image of READY prompt

Wang2200.org

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)