image of READY prompt

Wang2200.org

Listing of file='GBS1010A' on disk='vmedia/701-2616C.wvd.zip'

# Sector 5, program filename = 'GBS1010A'
0010 REM GBS1010A, RELEASE 2.2, (09/15/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 INVOICING SYSTEM, CONTROL FILE INQUIRY/L
     IST
0040 REM PROGRAM FUNCTION  =  DISPLAY AND/OR PRINT THE CONTROL FILE
0050 REM DATE WRITTEN      =  03/08/79 MK
0060 REM LAST REVISION     =  09/15/80 TM
0065 REM THIS PROGRAM WAS UPGRADED TO 2.2 BY ERRATA 1166 + 1173
0070 REM ---------------------------------------------------------------------
     --
0170     DIM A6$1,B6$1,C6$1,D6$8,D7$5
0172     DIM K$1,K1$3,K2$3,K3$17
0174     DIM M6(17),M7(17)
0198     GOTO 4000
3990 REM
3996 REM *****************************
3997 REM ! CONTROL FILE INQUIRY/LIST !
3998 REM *****************************
3999 REM
4000     SELECT @PART S0$
4010 REM %PROGRAM CONSTANTS
4020     A6$="N"
4030     B6$="Y"
4040     K2=366
4050     K,K1,P1=0
4055     MAT M7=ZER
4060     L=L0
4070 REM %ACQUIRE REPORT OPTIONS
4080     GOSUB '100("Y,N","NnYyY ",1,1,"PRINT REPORT (Y OR N)",2)
4090     IF Q6$=HEX(1F) THEN GOSUB '31
4100     A6$=Q6$
   : REM SAVE 'PRINT' SWITCH
4110     IF A6$="Y"THEN 4140
4120     $CLOSE#15
   : REM RELEASE PRINTER
4130     GOTO 4220
4140     GOSUB '93(" ")
   : REM IS PRINTER AVAILABLE?
4150     IF I0$=" "THEN A6$="N"
   : REM DID WE GET THE PRINTER?
4160 REM %SCREEN DISPLAY?
4170     GOSUB '100("Y,N","NnYyY ",1,1,"SCREEN DISPLAY (Y OR N)",2)
4180     IF Q6$=HEX(1F) THEN GOSUB '31
4190     B6$=Q6$
   : REM SAVE 'DISPLAY' SWITCH
4200     IF B6$="N" AND A6$="N" THEN 4970
   : REM NO PRINT, NO DISPLAY?
4210 REM %CHOOSE INQUIRY TYPE
4220     PRINT AT(5,0,)
4230     GOSUB '100("A,R,I","AaIiRr",1,1,"ENTER INQUIRY TYPE  (A=ALL, R=RANGE,
      I=INDIVIDUAL)",2)
4240     IF Q6$=HEX(1F) THEN GOSUB '31
4250     K$=Q6$
4260     Q6$="ALL       RANGE     INDIVIDUAL"
4270     K3$=STR(Q6$,Q9*10-9,10)
4280     K3$=K3$&" OPTION"
   : REM INITIALIZE OPTION CAPTION
4290     ON Q9GOTO 4460,4370,4310
   : REM BRANCH BASED ON INQUIRY TYPE
4300 REM %INDIVIDUAL OPTION
4310     GOSUB '34(HEX(08),"(000,")
   : REM ACQUIRE DATE
4320     IF Q6$="END"THEN 4850
4330     K,K1,K2=Q9
4340     GOTO 4460
4350 REM %RANGE OPTION
4360     PRINT AT(3,0,80);"Starting date must be earlier than ending date.";HE
     X(07)
4370     MAT M6=ZER
4380     L=L0
4390     GOSUB '34("STARTING","(000,")
   : REM ACQUIRE STARTING DATE
4400     IF Q6$="END"THEN 4970
4410     K,K1=Q9
4420     K2=366
4430     GOSUB '34("ENDING","(")
   : REM ACQUIRE ENDING DATE
4440     IF Q6$<>"END"THEN K2=Q9
4445     IF K2=0 THEN 4360
4450     IF K2<K1 THEN 4360
   : REM STARTING DATE > ENDING DATE ?
4460     GOSUB '46(1,K,1)
   : REM READ CONTROL FILE
4470 REM %CONVERT DATES
4480     IF B6$="N"THEN PRINT AT(1,0,80);"PROCESSING DATE SECTOR ";K
4490     K=K+1
   : REM INCREMENT NO. OF RECORDS PROCESSED
4510     C6$="Y"
4520     IF MAX(M())=0 AND MIN(M())=0THEN C6$="N"
4530     IF C6$="N" AND B6$="N" THEN 4660
4535     IF K=1 THEN 4600
4540     GOSUB '123(INT(Q1/1E3)*1E3+K-1)
4550 REM ACCUMULATE TOTALS
4560     MAT M6=M6+M
4570     MAT M7=M7+M
4580     M6(16),M7(16)=0
4590 REM %DISPLAY/PRINT
4600     PRINT AT(4,0,)
4610     IF B6$="Y"THEN GOSUB 6320
4620     IF A6$="Y"THEN GOSUB '90
4630     L=L+1
4640     IF A6$="Y" AND C6$="Y" THEN GOSUB 6320
   : ELSE L=L-1
