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)