Listing of file='SALE020A' on disk='vmedia/701-2616C.wvd.zip'
# Sector 761, program filename = 'SALE020A' 0010 REM SALE020A, 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 RECEIVABLE SYSTEM 0040 REM PROGRAM FUNCTION = MAINTAIN RECORDS IN THE SALESMAN MASTER FILE 0050 REM DATE WRITTEN = 06/20/79 CC 0060 REM LAST REVISION = 08/12/79 MK 0070 REM ----------------------------------------------------------------- 0170 DIM I9$1 0198 GOTO 4000 3996 REM ************************************ 3997 REM ! SALESMAN MASTER FILE MAINTENANCE ! 3998 REM ************************************ 3999 REM 4000 SELECT @PARTS0$ 4010 I9=2 : REM NO. OF FIELDS 4020 B6=24 : REM LONGEST FIELD - LEFT SIDE OF SCREEN 4030 C6=14 : REM MAX. DIGITS LEFT OF '.' - LEFT SIDE 4040 B7=14 : REM LONGEST FIELD - RIGHT SIDE OF SCREEN 4050 C7=6 : REM MAX. DIGITS LEFT OF '.' - RIGHT SIDE 4060 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 SALESMAN ID (KEY FIELD) 4140 GOSUB '238(1) 4150 GOSUB '100(" ",HEX(7F),Q0,0,"ENTER SALESMAN 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(3) : REM CONSTRUCT SALESMAN ID 4190 E$=Q6$ 4200 PRINT AT(4,0,);TAB(10);"SALESMAN ID - ";E$ 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" 4260 PRINT AT(4,0);STR(Q6$,Q9*6-5,6) 4270 IF I9$<>"A" THEN 4450 4280 REM %ADD A NEW SALESMAN 4290 GOSUB '232(1,0,E$) : REM IS SALESMAN ALREADY ON FILE? 4300 IF Q$="N" THEN 4330 4310 PRINT AT(3,0,80);HEX(07);"SALESMAN ID is already in the salesman mast er file" 4320 GOTO 4140 4330 GOSUB '36 : REM CLEAR SALESMAN 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,E$,0) : REM FINDNEW 4380 GOSUB '91 : REM KFAM RETURN CODE CHECK 4390 IF J0>0 THEN 4140 4400 GOSUB '43(2) : REM WRITE SALESMAN RECORD 4410 G5$(G0)="New salesman" 4420 GOSUB 4730 : REM WRITE AUDIT TRAIL 4430 GOTO 4140 4440 REM %CHANGE/DELETE SALESMAN INFORMATION 4450 GOSUB '232(1,1,E$) 4460 GOSUB '91 4470 IF J0>0 THEN 4140 4480 GOSUB '53(2) : REM READ SALESMAN RECORD 4490 IF T7$=E$ 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 '43(2) : REM REWRITE SALESMAN RECORD 4570 GOTO 4140 4580 REM %DELETE A RECORD 4590 IF ABS(G)+ABS(G2)=0 THEN 4620 4600 PRINT AT(3,0,80);HEX(07);"salesman cannot be deleted, sales total is not zero" 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,E$) : REM DELETE RECORD 4650 GOSUB '91 4660 IF J0>0 THEN 4140 4670 E$=HEX(FF) 4680 GOSUB '43(2) : REM REWRITE SALESMAN RECORD 4690 G5$(G0)="Deleted salesman" 4700 GOSUB 4730 4710 GOTO 4140 4720 REM %BUILD & WRITE AUDIT FILE DATA 4730 G2$(G0)=" " 4740 G3$(G0)="SALESMAN NAME" : REM SOMETHING TO IDENTIFY ADDS/DELETES 4750 G0$(G0)="3"&E$ : REM ALL TRANS TYPES - BUILD AUDIT 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 6030 REM CLEAR OUT \C1\CC\CC SALESMAN FILE VARIABLES HERE 6040 E1$,E2$= " " 6050 G,G1,G2,G3=0 6060 RETURN 6070 REM %DISPLAY ENTIRE RECORD 6080 DEFFN'37 6090 PRINT AT(5,0,) 6100 G7=0 6110 I9=2 : REM NO. OF FIELDS 6120 FOR I=1TO I9 6130 GOSUB '35 : REM DISPLAY EACH FIELD 6140 NEXT I 6150 RETURN 6160 REM %ITEM NO. SELECT ROUTINE 6170 DEFFN'33 6180 CONVERT I9TO Q7$,(##) 6190 PRINT AT(1,0,80);"ENTER LINE NUMBER T0 CORRECT (0=END, -1=VOID)"; 6200 GOSUB '100("-1",Q7$,2,0," ",1) 6210 IF Q6$ = HEX(1F) THEN GOSUB '31 6220 I,J9=Q9 6230 IF I=-1 THEN 6310 : REM VOID OPTION? 6240 IF I=0 THEN RETURN : REM END OF CORRECTIONS? 6250 Q7$=" " 6260 G7=G7+1 6270 GOSUB '35 6280 IF I9$="C"THEN GOSUB 4750 : REM WRITE AUDIT TRAIL 6290 GOTO 6170 6300 REM VOID OPTION 6310 RETURN CLEAR 6320 IF I9$="A" OR G7=0 THEN 4140 6330 CONVERT MIN(G7,99) TO Q6$,(##) 6340 G2$(G0)=Q6$&" PREVIOUS EDITS FOR" 6350 G3$(G0)="THIS SALESMAN ARE VOID" 6360 GOSUB 4750 6370 GOTO 4140 6380 REM %DATA ENTRY FOR NEW SALESMAN 6390 DEFFN'32 6400 G7=1 6410 FOR I=1TO I9 6420 Q7$=" " 6430 GOSUB '35 : REM DATA ENTRY/DISPLAY ROUTINE 6440 NEXT I 6450 RETURN 6460 REM %GENERAL DATA ENTRY SUBROUTINE 6470 DEFFN'34(Q6$,Q9,G5$(G0),Q$(1),Q$(2),Q3,Q4,Q5) 6480 IF G7>0THEN PRINT AT(1,0,80);"ENTER ";G5$(G0);Q7$ 6490 IF Q5<2 THEN GOSUB 6720 : REM RIGHT JUSTIFY NUMERICS 6500 G2$(G0)=Q6$ : REM SAVE OLD VALUE-AUDIT FILE 6510 IF Q6$>" " AND Q5=2 THEN Q5=3 : REM DEFAULT ALPHA IF NON-BLANK 6520 IF G7>0 THEN GOSUB '100(Q$(1),Q$(2),Q3,Q4," ",Q5) 6530 IF Q6$=HEX(1F) THEN GOSUB '31 6540 IF Q5<2 THEN GOSUB 6720 : REM RIGHT JUSTIFY NUMERICS 6550 G3$(G0)=Q6$ : REM SAVE NEW VALUE-ALPHA 6560 Q8=50 : REM START COLUMN - RIGHT SIDE 6570 Q2=INT(I9/2) 6580 %IF I>Q2 THEN 6551 : REM RIGHT SIDE OF SCREEN? 6590 PRINT AT(I+5,0,Q8); 6600 PRINTUSING "##) ";I; 6610 B8=Q8-B6-2 6620 IF Q5<2 THEN B8=B8+C6-Q3 : REM NUMERIC? 6630 GOTO 6680 6640 PRINT AT(I+5-Q2,Q8,80-Q8); 6650 PRINTUSING "##) ";I; 6660 B8=80-B7-2 6670 IF Q5<2 THEN B8=B8+C7-Q3 : REM NUMERIC? 6680 PRINT G5$(G0);TAB(B8);Q6$ : REM PRINT LABEL, VALUE 6690 RETURN 6700 RETURN 6710 REM RIGHT JUSTIFY NUMERICS FOR DISPLAY, AND FOR AUDIT FILE 6720 Q6$=ALL("#") 6730 Q7$=STR(Q6$,,Q3) : REM PRINTUSING MASK-ALPHA 6740 IF Q4>0THEN Q7$=Q7$&"."&STR(Q6$,,Q4) : REM ANY DIGITS AFTER DECIMAL? 6750 Q6$=ALL(00) 6760 PRINTUSING TO Q6$,Q7$,Q9 6770 Q6$=STR(Q6$,3,LEN(Q7$)) 6780 RETURN 6790 REM BRANCH TO THE APPROPRIATE SUBROUTINE FOR EACH FIELD 6800 DEFFN'35 6810 Q$=" " 6820 ON I GOSUB 6850,6880 6830 IF Q$>" " THEN 6800 6840 RETURN 6850 GOSUB '34(E1$,0,"SALESMAN NAME"," ",HEX(7F),24,0,2) 6860 E1$=Q6$ 6870 RETURN 6880 GOSUB '34(E2$,0,"TERRITORY"," ",HEX(7F),3,0,2) 6890 E2$=Q6$ 6900 RETURN 9000 REM %^VARIABLES 9010 REM B6 = LONGEST FIELD, LEFT SIDE OF SCREEN 9020 REM B7 = LONGEST FIELD, RIGHT SIDE OF SCREEN 9030 REM B8 = SCREEN COLUMN NO. - PRINT FIELD VALUE 9040 REM C6 = MAXIMUM NO. OF DIGITS LEFT OF DECIMAL, LEFT SIDE OF SCREEN 9050 REM C7 = MAXIMUM NO. OF DIGITS RIGHT OF DECIMAL, RIGHT SIDE OF SCREEN 9060 REM G0 = COUNTER FOR AUDIT FILE - RECORDS IN A SECTOR 9070 REM G7 = 0 MEANS DISPLAY MODE, > 0 GIVES A COUNT OF CHANGES MADE 9080 REM I9 = NUMBER OF FIELDS 9090 REM $ 9998 DEFFN'29"Q$=";HEX(22);"SALE020A";HEX(22);":SCRATCHTQ$:SAVET$()Q$";HEX(0D) 9999 DEFFN'30"DIM Z$57:IF STR(I0$,,1)=HEX(20)THENI0$=HEX(323135):Z$=";HEX(22); "GBS/MVP - Maintain salesman master file.";HEX(22);":SELECT#15<I0$>:$OPEN #15:SELECTLIST<I0$>(132): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':LISTZ$THEX(7 A):$CLOSE#15:SELECTLIST005(80)";HEX(0D)