image of READY prompt

Wang2200.org

Listing of file='ACPA090A' on disk='vmedia/701-2654C.wvd.zip'

# Sector 403, program filename = 'ACPA090A'
0010 REM ACPA090A, 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 ACCOUNTS PAYABLE SYSTEM,
                                     PRINT/DISPLAY VENDORS
0040 REM PROGRAM FUNCTION  =  DISPLAY AND/OR PRINT THE VENDOR MASTER FILE
0050 REM DATE WRITTEN      =  03/08/79
0060 REM LAST REVISION     =  04/16/79
0070 REM ---------------------------------------------------------------------
     --
0170     DIM A6$1,B6$1,C6$1,D6$8
0172     DIM K$1,K1$Q0,K2$Q0,K3$17
0198     GOTO 4000
3990 REM
3996 REM ************************************
3997 REM ! VENDOR MASTER FILE DISPLAY/PRINT !
3998 REM ************************************
3999 REM
4000     SELECT @PART S0$
4010 REM %PROGRAM CONSTANTS
4012     %##,###,###.##-
4014     %########  ###.###
4020     K2$=ALL(FF)
4030     A6$="N"
4040     B6$="Y"
4050     K,P1,K0=0
4060     L=L0
4070     D6,D7,D8,D9=0
   : REM INITIALIZE FINAL TOTALS
4080 REM %ACQUIRE REPORT OPTIONS
4090     GOSUB '100("Y,N","NnYyY ",1,1,"PRINT REPORT (Y OR N)",2)
4100     IF Q6$=HEX(1F) THEN GOSUB '31
4110     A6$=Q6$
   : REM SAVE 'PRINT' SWITCH
4120     IF A6$="Y" THEN 4150
4130     $CLOSE#15
4140     GOTO 4230
4150     GOSUB '93(" ")
   : REM IS PRINTER AVAILABLE?
4160     IF I0$=" "THEN A6$="N"
   : REM DID WE GET THE PRINTER?
4170 REM %SCREEN DISPLAY?
4180     GOSUB '100("Y,N","NnYyY ",1,1,"SCREEN DISPLAY (Y OR N)",2)
4190     IF Q6$=HEX(1F) THEN GOSUB '31
4200     B6$=Q6$
   : REM SAVE 'DISPLAY' SWITCH
4210     IF B6$="N" AND A6$="N" THEN 5230
   : REM NO PRINT, NO DISPLAY?
4220 REM %CHOOSE REPORT TYPE
4230     PRINT AT(5,0,);TAB(16);"A = Full report"
4240     PRINT TAB(16);"B = Condensed report"
4260     GOSUB '100("A,B","AaBb",1,1,"ENTER REPORT TYPE",2)
4270     IF Q6$=HEX(1F) THEN GOSUB '31
4280     C6$=Q6$
4290 REM %CHOOSE INQUIRY TYPE
4300     PRINT AT(5,0,)
4310     GOSUB '100("A,R,I","AaIiRr",1,1,"ENTER INQUIRY TYPE  (A=ALL, R=RANGE,
      I=INDIVIDUAL)",2)
4320     IF Q6$=HEX(1F) THEN GOSUB '31
4330     K$=Q6$
4340     Q6$="ALL       RANGE     INDIVIDUAL"
4350     K3$=STR(Q6$,Q9*10-9,10)
4360     K3$=K3$&" OPTION"
   : REM INITIALIZE CAPTION
4370     ON Q9GOTO ,4530,4440
   : REM BRANCH ON INQUIRY TYPE
4380 REM %ALL OPTION
4390     GOSUB '235(1,0)
   : REM ALL OPTION => FIND FIRST
4400     IF Q$="B" THEN 4000
4410     IF Q$>" "THEN 5320
4420     GOTO 4670
4430 REM %INDIVIDUAL OPTION
4440     GOSUB '34(HEX(08))
   : REM ACQUIRE INDIVIDUAL ID
4450     IF Q6$="END"THEN 5100
4460     K1$,K2$=Q6$
4470     GOSUB '232(1,0,K1$)
   : REM INDIVIDUAL => FIND OLD
