Listing of file='ACPA080A' on disk='vmedia/701-2654C.wvd.zip'
# Sector 354, program filename = 'ACPA080A' 0010 REM ACPA080A, RELEASE 2.1, (06/23/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 ACCOUNTS PAYABLE SYSTEM, VENDOR MASTER FILE MAINTENANCE MODULE 0040 REM PROGRAM FUNCTION = MAINTAIN RECORDS IN THE VENDOR MASTER FILE 0060 REM LAST REVISION = 06/23/80 0070 REM --------------------------------------------------------------- 0170 DIM I9$1 0197 DIM D9$19,D6$6 0198 GOTO 4000 3996 REM ********************************** 3997 REM ! VENDOR MASTER FILE MAINTENANCE ! 3998 REM ********************************** 3999 REM 4000 SELECT @PARTS0$ 4002 PRINT HEX(03);TAB(16);"VENDOR MASTER FILE MAINTENANCE" 4010 B6=21 : REM LONGEST ALPHA FIELD - LEFT SIDE 4015 C6=8 : REM LONGEST NUMERIC FIELD - LEFT SIDE 4030 G0=1 4035 C9=5 : REM NUMBER OF FIELDS ON THE LEFT SIDE 4036 C8=41 : REM START COLUMN - RIGHT SIDE 4040 REM CHECK AUDIT FILE SPACE 4070 LIMITS T#3,S$(3),Q6,Q7,Q8 4080 Q9=(Q8-2)/(Q7-Q6-1) 4090 IF Q9>.8 THEN PRINT AT(3,0);"Maintenance audit file is more than";INT (Q9*100);"% full." 4100 IF Q9<.95 THEN 4140 4110 GOSUB '254 4120 GOSUB '31 4130 REM ENTER VENDOR ID (KEY FIELD) 4140 GOSUB '238(1) 4150 GOSUB '100(" ",HEX(7F),Q0,0,"ENTER VENDOR ID. (OR END)",2) 4160 IF Q6$=HEX(1F) OR Q6$="END" OR Q6$="end"THEN GOSUB '31 4170 IF Q6$=" " THEN 4140 4180 GOSUB '96(4) : REM CONSTRUCT VENDOR ID 4190 A$=Q6$ 4200 PRINT AT(4,0,);TAB(10);"VENDOR ID - ";A$ 4210 REM TRANSACTION TYPE (ADD, CHANGE, DELETE) 4220 GOSUB '100("A,C,D","AaCcDdC ",1,1,"ENTER TRANSACTION TYPE (A,C, OR D) ",2) 4230 IF Q6$=HEX(1F) THEN GOSUB '31 4240 I9$=Q6$ 4250 Q6$="Add ChangeDelete" 4252 D6$=STR(Q6$,Q9*6-5,6) 4260 PRINT AT(4,0);D6$ 4270 IF I9$<>"A" THEN 4450 4280 REM %ADD A NEW VENDOR 4290 GOSUB '232(1,0,A$) : REM IS VENDOR ALREADY ON FILE? 4300 IF Q$="N" THEN 4330 4310 PRINT AT(3,0,80);HEX(07);"VENDOR ID is already in the vendor master f ile" 4320 GOTO 4140 4330 GOSUB '36 : REM CLEAR VENDOR FILE VARIABLES 4340 GOSUB '37 : REM DISPLAY ENTIRE RECORD 4350 GOSUB '32 : REM DATA ENTRY FOR ENTIRE RECORD 4360 GOSUB '33 : REM ITEM NO. CORRECTION ROUTINE 4370 GOSUB '233(1,1,A$,0) : REM FINDNEW 4380 GOSUB '91 : REM KFAM RETURN CODE CHECK 4390 IF J0>0 THEN 4140 4400 GOSUB '60(2) : REM WRITE VENDOR RECORD 4410 G5$(G0)="New vendor" 4420 GOSUB 4730 : REM WRITE AUDIT TRAIL 4430 GOTO 4140 : REM NEXT VENDOR 4440 REM %CHANGE/DELETE VENDOR INFORMATION 4450 GOSUB '232(1,1,A$) 4460 GOSUB '91 4470 IF J0>0 THEN 4140 4480 GOSUB '70(2) : REM READ VENDOR RECORD 4490 IF T7$=A$ THEN 4520 4500 PRINT AT(3,0,80);HEX(07);"Record ID in key file does not match the re cord ID from the master file" 4510 GOTO 4140 4520 GOSUB '37 : REM SCREEN DISPLAY 4530 IF I9$ = "D" THEN 4590 4540 GOSUB '33 : REM ITEM NO. CORRECTION ROUTINE 4550 DBACKSPACE #2,1S 4560 GOSUB '60(2) : REM REWRITE VENDOR RECORD 4570 GOTO 4140 4580 REM %DELETE A RECORD 4590 IF A2=0 THEN 4620 4600 PRINT AT(3,0,80);HEX(07);"Vendor cannot be deleted, balance is not ze ro" 4610 GOTO 4140 4620 GOSUB '100("Y,N","YyNn",1,1,"DELETE (Y OR N)",2) 4630 IF Q6$<>"Y"THEN 4140 4640 GOSUB '231(1,0,A$) : REM DELETE RECORD 4650 GOSUB '91 4660 IF J0>0 THEN 4140 4662 G5$(G0)="Deleted vendor" 4665 GOSUB 4730 : REM WRITE AUDIT TRAIL 4670 A$=HEX(FF) 4680 GOSUB '60(2) : REM REWRITE VENDOR RECORD 4710 GOTO 4140 4720 REM %BUILD & WRITE AUDIT FILE DATA 4730 G2$(G0)=" " 4740 G3$(G0)=A$ : REM SOMETHING TO IDENTIFY ADDS/DELETES 4750 G0$(G0)="8" & A$ : REM ALL TRANS TYPES - BUILD RECORD ID 4760 G1$(G0)=I9$ 4770 G0=G0+1 4780 IF G0<4 THEN RETURN 4790 GOSUB '49(3) : REM WRITE TO AUDIT FILE 4800 G0=1 4810 G0$()=ALL(FF) 4820 IF Q9<.95 THEN RETURN 4830 GOSUB '254 4840 REM %END OF PROGRAM 4850 DEFFN'31 4860 IF G0>1 THEN GOSUB '49(3) : REM WRITE REMAINING AUDIT RECORDS 4870 LOAD T M$ 6000 REM %^SUBROUTINES 6010 REM %INITIALIZE FILE VARIABLES 6020 DEFFN'36 6032 A1$,A2$,A3$,A4$,A5$,B4$,B1$()= " " 6034 A,A1,A2,A3,A0=0 6035 MAT A4 = ZER 6040 RETURN 6050 REM %DISPLAY ENTIRE RECORD 6060 DEFFN'37 6062 PRINT AT(4,0,80);TAB(5);"VENDOR ID. - ";A$;TAB(30);D6$;TAB(C8+6);"D IST ACCT";TAB(C8+22);" % DIST" 6070 PRINT AT(5,0,) 6080 G7=0 6090 I9=11 : REM NO. OF FIELDS 6100 FOR I=1TO I9 6110 GOSUB '35 : REM DISPLAY EACH FIELD 6120 NEXT I 6130 RETURN 6140 REM %ITEM NO. SELECT ROUTINE 6150 DEFFN'33 6160 CONVERT I9TO Q7$,(##) 6170 PRINT AT(1,0,80);"ENTER LINE NO. TO CORRECT (0=END, -1=VOID)"; 6180 GOSUB '100("-1",Q7$,2,0," ",1) 6190 IF Q6$ = HEX(1F) THEN GOSUB '31 6200 I,J9=Q9 6210 IF I=-1 THEN 6290 : REM VOID OPTION? 6220 IF I=0 THEN 6271 : REM END OF CORRECTIONS? 6239 Q7$=" " 6240 G7=G7+1 6250 GOSUB '35 6260 GOSUB 4750 : REM WRITE AUDIT TRAIL 6270 GOTO 6150 6271 S6=0 6272 FOR I=1 TO 6 6273 S6 = S6 + A4(I) : REM SUM PERCENTAGES 6274 NEXT I 6275 IF S6=100 OR S6=0 THEN RETURN : REM NEXT RECORD IF SUM IS 100 6276 PRINT AT(3,0,80); "The sum of G/L account percentages is not 100. Re -enter." : REM IF NOT THEN PRINT ERROR MESSAGE 6278 GOTO 6150 6280 REM VOID OPTION 6290 RETURN CLEAR 6300 IF I9$="A" OR G7=0 THEN 4140 6310 CONVERT MIN(G7,99) TO Q6$,(##) 6320 G2$(G0)=Q6$&" previous edits for" 6330 G3$(G0)="this vendor are void." 6340 GOSUB 4750 6350 GOTO 4140 6360 REM DATA ENTRY FOR NEW VENDOR 6370 DEFFN'32 6380 G7=1 6390 FOR I= 1 TO I9 6400 Q7$=" " 6410 GOSUB '35 6415 IF I>D9 AND B1$(D9)=" " THEN RETURN : REM EASY EXIT FROM ACCT.NO'S. 6420 NEXT I 6430 RETURN 6440 REM %GENERAL DATA ENTRY SUBROUTINE 6450 DEFFN'34(Q6$,Q9,G5$(G0),Q7$,Q$(1),Q$(2),Q3,Q4,Q5) 6460 IF G7>0THEN PRINT AT(1,0,80);"ENTER ";G5$(G0);Q7$ 6470 IF Q5<2 THEN GOSUB 6650 : REM AUDIT FILE FORMAT-NUMERICS 6480 G2$(G0)=Q6$ : REM SAVE OLD VALUE-AUDIT FILE 6490 IF Q6$>" " AND Q5=2 THEN Q5=3 : REM DEFAULT ALPHA IF NON-BLANK 6495 IF Q9<>0 AND Q5=1 THEN Q5=0 : REM DEFAULT FOR NUMERICS 6500 IF G7>0 THEN GOSUB '100(Q$(1),Q$(2),Q3,Q4," ",Q5) 6510 IF Q6$=HEX(1F) THEN GOSUB '31 6515 IF I>C9 AND D8=0 THEN GOSUB '96(5) 6520 IF Q5<2THEN GOSUB 6650 : REM AUDIT FILE FORMAT-NUMERICS 6530 G3$(G0)=Q6$ : REM SAVE NEW VALUE-ALPHA 6545 IF I>C9 THEN 6575 : REM RIGHT SIDE OF SCREEN? 6550 PRINT AT(I+5,0,C8); 6555 PRINTUSING "##) ";I; 6560 B8=C8-B6-2 6565 IF Q5<2 THEN B8=B8+C6-Q3 : REM NUMERIC? 6570 PRINT G5$(G0);TAB(B8+2);Q6$ 6572 RETURN 6575 PRINT AT(I+5-C9,C8); 6580 PRINTUSING "##) ";I; 6582 IF Q9=0 AND D8=1 AND I9$="A" THEN RETURN : REM INITIAL SCREEN BLANK 6584 IF D8=1 AND B1$(D9)=" " THEN Q6$=" " 6585 IF D8=0 THEN PRINT AT(I+5-C9,C8+6,9); STR(Q6$,,9) : ELSE PRINT AT(I+5-C9,C8+22,7); STR(Q6$,,7) : REM PRINT EITHER ACC. # OR % 6600 RETURN 6640 REM PUT NUMERIC VALUES INTO AUDIT FILE FORMAT 6650 Q6$=ALL("#") 6660 Q7$=STR(Q6$,,Q3) : REM PRINTUSING MASK-ALPHA 6670 IF Q4>0THEN Q7$=Q7$&"."&STR(Q6$,,Q4) : REM ANY DIGITS AFTER DECIMAL? 6675 Q7$=Q7$&"-" 6680 Q6$=ALL(00) 6690 PRINTUSING TO Q6$,Q7$,Q9 6700 Q6$=STR(Q6$,3,LEN(Q7$)) 6710 RETURN 6720 REM BRANCH TO THE APPROPRIATE SUBROUTINE FOR EACH FIELD 6730 DEFFN'35 6740 Q$=" " 6750 ON I GOSUB 6800,6810,6820,6830,6840,6850,6850,6850,6850,6850,6850 6760 IF Q$>" "THEN 6730 6770 RETURN 6780 REM %ACCEPT, VALIDATE, AND DISPLAY FILE VARIABLES 6790 REM MAKE '34 CALLS HERE 6800 GOSUB '34(A1$,0,"VENDOR NAME"," "," ",HEX(7F),21,0,2) 6801 A1$=Q6$ : RETURN 6810 GOSUB '34(A2$,0,"ADDRESS LINE 1"," "," ",HEX(7F),20,0,2) 6811 A2$=Q6$ : RETURN 6820 GOSUB '34(A3$,0,"ADDRESS LINE 2"," "," ",HEX(7F),20,0,2) 6821 A3$=Q6$ : RETURN 6830 GOSUB '34(A4$,0,"CITY/STATE"," "," ",HEX(7F),16,0,2) 6831 A4$=Q6$ : RETURN 6840 GOSUB '34(A5$,0,"ZIP CODE"," "," ",HEX(7F),5,0,2) 6841 A5$=Q6$ : RETURN 6849 REM ASK FOR CHART OF ACCT. ID 6850 D9=I-C9 : REM SUBSCRIPT FOR G/L ACCOUNT ITEMS 6851 D8=0 : REM SET D8 FOR '34 6853 CONVERT D9 TO STR(D9$,1,1),(#) : REM BUILD PROMPT 6854 Q6$="stndrdththth" 6855 STR(D9$,2,2)=STR(Q6$,2*D9-1,2) 6856 STR(D9$,4,16)=" DIST. ACCT. NO." : REM COMPLETE PROMPT 6859 GOSUB '34(B1$(D9),0,D9$," "," ",HEX(7F),VAL(Q0$(5)),0,2) 6860 IF G7=0 THEN 6891 : REM IF DISPLAY ONLY, SKIP VERIFICATION 6861 B1$(D9)=Q6$ 6862 IF STR(B1$(D9),,1)<>" " THEN 6873 : REM TEST FOR BLANK ACCT. NO. 6863 A4(D9)=0 : REM SET PERCENTAGE TO 0 FOR BLANK ID 6864 PRINT AT(I+5-C9,C8+22,7) : REM CLEAR PERCENTAGE DISPLAY 6865 RETURN 6873 GOSUB '232(2,0,B1$(D9)) : REM FINDOLD FOR THE ACCT. ID 6875 GOSUB '91 : REM CONVERT KFAM ERROR CODE TO NUMERIC 6877 IF J0<>0 THEN 6881 : REM ERROR MESSAGE IF KFAM ERROR 6878 GOSUB '75(5) : REM GET RECORD FROM CHART OF ACCT. FILE 6880 IF O1$="2" AND O3$<>"M" THEN 6891 : REM IF VALID ACCT, INPUT % 6881 PRINT AT(3,0,80);HEX(07);"Illegal account no., re-enter" 6882 B1$(D9)=" " : REM RESET ID TO BLANK 6884 GOTO 6859 6890 REM ASK FOR DIST. % 6891 D8=1 : REM SET SWITCH FOR '34 6893 STR(D9$,4,16)=" DISTRIBUTION % " 6894 GOSUB '34(" ",A4(D9),D9$," ","0","100.00",3,2,1) 6895 A4(D9)=Q9 6896 D8=0 6897 RETURN 8999 REM 9000 REM %^VARIABLES 9010 REM B6 = LONGEST ALPHA FIELD, LEFT SIDE OF SCREEN 9012 REM B7 = LONGEST ALPHA FIELD, RIGHT SIDE OF SCREEN 9014 REM B8 = SCREEN COLUMN NO. 9016 REM C6 = LONGEST NUMERIC FIELD, LEFT SIDE (DIGITS LEFT OF DECIMAL) 9018 REM C7 = LONGEST NUMERIC FIELD, RIGHT SIDE (DIGITS LEFT OF DECIMAL) 9022 REM G0 = COUNTER FOR AUDIT FILE - RECORDS IN A SECTOR 9024 REM G7 = 0 MEANS DISPLAY MODE, > 0 GIVES A COUNT OF CHANGES MADE 9028 REM I9 = NUMBER OF FIELDS 9030 REM A$ = KEY FIELD 9040 REM "VENDOR"& A$ = NAME/DESCRIPTION TO IDENTIFY ADDED/DELETED RECORDS 9070 REM 4 = SUBSCRIPT FOR Q0$() 9110 REM D9 = SUBSCRIPT FOR THE G/L ACCOUNT ITEMS; B4$( ) AND D4( ) 9115 REM D8 = SWITCH FOR G/L ACCOUNT ITEM; 0 FOR ACCOUNT NUMBER 1 FOR ACCOUNT PERCEN TAGE 9120 REM D9$ = PROMPT FOR G/L ACCOUNT ITEMS 9200 REM $ 9992 DEFFN'29"Q$=";HEX(22);"ACPA080A";HEX(22);":SCRATCH T Q$:SAVE T ()Q$";HEX (0D) 9999 DEFFN'30"DIM Z$57:IF STR(I0$,,1)=HEX(20)THENI0$=HEX(323135):Z$=";HEX(22); "GBS/MVP - MAINTAIN VENDOR MASTER FILE";HEX(22);":SELECT#15<I0$>:$OPEN#15 :SELECTLIST<I0$>(80): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':LISTZ$THEX(7A):$ CLOSE#15:SELECTLIST005(80)";HEX(0D)