4650     SELECT PRINT 005(80)
4660     IF K$="I"THEN 4310
   : REM GET ANOTHER INDIVIDUAL RECORD?
4670     IF K-1>=K2 THEN 4730
   : REM END OF RANGE?
4680     IF B6$="Y"THEN GOSUB '254
   : REM PAUSE AFTER EACH SCREEN
4690     IF Q6$=HEX(1F)THEN GOSUB '31
4700 REM %PROCESS NEXT RECORD
4710     GOTO 4460
4720 REM %PRINT TOTALS
4730     IF A6$="N"AND K$="R"THEN 4370
4740     IF A6$="N"OR K$<>"R"THEN 4850
4750     GOSUB '90
4760     PRINT HEX(0A)
4770     U9$="RANGE"
4780     MAT M=M6
4790     U9=0
4800     GOSUB 6320
4810     PRINT HEX(0A)
4820     SELECT PRINT 005(80)
4830     GOTO 4370
   : REM ANOTHER RANGE
4840 REM INDIVIDUAL, ALL OPTIONS
4850     IF A6$="N" THEN 4970
4860     L=L0
4870     GOSUB '90
4880     PRINT HEX(0A)
4890     U9$="FINAL"
4900     MAT M=M7
4910     K=2
4920     U9=0
4930     GOSUB 6320
4940     MAT M7=ZER
4950     PRINT HEX(0C)
4960 REM %RESTART/MENU
4970     SELECT PRINT 005(80)
4980     PRINT AT(1,0,)
4990     GOSUB '100("M,R","MmRr",1,1,"KEY R TO RESTART, M FOR MENU",2)
5000     IF Q6$=HEX(1F) THEN GOSUB '31
5010     IF Q6$="R"THEN 4000
5020 REM %END OF PROGRAM
5030     DEFFN '31
5040     LOAD T M$
6000 REM %^SUBROUTINES
6010 REM %PAGE EJECT
6020     DEFFN'90
6030     Q6$=" "
6040     KEYIN Q6$,6050,6050
   : REM OPERATOR INTERRUPT CHECK
6050     IF Q6$="P" THEN GOSUB '254
6060     IF Q6$=HEX(1F) THEN GOSUB '31
6070     SELECT PRINT <I0$>(132)
6080     IF L<=4THEN RETURN
   : REM LINE COUNT CHECK
6090     P1=P1+1
6100     PRINT HEX(0C0A0E);TAB(3);N2$
   : REM PRINT TOP OF PAGE
6110     PRINT K3$;TAB(50);"CONTROL FILE";TAB(110);Q1$;TAB(122);"PAGE ";P1
6120     PRINT HEX(0A)
6130     L=0
6140     RETURN
6150 REM %ACQUIRE DATE
6160     DEFFN'34(D6$,D7$)
6170     Q9=0
6180     PRINT AT(1,0,80);"ENTER ";D6$;" DATE  ";D7$;"MM/DD/YY, END)"
6190     GOSUB '100(" ",HEX(7F),8,0," ",2)
6200     IF Q6$=HEX(1F) THEN GOSUB '31
6210     IF Q6$="end" THEN Q6$="END"
6220     IF Q6$="END" OR Q6$="000"THEN RETURN
6230     GOSUB '121(Q6$)
6240     Q9=MOD(U9,1E3)
6250     IF Q6$<>"E" THEN RETURN
6260     PRINT AT(3,0,80);HEX(07);"Invalid date, re-enter."
6270     GOTO 6160
6280    %###,###,###.##-
6290    %######-
6300    %###,###,###-
6310 REM CONTROL RECORD PRINT
6320     Q6=35
   : REM SECTOR '000' - NUMERICS
6330     Q7=16
   : REM LEFT COLUMN - NUMERIC FIELDS
6340     Q8=40
   : REM RIGHT COLUMN - FIELD LABELS
6350     Q9=58
   : REM RIGHT COLUMN - NUMERIC FIELDS
6360     IF K>1 THEN 6640
6370     PRINT "CONTROL RECORD"
6380     PRINT HEX(0A)
6390     PRINT "LAST JULIAN DATE USED";TAB(Q6);
6400     PRINTUSING 6290,M(1)
6410     PRINT "LAST INVOICE NO.";TAB(Q6);
6420     PRINTUSING 6290,M(2)
6430     PRINT "LAST NON-REG INVOICE NO.";TAB(Q6);
6440     PRINTUSING 6290,M(5)
6450     PRINT "LAST ORDER NO.";TAB(Q6);
6460     PRINTUSING 6290,M(4)
6470     PRINT "A/R BALANCE";TAB(Q6-6);
6480     PRINTUSING 6280,M(3)
6490     PRINT "INVOICES PRINTED CODE";TAB(Q6);
6500     PRINTUSING 6290,M(6)
6510     PRINT "INVOICE REGISTER PRINT CODE";TAB(Q6);
6520     PRINTUSING 6290,M(7)
6530     PRINT "SHIPPING REGISTER PRINT CODE";TAB(Q6);
6540     PRINTUSING 6290,M(8)
6550     PRINT "LAST ORDER NO. ON ORDER REGISTER";TAB(Q6);
6560     PRINTUSING 6290,M(9)
6570     PRINT "LAST ORDER NO. ON SHIP. PAPERS";TAB(Q6);
6580     PRINTUSING 6290,M(10)
6590     PRINT "CURRENT INVOICE TRANS FILE";TAB(Q6-3);
6600     IF M(11)=0 THEN PRINT "INVCF020"
   : ELSE PRINT "INVCF030"