4480     GOSUB '91
   : REM KFAM ERROR PROCESSING
4490     ON J0+1 GOTO 4670,,,4440,,,,4440
4500     GOTO 5320
4510 REM %RANGE OPTION
4520     PRINT AT(3,0,80);"Starting ID must be lower than Ending ID.";HEX(07)
4530     C6,C7,C8,C9,K=0
   : REM CLEAR RANGE TOTALS
4540     L=L0
4550     GOSUB '34("STARTING")
   : REM ACQUIRE STARTING ID
4560     IF Q6$="END"THEN 5100
4570     K1$=Q6$
4580     GOSUB '34("ENDING")
   : REM ACQUIRE ENDING ID
4590     K2$=ALL(FF)
4600     IF Q6$<>"END"THEN K2$=Q6$
4610     IF K1$>K2$ THEN 4520
   : REM STARTING ID > ENDING ID?
4620     GOSUB '232(1,0,K1$)
   : REM RANGE => STARTING POS.
4630     J$(3)=" "
4640     GOSUB '91
4650     ON J0 GOTO ,,4870,,,,4000
4660     IF J0>0 THEN 5320
4670     GOSUB '70(2)
   : REM READ VENDOR RECORD
4680     IF A$>K2$THEN 4820
   : REM OUT-OF-RANGE CHECK
4690 REM %CONVERT DATES
4700     K=K+1
   : REM NO. OF RECORDS PROCESSED
4710     GOSUB '123(A0)
   : REM CONVERT DATE
4720     D6$=U9$
4730 REM ACCUMULATE TOTALS
4740     IF C6$<>"C"THEN 4770
4750     K=K+1
   : REM INCREMENT RANGE COUNT
4751     C6=C6+A
4752     C7=C7+A1
4753     C8=C8+A3
4754     C9=C9+A2
4755     K0=K0+1
   : REM INCREMENT TOTAL COUNT
4756     D6=D6+A
4757     D7=D7+A1
4758     D8=D8+A3
4759     D9=D9+A2
4760 REM %DISPLAY/PRINT
4770     PRINT AT(5,0,)
4780     IF B6$="Y"THEN GOSUB 6402
   : ELSE PRINT "Processing record ID ";T7$
4790     IF A6$="Y"THEN GOSUB '90
4800     IF A6$="Y"THEN ON VAL(C6$)-64 GOSUB 6603,6654
4810     SELECT PRINT 005(80)
4820     IF K$="I"THEN 4440
   : REM ANOTHER INDIVIDUAL?
4830     IF A$>=K2$THEN 4950
   : REM END OF RANGE?
4840     IF B6$="Y"THEN GOSUB '254
   : REM PAUSE AFTER EACH SCREEN
4850     IF Q6$=HEX(1F)THEN GOSUB '31
4860 REM %PROCESS NEXT RECORD
4870     IF J0=7 THEN GOSUB '92
4880     GOSUB '237(1,0)
   : REM ALL/RANGE => FIND NEXT
4890     IF Q$=" " THEN 4670
4900     IF Q$="E" THEN 4950
4910     GOSUB '91
4920     IF J0=7THEN 4870
   : REM RECORD BUSY?
4930     GOTO 5320
   : REM FATAL KFAM ERROR
4940 REM %PRINT TOTALS
4950     IF A6$="N"AND K$="R"THEN 5090
   : REM ANOTHER RANGE?
4960     IF A6$="N"OR K$<>"R"THEN 5100
   : REM PRINT RANGE TOTALS?
4970     L=L+2
4980     GOSUB '90
4990     IF C6$<>"C"THEN 5060
5000     L=L+2
5010     GOSUB '90
5020     PRINT HEX(0A)
5030     A$=" "
5040     A1$="RANGE TOTAL"
5050     A=C6
   : A1=C7
   : A3=C8
   : A2=C9
   : REM PUT TOTALS IN PRINT VAR.
5052     GOSUB 6603
   : REM PRINT TOTALS
