image of READY prompt

Wang2200.org

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)