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)