6610     PRINT HEX(0A0A)
6620     RETURN
6630 REM DATA RECORD PRINT
6640     PRINT TAB(6);"DATE";TAB(Q7-1);U9$;TAB(Q8+5);
6650     IF U9>0 THEN PRINT "JULIAN DATE";TAB(Q9+1);U9;
6660     PRINT
6670     PRINT "GROSS SALES";TAB(Q7);
6680     IF M(1)<>0THEN PRINTUSING 6280,M(1);
6690 REM
6700     PRINT TAB(Q8);"LINE DISCOUNT";TAB(Q9);
6710     IF M(2)<>0THEN PRINTUSING 6280,M(2);
6720     PRINT
6730     PRINT "CREDIT INVOICE";TAB(Q7);
6740     IF M(6)<>0THEN PRINTUSING 6280,M(6);
6750 REM
6760     PRINT TAB(Q8);"INVOICE DISCOUNT";TAB(Q9);
6770     IF M(3)<>0THEN PRINTUSING 6280,M(3);
6780     PRINT
6790     PRINT "DEBIT MEMO";TAB(Q7);
6800     IF M(5)<>0THEN PRINTUSING 6280,M(5);
6810 REM
6820     PRINT TAB(Q8);"SALES TAXES";TAB(Q9);
6830     IF M(7)<>0THEN PRINTUSING 6280,M(7);
6840     PRINT
6850     PRINT "CREDIT MEMO";TAB(Q7);
6860     IF M(4)<>0THEN PRINTUSING 6280,M(4);
6870 REM
6880     PRINT TAB(Q8);"FREIGHT";TAB(Q9);
6890     IF M(8)<>0THEN PRINTUSING 6280,M(8);
6900     PRINT
6910     PRINT "NO. OF INVOICES";TAB(Q7);
6920     IF M(12)<>0THEN PRINTUSING 6300,M(12);
6930 REM
6940     PRINT TAB(Q8);"SPECIAL CHG/CR";TAB(Q9);
6950     IF M(9)<>0THEN PRINTUSING 6280,M(9);
6960     PRINT
6970     PRINT "UNITS SHIPPED";TAB(Q7);
6980     IF M(10)<>0THEN PRINTUSING 6300,M(10);
6990 REM
7000     PRINT TAB(Q8);"COST OF UNITS";TAB(Q9);
7010     IF M(11)<>0THEN PRINTUSING 6280,M(11);
7020     PRINT
7030     PRINT "A/R BALANCE";TAB(Q7);
7040     IF M(16)<>0THEN PRINTUSING 6280,M(16);
7050 REM
7060     PRINT TAB(Q8);"CASH RECEIVED";TAB(Q9);
7070     IF M(13)<>0THEN PRINTUSING 6280,M(13);
7080     PRINT
7090     PRINT "DISCOUNTS TAKEN";TAB(Q7);
7100     IF M(14)<>0THEN PRINTUSING 6280,M(14);
7110 REM
7120     PRINT TAB(Q8);"ALLOWANCES";TAB(Q9);
7130     IF M(15)<>0THEN PRINTUSING 6280,M(15);
7140     PRINT
7150     PRINT "NO. OF ORDERS";TAB(Q7);
7160     IF M(17)<>0THEN PRINTUSING 6300,M(17);
7170     PRINT
7180     PRINT HEX(0A)
7190     RETURN
9000 REM %^VARIABLES
9010 REM A6$  = PRINT REPORT?
9020 REM B6$  = SCREEN DISPLAY?
9030 REM C6$  = REPORT TYPE
9040 REM D6$  = PROMPT FOR DATE
9050 REM D7$  = PROMPT FOR DATE
9060 REM   K  = NO. OF RECORDS - RANGE TOTAL
9070 REM  K$  = INQUIRY TYPE
9080 REM K1$  = STARTING DATE
9090 REM K2$  = ENDING DATE
9100 REM K3$  = OPTION CAPTION
9110 REM M6(  = RANGE TOTALS
9120 REM M7(  = FINAL TOTALS
9130 REM $
9998 DEFFN'29"Q$=";HEX(22);"GBS1010A";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 - Display/print control file.";HEX(22);":SELECT#15<I0$>:$OPEN#15
     :SELECTLIST<I0$>(132): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':$CLOSE#15:SELEC
     TLIST005(80)";HEX(0D)