5060     PRINT HEX(0A)
5070     IF K>0 THEN PRINT "NO. OF RECORDS PROCESSED = ";K
5080     SELECT PRINT 005(80)
5090     GOTO 4530
5100     IF A6$="N" THEN 5230
5110     SELECT PRINT <I0$>(132)
5120     PRINT HEX(0A)
5130     IF C6$<>"C"THEN 5210
5140     L=L+3
5150     GOSUB '90
5160     PRINT HEX(0A)
5170     A$=" "
5180     A1$="FINAL TOTAL"
5190     A=D7
   : A1=D7
   : A3=D8
   : A2=D9
   : REM PUT TOTALS IN PRINT VAR.
5192     GOSUB 6603
   : REM PRINT TOTALS
5200     PRINT HEX(0A)
5210     PRINT HEX(0C)
5220 REM %RESTART/MENU
5230     SELECT PRINT 005(80)
5240     PRINT AT(1,0,)
5250     GOSUB '100("M,R","MmRr",1,1,"KEY R TO RESTART, M FOR MENU",2)
5260     IF Q6$=HEX(1F) THEN GOSUB '31
5270     IF Q6$="R"THEN 4000
5280 REM %END OF PROGRAM
5290     DEFFN '31
5300     LOAD TM$
5310 REM %KFAM ERROR PROCESSING
5320     GOSUB '91
5330     GOSUB '254
5340     GOTO 5290
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<L0THEN RETURN
   : REM LINE COUNT CHECK
6090     P1=P1+1
6100     PRINT HEX(0C0A0D0E);TAB(3);N2$
   : REM PRINT COMPANY NAME
6110     PRINT K3$;TAB(56);"VENDOR MASTER FILE";TAB(110);Q1$;TAB(122);"PAGE ";
     P1
6120     PRINT HEX(0A)
6130     L=7
6131     IF C6$="A" THEN 6137
6132     PRINT TAB(56);"(CONDENSED)"
6133     PRINT HEX(0A)
6134     PRINT TAB(30);"VENDOR #";TAB(41);"NAME"
6135     PRINT HEX(0A)
6136     RETURN
6137     PRINT TAB(56);"(COMPLETE)"
6138     PRINT HEX(0A)
6139     PRINT TAB(38);"--DISTRIBUTION--";TAB(66);"Y-T-D";TAB(77);"LAST YEAR";
     TAB(96);"Y-T-D";TAB(111);"GROSS";TAB(121);"DATE LAST"
6140     PRINT "VENDOR #";TAB(11);"NAME/ADDRESS";TAB(38);"ACCT NO";TAB(51);"%"
     ;TAB(63);"PURCHASE";TAB(78);"PURCHASE";TAB(93);"DISCOUNT";TAB(109);"BALAN
     CE";TAB(123);"PAYMENT"
6141     PRINT HEX(0A)
6142     L=L+1
6143     RETURN
6150 REM %ACQUIRE FILE ID
6160     DEFFN'34(Q7$)
6165     PRINT AT(4,0,80)
6170     PRINT AT(1,0,80);"ENTER ";Q7$;" VENDOR ID (OR END)"
6180     GOSUB '100(" ",HEX(7F),Q0,0," ",2)
6190     IF Q6$=HEX(1F) THEN GOSUB '31
6200     IF Q6$="end" THEN Q6$="END"
6210     IF Q6$="END"THEN RETURN
6220     GOSUB '96(4)
   : REM CONSTRUCT FILE ID
