|
DataMuseum.dkPresents historical artifacts from the history of: Q1 computer |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Q1 computer Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 10428 (0x28bc)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »COLTRANP«
└─⟦dbbef6eca⟧ Bits:30008596 DDMQ1-0028_DEMONSTRATION_DISK_LMC_SOURCE_Sept_77
└─⟦this⟧ »COLTRANP«
/* THIS IS A SOURCE LISTING FOR COLONIAL STOCK TRANSACTION LISTING 7/07/77 */
DCL 1 TRAN,
2 TDATE CHAR (6),
2 TCODE CHAR(1),
2 T# CHAR (5),
2 TITEM# CHAR (3),
2 TPART# CHAR (8),
2 TDESCRIPT CHAR (25),
2 TREF# CHAR (6),
2 TQUANTITY FIXED (5),
2 TBALANCE FIXED (6);
DCL 1 MATERIAL,
2 PART# CHAR(8),
2 DESCRIPT CHAR(25),
2 STOCK_ON_HAND FIXED(6),
2 LASTDATE CHAR(6),
2 FSCH(5) FIXED(5),
2 DEALPRICE(5) FIXED(5,2),
2 DIRPRICE(5) FIXED(5,2),
2 DIS FIXED(2),
2 UNITQTY BINARY;
DCL TFILE FILE,S# CHAR (1),S CHAR (1),A CHAR (1),SDATE CHAR (6),INVFILE FILE;
DCL BQUAN FIXED (11),BENTRY FIXED (11),CHITEM# CHAR (3),ADATE CHAR (6);
DCL PPDATE CHAR (8),PMONTH CHAR (2),PDATE CHAR (2),PYEAR CHAR(2),B CHAR (1);
DCL ATCODE CHAR(1),APART# CHAR(8),ADESCRIPT CHAR(25),DATE CHAR(6);
DCL SQUANTITY FIXED(6),CHT# CHAR(5),AITEM# CHAR(3),ATREF# CHAR(6);
START: OPEN TFILE;
PUT FILE (DISPLAY)SKIP LIST ('THIS IS A TRANSACTION LISTING PROGRAM');
PUT FILE (DISPLAY)LIST ('HAVE YOU SORTED TFILE ');GET SKIP LIST (A);
PUT FILE (DISPLAY) LIST (A);PUT FILE (DISPLAY)LIST(' ');
IF (A='N') THEN DO;CALL TYPIST ('SORT TFILE SCRATCH COLLIST┣0d┫',27);STOP;END;
IF (A¬='Y') THEN GOTO START;
CH: PUT FILE (DISPLAY) LIST (' DO YOU WANT TO CHANGE TFILE ? ');
GET SKIP LIST(A);PUT FILE (DISPLAY)LIST (A);
PUT FILE (DISPLAY)LIST (' ');IF (A='Y') THEN DO;OPEN INVFILE;
RECH: PUT FILE (DISPLAY) SKIP LIST ('DATE : ');GET SKIP LIST (TDATE);
IF (TDATE='END ') THEN GOTO START;PUT FILE (DISPLAY) LIST(TDATE);
PUT FILE (DISPLAY)LIST (' ');
PUT FILE (DISPLAY) LIST ('REF#1 : ');
GET SKIP LIST(CHT#);PUT FILE (DISPLAY) LIST (CHT#);
PUT FILE (DISPLAY)LIST (' ');
PUT FILE (DISPLAY)LIST ('ITEM# : ');GET SKIP LIST (CHITEM#);
PUT FILE (DISPLAY) LIST (CHITEM#);
PUT FILE (DISPLAY)LIST (' ');
PUT FILE (DISPLAY) LIST ('IS THE INFORMATION CORRECT ? ');GET SKIP LIST (A);
IF (A='N') THEN GOTO RECH;IF (A¬='Y') THEN GOTO RECH;
ON ERROR GOTO MESG;
READ KEY (TDATE) FILE (TFILE) INTO (TRAN);
IF (CHT#=T#)THEN GOTO RUP;ON ERROR GOTO MESG;
READ KEY (CHT#) FILE (TFILE)INTO (TRAN)KEYTO (T#);
RUP: IF TITEM#=CHITEM# THEN GOTO CHUP;ON ERROR GOTO MESG;
READ KEY (CHITEM#) FILE (TFILE) INTO (TRAN) KEYTO (TITEM#);
CHUP: PUT FILE (DISPLAY)SKIP LIST('DATE : ');GET SKIP LIST (ADATE);
IF (ADATE ¬=' ') THEN TDATE=ADATE;PUT FILE (DISPLAY)LIST(TDATE);
PUT FILE (DISPLAY) LIST (' ');
PUT FILE (DISPLAY)LIST('ITEM # : ');GET SKIP LIST(AITEM#);
IF AITEM#¬=' ' THEN TITEM#=AITEM#;PUT FILE(DISPLAY)LIST(TITEM#);
PUT FILE(DISPLAY)LIST(' REF# 1 : ');
GET SKIP LIST(CHT#);IF CHT#¬=' ' THEN T#=CHT#;PUT FILE(DISPLAY)LIST(T#);
PUT FILE(DISPLAY)LIST(' REF# 2 : ');
GET SKIP LIST(ATREF#);IF ATREF#¬=' ' THEN TREF#=ATREF#;
PUT FILE(DISPLAY)LIST(TREF#);PUT FILE(DISPLAY)LIST(' ');
PUT FILE (DISPLAY)LIST('PART# : ');
GET SKIP LIST (APART#); IF APART#¬=' ' THEN TPART#=APART#;
PUT FILE (DISPLAY)LIST(TPART#);PUT FILE(DISPLAY)LIST(' ');
PUT FILE (DISPLAY)LIST('DESCRIPT: ');GET SKIP LIST (ADESCRIPT);
IF ADES¬=' ' THEN DESCRIPT=ADES;
PUT FILE (DISPLAY)LIST(TDESCRIPT);
PUT FILE (DISPLAY)LIST (' ');
SQUANTITY=TQUANTITY;
PUT FILE (DISPLAY)LIST (' QUANTITY: ');
GET SKIP LIST (TQUANTITY); PUT FILE (DISPLAY) EDIT(TQUANTITY)(P'ZZ,ZZ9');
PUT FILE (DISPLAY)LIST (' ');
READ KEY(TPART#)FILE (INVFILE) INTO (MATERIAL);
IF SQUANTITY=TQUANTITY THEN GOTO HHCH;IF SQUANTITY>TQUANTITY THEN DO;
IF TCODE='1' THEN STOCK_ON_HAND=STOCK_ON_HAND + (SQUANTITY-TQUANTITY);
IF TCODE='2' THEN STOCK_ON_HAND=STOCK_ON_HAND - (SQUANTITY-TQUANTITY);
END; IF SQUANTITY<TQUANTITY THEN DO;
IF TCODE='1' THEN STOCK_ON_HAND=STOCK_ON_HAND - (TQUANTITY-SQUANTITY);
IF TCODE='2' THEN STOCK_ON_HAND=STOCK_ON_HAND + (TQUANTITY-SQUANTITY);
END;REWRITE FILE (INVFILE)FROM (MATERIAL); TBALANCE=STOCK_ON_HAND;
HHCH: REWRITE FILE(TFILE)FROM(TRAN);GOTO RECH;
MESG: PUT FILE (DISPLAY) SKIP LIST ('NO SUCH TRANSACTION! TRY AGAIN. ');
GET SKIP LIST ('');GOTO START;
END;
PUT FILE (DISPLAY)SKIP LIST('DO YOU WANT TO UPDATE THE DAILY ');
PUT FILE (DISPLAY)LIST('TRANSACTION ONTO THE HISTORY FILE ? ');
GET SKIP LIST (A);IF A='Y' THEN DO;
PUT FILE (DISPLAY) SKIP LIST('PUT HISTFL INTO DRIVE! ');GET SKIP LIST('');
CALL TYPIST('JOIN HISTFL TFILE CL ┣0d┫',22); STOP;END;
ASKALL: PUT FILE (DISPLAY) LIST (' DO YOU WANT ALL TO BE LISTED ? ');
GET SKIP LIST (A);IF (A='Y') THEN DO;S='1';GOTO PAPARR;END;
IF (A¬='N') THEN GOTO ASKALL;
PUT FILE (DISPLAY) LIST (A,' ');
PUT FILE (DISPLAY) LIST ('DATE OF TRANSACTION : ');GET SKIP LIST (DATE);
PUT FILE (DISPLAY) LIST (DATE);
PAPARR: PUT FILE (DISPLAY) LIST (' ARRANGE PAPER PLEASE ! ');
GET SKIP LIST ('');
TRPRINT: ON ENDFILE GOTO FINISH;READ FILE (TFILE) INTO (TRAN);
IF S¬='1' THEN DO;
IF (DATE¬=TDATE) THEN GOTO TRPRINT; END; SDATE=TDATE;
PMONTH=SUBSTR(TDATE,1,2);PDATE=SUBSTR(TDATE,3,2);PYEAR=SUBSTR(TDATE,5,2);
PPDATE=PMONTH CAT '/' CAT PDATE CAT '/' CAT PYEAR;
HEAD: PUT SKIP (3) LIST ('COLONIAL SYSTEMS STOCK TRANSACTION LISTING');
PUT LIST (' DATE: ',PPDATE);
PUT SKIP (3) LIST('T# IT# PART# REF#1 DESCRIPTION REF#2 ');
PUT LIST (' IN OUT BALANCE'); BQUAN=0;BENTRY=0;
TLST: PUT SKIP LIST (TCODE,' ',TITEM#,' ',TPART#,' ',T#,' ',TDESCRIPT);
BQUAN=TQUANTITY+BQUAN;BENTRY=BENTRY+1;
IF(TREF#='A')THEN DO;S#=SUBSTR(TREF#,1,1);TREF#=' ' CAT S# CAT ' ';END;
IF(TREF#='D')THEN DO;S#=SUBSTR(TREF#,1,1);TREF#=' ' CAT S# CAT ' ';END;
PUT LIST (TREF#,' ');
IF (TCODE='1') THEN DO;PUT LIST (' ');PUT EDIT (TQUANTITY)(P'ZZ,ZZ9');
END; IF (TCODE='2') THEN DO; PUT EDIT (TQUANTITY)(P'ZZ,ZZ9');
PUT LIST (' ');
END;IF (TCODE='3') THEN DO;IF (TREF#=' A ') THEN DO;
PUT EDIT (TQUANTITY)(P'ZZ,ZZ9');PUT LIST (' ');END;
IF(TREF#=' D ')THEN DO;PUT LIST (' ');PUT EDIT(TQUANTITY)(P'ZZ,ZZ9');
END;END; PUT LIST (' '); PUT EDIT (TBALANCE)(P'ZZZ,ZZ9');
ON ENDFILE GOTO FINISH;
READ FILE (TFILE) INTO (TRAN);
IF (S¬='1') THEN DO;
IF (DATE¬=TDATE) THEN GOTO FINISH;END;
IF (S='1')THEN DO;IF(TDATE¬=SDATE)THEN DO;PUT SKIP(3)LIST('TOTAL # OF ENTRY=');
PUT EDIT (BENTRY)(P'ZZ,ZZZ,ZZZ,ZZ9');
PUT LIST (' BATCH QUANTITY TOTAL= ');
PUT EDIT (BQUAN)(P'ZZ,ZZZ,ZZZ,ZZ9');
UNSPEC(TFILE)=UNSPEC(TFILE)-1; GOTO TRPRINT;END;END;GOTO TLST;
FINISH: PUT SKIP (3) LIST ('TOTAL # OF ENTRY= ');
PUT EDIT (BENTRY)(P'ZZ,ZZZ,ZZZ,ZZ9');
PUT LIST (' BATCH QUANTITY TOTAL= ');PUT EDIT (BQUAN)(P'ZZ,ZZZ,ZZZ,ZZ9');
PUT SKIP LIST ('');GOTO START;END;