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)