6230     RETURN
6300 REM %DISPLAY/PRINT VENDOR RECORDS
6400 REM --------------------
6401 REM SCREEN DISPLAY => CONDENSED PRINT
6402     PRINT "  VENDOR ID ";A$;TAB(40);"ACCT NO.";TAB(53);"%"
6403     MAT REDIM M$(6)40
6404     M$()=" "
6405     M$(1) = A1$
6406     M$(2) = A2$
6407     M$(3) = A3$
6408     M$(4) = A4$ & " " & A5$
6409     FOR I = 1 TO 6
6410        PRINT TAB(7);M$(I);TAB(40);
6411        IF B1$(I)<>" " THEN PRINTUSING 4014,B1$(I),A4(I);
6412        PRINT
6413     NEXT I
6414     PRINT TAB(7);"YEAR-TO-DATE PURCHASES";TAB(32);
6415     PRINTUSING 4012,A
6416     PRINT TAB(7);"LAST YEAR PURCHASES";TAB(32);
6417     PRINTUSING 4012,A1
6418     PRINT TAB(7);"CURRENT BALANCE";TAB(32);
6419     PRINTUSING 4012,A2
6420     PRINT TAB(7);"DISCOUNTS EARNED";TAB(32);
6421     PRINTUSING 4012,A3
6422     PRINT TAB(7);"LAST PAYMENT DATE";TAB(32);D6$
6423     MAT REDIM M$(4)62
6424     RETURN
6600 REM --------------------
6601 REM HARDCOPY REPORT
6603     PRINT TAB(3);A$;TAB(11);A1$;TAB(38);
6604     IF B1$(1)<>" "THEN PRINTUSING 4014,B1$(1),A4(1);
6605     PRINT TAB(58);
6606     IF A<>0THEN PRINTUSING 4012,A;
6607     PRINT TAB(73);
6608     IF A1<>0 THEN PRINTUSING 4012,A1;
6609     PRINT TAB(88);
6610     IF A3<>0 THEN PRINTUSING 4012,A3;
6611     PRINT TAB(103);
6612     IF A2<>0 THEN PRINTUSING 4012,A2;
6613     PRINT TAB(122);D6$
6614     IF A$=HEX(80)THEN RETURN
6615 REM SECONDARY LINES
6616     M$()=" "
6617     M$(2)=A2$
6618     M$(3)=A3$
6619     M$(4) = A4$ & " " & A5$
6620     FOR I=2TO 4
6621        PRINT TAB(11);M$(I);TAB(38);
6622        IF B1$(I)<>" "THEN PRINTUSING 4014,B1$(I),A4(I);
6623        PRINT
6624     NEXT I
6625     L=L+5
6626     FOR I=5TO 6
6627        L=L+1
6628        PRINT TAB(38);
6629        IF B1$(I)<>" "THEN PRINTUSING 4014,B1$(I),A4(I)
   : ELSE L=L-1
6630     NEXT I
6631     PRINT HEX(0A)
6632     RETURN
6650 REM --------------------
6652 REM CONDENSED PRINT
6654     PRINT TAB(33);A$;TAB(41);A1$
6656     L=L+1
6658     RETURN
8999 REM
9000 REM %VARIABLES
9010 REM A6$  = PRINT REPORT?
9020 REM B6$  = SCREEN DISPLAY?
9030 REM C6$  = REPORT TYPE
9040 REM D6$  = GREGORIAN DATE
9050 REM D7$  = GREGORIAN DATE
9060 REM  K0  = NO. OF RECORDS - FINAL TOTAL
9070 REM   K  = NO. OF RECORDS - RANGE TOTAL
9080 REM  K$  = INQUIRY TYPE
9090 REM K1$  = STARTING VENDOR ID
9100 REM K2$  = ENDING VENDOR ID
9110 REM K3$  = OPTION CAPTION
9120 REM  Q0  = LENGTH OF RECORD ID
9130 REM  Z0  = SUBSCRIPT FOR Q0$() - RECORD ID CONSTRUCTION PARAMETERS
9140 REM  Z$  = RECORD ID
9150 REM Z2$  = RECORD DESCRIPTION
9160 REM $
9992 DEFFN'29"Q$=";HEX(22);"ACPA090A";HEX(22);":SCRATCH TQ$:SAVE T$()Q$";HEX(0
     D)
9999 DEFFN'30"DIM Z$57:IF STR(I0$,,1)=HEX(20)THENI0$=HEX(323135):Z$=";HEX(22);
     "GBS/MVP - PRINT/DISPLAY VENDOR MASTER FILE";HEX(22);":SELECT#15<I0$>:$OP
     EN#15:SELECTLIST<I0$>(80): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':LISTZ$THEX(
     7A):$CLOSE#15:SELECTLIST005(80)";HEX(0D)