|
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: 27571 (0x6bb3)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »STAMNTA«
└─⟦934333717⟧ Bits:30008597 DDMQ1-0029_Demonstration_Disk_SOURCE_Single_Density_Sept_77
└─⟦this⟧ »STAMNTA«
/*DEMONSTRATION GENERAL LEDGER SYSTEM*/
/*MARCO*/
DCL 1 TRAN,
2 ACCT BINARY,
2 YEAR(13) BINARY,
2 MONTH(13) BINARY,
2 DAY(13) BINARY,
2 V#(13) BINARY,
2 V#1(13) BINARY,
2 AMT(13) FLOAT(9),
2 DES(13) CHAR(18);
DCL TRANFL FILE;
DCL NN CHAR(5);
DCL TDAY CHAR(8), NG FLOAT(9),
PDAY CHAR(8),N# CHAR(6),
DAYY CHAR(8),
DA(3) BINARY,
N FLOAT(2),
XN CHAR(2),
NO1 FLOAT(9),
ND FLOAT(3), REM FLOAT(2), CON(2) CHAR(1) INIT(' ','-'),
YYAR BINARY, VOU CHAR(8), VO CHAR(8), XA FLOAT(3),
VF FLOAT(8), XB FLOAT(3), XC FLOAT(3),
B50 CHAR(49) INIT(' '),
B10 CHAR(9) INIT(' '),
X CHAR(3), Q FLOAT(1), A CHAR(1), B CHAR(1), C CHAR(1),Y FLOAT(2),
D CHAR(1), E CHAR(1), FF CHAR(1),
DR FLOAT(9), CR FLOAT(9), CUDR FLOAT(9),
CUCR FLOAT(9), OPDR FLOAT(9), OPCR FLOAT(9),
NEDR FLOAT(9), NECR FLOAT(9), CLCR FLOAT(9),
CLDR FLOAT(9), NET FLOAT(9), CLBAL FLOAT(9);
FAN: PROCEDURE(IYAR);
DCL IYAR FLOAT(2), IQQ FLOAT(2);
IQQ=2; IF IYAR=0 THEN GO TO REFAN;
X=BööC; DR=X;
X=DööEööFF; CR=X;
IF V#(1)=DR & V#1(1)=CR THEN IQQ=1;
REFAN: RETURN(IQQ); END;
ROU: PROCEDURE; DCL STORE CHAR(4);
STORE=100+V#(1); B=SUBSTR(STORE,2,1);
C=SUBSTR(STORE,3,1); STORE=1000+V#1(1);
D=SUBSTR(STORE,2,1); E=SUBSTR(STORE,3,1);
FF=SUBSTR(STORE,4,1);
RETURN; END;
FUN: PROCEDURE(A1);
DCL A1 CHAR(1);
Q=2; A1='1';
RM: GET LIST(B,C,D,E,FF);
REM=((A1*6)+(B*5)+(C*4)+(D*3)+(E*2)+FF);
RS: IF REM<7 THEN GO TO REMAIN; REM=REM-7; GO TO RS;
REMAIN:IF REM¬=0 THEN GO TO ERR;
RT:Y=D*10+E;X=Y; ND=B*5+Y; ND=ND+1; Q=1;
GO TO CDY;
ERR: PUT FILE(DISPLAY) SKIP LIST('A/C NO. ERROR, TRY AGAIN');
GET SKIP LIST(X); Q=2; GO TO CDY;
CDY: RETURN(Q); END;
DATE: PROCEDURE(I1,I2,I3,DAT);
DCL I1 BINARY, I2 BINARY, I3 BINARY, DAT CHAR(8);
DAT=' / / '; INN=1; DA(1)=I1; DA(2)=I2; DA(3)=I3;
DO IN=1 TO 3;
N=DA(IN); XN=N;
IF LENGTH(XN)=1 THEN XN='0'ööN;
SUBSTR(DAT,INN,2)=XN;
INN=INN+3; END;
RETURN; END;
NUMD: PROCEDURE(NE);
DCL NE FLOAT(9);
NM=1; NO1=NE; IF NO1>=0 THEN GO TO OKK;
NM=2; NO1=NO1-NO1*2;
OKK: PUT FILE(DISPLAY) EDIT(NO1)(P'ZZZZZZZ9V.99') (CON(NM))(A(1));
RETURN; END;
NUM: PROCEDURE(NO);
DCL NO FLOAT(9);
NO1=NO; NM=1; IF NO1>=0 THEN GO TO OK;
NM=2; NO1=NO1-NO1*2;
OK: PUT LIST(' ');
PUT EDIT(NO1)(P'ZZZZZZZZZ9V.99') (CON(NM))(A(2));
RETURN;
END;
SEEOF: PROCEDURE(FL);
DCL FL(1) BINARY;
FL(1)=FL(6);
RETURN; END;ND=0; III=0; NEDR=0; NECR=0; CLDR=0;
ASK: PUT FILE(DISPLAY) SKIP LIST('DATE (DAY MONTH YEAR): ');
GET LIST(DAY(1),DAY(2),DAY(3));
IF DAY(1)>31 THEN GO TO ASK; IF DAY(2)>12 THEN GO TO ASK;
CALL DATE(DAY(1),DAY(2),DAY(3),TDAY);
OPEN TRANFL;
READ FILE (TRANFL) INTO (TRAN);
IF ACCT¬=0 THEN GO TO ST; IF SUBSTR(DES(1),1,8)¬=' TRANFL' THEN GO TO ST;
CALL DATE(DAY(2),MONTH(2),YEAR(2),PDAY);
MAIN: PUT FILE(DISPLAY) SKIP LIST('A)TRIAL BALANCE,');
PUT FILE(DISPLAY) LIST(' B)LEDGER PRINT OUT,');
PUT FILE(DISPLAY) LIST(' C)ENQUIRY OR');
PUT FILE(DISPLAY) LIST(' D)BALANCE SHEET:');
GET SKIP LIST(X);
IF SUBSTR(X,1,1)='A' THEN GO TO TRIAL;
IF SUBSTR(X,1,1)='B' THEN GO TO LED;
IF SUBSTR(X,1,1)='C' THEN GO TO ENQ;
IF SUBSTR(X,1,1)='D' THEN GO TO BS;
IF SUBSTR(X,1,3)='END' THEN GO TO STT;
GO TO MAIN;
TRIAL: OPEN TRANFL;
READ FILE(TRANFL) INTO (TRAN);
CUDR=0; CUCR=0; OPDR=0; OPCR=0; CLCR=0;
CLCR=0; MPG=0; CLDR=0; NEDR=0; NECR=0;
HEAD: MPG=MPG+1; K=56;
PUT SKIP EDIT(B50)(A(50)) (B10)(A(10));
PUT LIST(' A B C INT''L CORP'); DO I=1 TO 200; END;
PUT SKIP(2) EDIT(B50)(A(50))(B10)(A(10));
PUT EDIT(' TRIAL BALANCE')(A(20)); DO I=1 TO 200; END;
PUT SKIP(2); PUT LIST(' ');
PUT LIST(' DATE: ');
PUT EDIT(TDAY)(A(8))(B10)(A(10))(B10)(A(10))(B10)(A(10));
PUT LIST('PERIOD ENDING: ');
PUT EDIT(PDAY)(A(8))(B10)(A(10))(B10)(A(10))(B10)(A(10));
PUT LIST('PAGE: ');
PUT EDIT (MPG)(P'Z9');
XA=2; PUT SKIP(XA);
PUT SKIP LIST('ACCT# DESCRIPTION');
PUT EDIT(B10)(A(10));
PUT LIST(' OPENING BALANCE');
PUT LIST(' CURRENT DEBIT CURRENT CREDIT');
PUT LIST(' CURRENT NET CLOSING BALANCE');
XA=2; PUT SKIP(XA);
CALL SEEOF(TRANFL);
LAST=UNSPEC(TRANFL)-1;
OPEN TRANFL; READ FILE(TRANFL) INTO (TRAN);
AGA: IF UNSPEC(TRANFL)>LAST THEN GO TO FIN;
READ FILE(TRANFL) INTO (TRAN);
IF YEAR(1)=0 THEN GO TO AGA;
DR=0; CR=0; NET=0; CLBAL=AMT(1); M=DAY(1)-1;
IF M=1 THEN GO TO EXIT;
DO I=2 TO M;
IF AMT(I)>0 THEN DR=DR+AMT(I);
IF AMT(I)<0 THEN CR=CR-AMT(I);
END;
NET=DR-CR; CLBAL=AMT(1)+NET;
CUDR=CUDR+DR; CUCR=CUCR+CR;
IF NET>0 THEN NEDR=NEDR+NET;ELSE NECR=NECR+NET;
EXIT: IF AMT(1)>0 THEN OPDR=OPDR+AMT(1);
IF AMT(1)<0 THEN OPCR=OPCR+AMT(1);
IF CLBAL>0 THEN CLDR=CLDR+CLBAL;
IF CLBAL<0 THEN CLCR=CLCR+CLBAL;
CALL ROU;
PUT SKIP LIST('1');
NN=BööCööDööEööFF;PUT EDIT(NN)(A(6));
PUT LIST(' ');
PUT EDIT(DES(1))(A(19)); NG=AMT(1);
CALL NUM(NG);
CALL NUM(DR);CALL NUM(CR);
CALL NUM(NET);CALL NUM(CLBAL);
K=K-1; IF K<13 THEN GO TO HEAD;
GO TO AGA;
FIN: XA=2; PUT SKIP(XA);
PUT SKIP EDIT(B10)(A(10)); PUT LIST(' ');
PUT LIST('C/F ');
CALL NUM(OPDR); CALL NUM(CUDR);
CALL NUM(CUCR); CALL NUM(NEDR);
CALL NUM(CLDR);
PUT SKIP EDIT(B10)(A(10))(B10)(A(10))(B10)(A(10));
PUT LIST(' '); CALL NUM(OPCR);
PUT EDIT(B10)(A(10))(B10)(A(10))(B10)(A(10))(B10)(A(10));
PUT LIST(' ');
CALL NUM(NECR); CALL NUM(CLCR);
K=K-4; PUT SKIP(K);
GO TO MAIN;
LED: PUT FILE(DISPLAY) SKIP LIST('LEDGER PRINTOUT ACCOUNT NO.: ');
GET SKIP LIST(A);
IF A='E' THEN GO TO MAIN; IF A¬='1' THEN GO TO MAIN;
IF FUN(A)¬=1 THEN GO TO LED;
III=ND-1; UNSPEC(TRANFL)=III;READ FILE(TRANFL) INTO(TRAN);
IF FAN(YEAR(1))¬=1 THEN PUT SKIP LIST(YEAR(1));
DR=0; CR=0; CLBAL=AMT(1); CALL ROU;
PUT SKIP EDIT(B50)(A(50))(B10)(A(10));
PUT LIST(' A B C INT''L CORP');
PUT SKIP(2) EDIT(B10)(A(10))(B50)(A(50));
PUT LIST(' LEDGER PRINTOUT');
PUT SKIP(2) EDIT(B10)(A(10));
PUT LIST(' DATE: ');
PUT EDIT(TDAY)(A(9))(B10)(A(10))(B10)(A(10))(B10)(A(10));
PUT LIST('PERIOD ENDING: ');
PUT EDIT(PDAY)(A(9))(B10)(A(10))(B10)(A(10))(B10)(A(10));
PUT LIST('PAGE:1');
PUT SKIP(2)EDIT(B10)(A(10));
PUT LIST('ACCOUNT NO.: ','1');
NN=BööCööDööEööFF; PUT EDIT(NN)(A(6)); PUT LIST(' ');
PUT LIST('ACCOUNT NAME: ');
PUT EDIT(DES(1))(A(19));
PUT SKIP(2) EDIT (B10)(A(10));
PUT LIST('DATE VOUCHER ');
PUT LIST(' DESCRIPTION ');
PUT EDIT(B10)(A(10))(B10)(A(10));
PUT LIST(' BALANCE ');
PUT EDIT(B10)(A(10));
PUT LIST('DEBIT ');
PUT EDIT(B10)(A(10));
PUT LIST('CREDIT');
XA=2; PUT SKIP(XA);
PUT SKIP EDIT(B50)(A(50));
PUT LIST(' B/F');NG=AMT(1);
CALL NUM(NG);
M=DAY(1)-1; IF M=1 THEN GO TO ENL;
XA=2; PUT SKIP(XA);
DO I=2 TO M;
CALL DATE(DAY(I), MONTH(I),YEAR(I),DAYY);
VOU='0'ööVOU; VF=V#(I); VF=VF*250+V#1(I);
VO=VF; LL=LENGTH(VO); MM=9-LL;
SUBSTR(VOU,MM,LL)=VO;
PUT SKIP EDIT(B10)(A(10))(B10)(A(10));
PUT SKIP LIST(' ');
PUT EDIT(DAYY)(A(9));
PUT LIST(' ');
PUT EDIT(VOU)(A(9));
PUT LIST(' ');
PUT EDIT(DES(I))(A(19))(B10)(A(10))(B10)(A(10))(B10)(A(10));
PUT EDIT(B10)(A(10));
IF AMT(I)>0 THEN DR=DR+AMT(I);
IF AMT(I)<0 THEN DO JK=1 TO 1;
CR=CR-AMT(I); PUT EDIT(B10)(A(10))(B10)(A(10));
PUT LIST(' '); AMT(I)=AMT(I)-AMT(I)*2; END;
PUT EDIT(AMT(I))(P'ZZZZZZZ9V.99');
END;
CLBAL=AMT(1)+DR-CR;
GO TO CF;
ENL: PUT SKIP(2) EDIT(B50)(A(50));
PUT LIST(' NO TRANSACTION ');
CF: PUT SKIP(2) EDIT(B50)(A(50));
PUT LIST(' C/F');
CALL NUM(CLBAL); K=52-M;
PUT SKIP(K); GO TO LED;
ENQ: PUT FILE(DISPLAY) SKIP LIST('ENQUIRE ACCOUNT NO.: ');
GET SKIP LIST(A);
IF SUBSTR(A,1,1)='E' THEN GO TO MAIN;
IF FUN(A)¬=1 THEN GO TO ENQ;
III=ND-1; UNSPEC(TRANFL)=III; READ FILE(TRANFL) INTO(TRAN);
IF FAN(YEAR(1))¬=1 THEN GO TO ENQ;
M=DAY(1)-1; DR=0; CR=0; CLBAL=AMT(1);
IF M=1 THEN GO TO NOQ;
DO I=2 TO M;
IF AMT(I)>0 THEN DR=DR+AMT(I);
IF AMT(I)<0 THEN CR=CR-AMT(I);
END;
CLBAL=AMT(1)+DR-CR;
NOQ: PUT FILE(DISPLAY) SKIP LIST('ACCOUNT NO : ',A,B,C,D,E);
PUT FILE(DISPLAY) EDIT (FF)(A(13))('DESCRIPTION')(A(15))(':')(A(2))
(DES(1))(A(20));
PUT FILE(DISPLAY) LIST('OPENING BALANCE: '); NG=AMT(1);CALL NUMD(NG);
PUT FILE(DISPLAY) LIST(' CURRENT DEBIT : ');
CALL NUMD(DR); PUT FILE(DISPLAY) LIST(' CURRENT CREDIT : ');
CALL NUMD(CR); PUT FILE(DISPLAY) LIST(' CLOSING BALANCE: ');
CALL NUMD(CLBAL);
GET LIST(X);
IF SUBSTR(X,1,3)='END' THEN GO TO MAIN;
IF SUBSTR(X,1,1)='P' THEN GO TO PENQ;GO TO ENQ;
PENQ: CALL ROU; PUT SKIP LIST('1');
NN=BööCööDööEööFF; PUT EDIT(NN)(A(8));
PUT LIST(' '); PUT EDIT(DES(1))(A(18));
PUT LIST(' OPENING BALANCE: '); NG=AMT(1);
CALL NUM(NG);
PUT SKIP EDIT(B10)(A(10))(B10)(A(10))(B10)(A(10));
PUT LIST(' CURRENT DEBIT : ');
CALL NUM(DR);
PUT SKIP EDIT(B10)(A(10))(B10)(A(10))(B10)(A(10));
PUT LIST(' CURRENT CREDIT : ');
CALL NUM(CR);
PUT SKIP EDIT(B10)(A(10))(B10)(A(10))(B10)(A(10));
PUT LIST(' CLOSING BALANCE: ');
CALL NUM(CLBAL);
XA=2; PUT SKIP(XA); GO TO ENQ;
BS: CUDR=2; III=CUDR-1; UNSPEC(TRANFL)=III; OPDR=0; OPCR=0;
PUT SKIP EDIT(B10)(A(10))(B10)(A(10))(B10)(A(10));
PUT LIST(' A B C INT''L CORP');
PUT SKIP(2)EDIT(B10)(A(10))(B10)(A(10))(B10)(A(10));
PUT LIST(' BALANCE SHEET');
PUT SKIP(2) LIST(' DATE: ');
PUT EDIT(TDAY)(A(9))(B10)(A(10));
PUT LIST(' PERIOD ENDING: ');
PUT EDIT(PDAY)(A(9));
PUT SKIP(3) LIST(' DESCRIPTION ');
PUT EDIT(B10)(A(10))(B10)(A(10));
PUT LIST('ASSETS');
PUT EDIT(B10)(A(10));
PUT LIST(' LIABILITIES');
XB=3; PUT SKIP(XB);
AA: READ FILE(TRANFL) INTO(TRAN);
IF YEAR(1)=0 THEN GO TO AA;
IF V#(1)=40 THEN GO TO ENBS;
CLBAL=AMT(1); M=DAY(1)-1;
IF M=1 THEN GO TO ENPA;
DR=0; CR=0;
DO I=2 TO M;
IF AMT(I)>0 THEN DR=DR+AMT(I);
IF AMT(I)<0 THEN CR=CR-AMT(I);
END; CLBAL=AMT(1)+DR-CR;
ENPA: IF CLBAL>0 THEN OPDR=OPDR+CLBAL;
IF CLBAL<0 THEN OPCR=OPCR-CLBAL;
PUT SKIP LIST(' ');
PUT EDIT(DES(1))(A(19));
IF CLBAL<0 THEN DO I=1 TO 1;
CLBAL=CLBAL-CLBAL*2;PUT EDIT(B10)(A(10))(B10)(A(10));
PUT LIST(' '); END;
PUT EDIT(B10)(A(10))(CLBAL)(P'ZZZZZZZ9V.99');
GO TO AA;
ENBS: XA=2; PUT SKIP(XA); DR=0; CR=0;
PUT SKIP EDIT(B10)(A(10))(B10)(A(10))(B10)(A(10));
PUT LIST(' ');
PUT EDIT(OPDR)(P'ZZZZZZZ9V.99');
PUT LIST(' ');
PUT EDIT(B10)(A(10))(OPCR)(P'ZZZZZZZ9V.99');
CUDR=OPDR-OPCR;
IF CUDR>0 THEN DR=CUDR;
IF CUDR<0 THEN CR=CUDR-CUDR*2;
OPDR=OPDR+CR; OPCR=OPCR+DR;
PUT SKIP(2) LIST(' TO P & L ACCOUNT');
DR=CUDR; IF CUDR>0 THEN CUDR=CUDR-CUDR*2;
IF DR>0 THEN DO I=1 TO 1;
PUT EDIT(B10)(A(10))(B10)(A(10));
PUT LIST(' ');
END; PUT EDIT(B10)(A(10)) (CUDR)(P'ZZZZZZZZ9V.99');
PUT SKIP(2) EDIT(B10)(A(10))(B10)(A(10))(B10)(A(10));
PUT LIST(' ');
PUT EDIT(OPDR)(P'ZZZZZZZ9V.99');
PUT LIST(' ');
PUT EDIT(B10)(A(10)) (OPCR)(P'ZZZZZZZZ9V.99');
XC=39; PUT SKIP(XC); GO TO MAIN;
STT: PUT FILE(DISPLAY) SKIP LIST('READY FOR MONTHLY UPDATE? ');
GET SKIP LIST(X);
IF SUBSTR(X,1,1)='Y' THEN GO TO STS;
IF SUBSTR(X,1,1)='E' THEN GO TO ST;
GO TO STT;
STS: OPEN TRANFL;
CALL SEEOF(TRANFL);
LAST=UNSPEC(TRANFL)-1;
OPEN TRANFL; READ FILE(TRANFL) INTO (TRAN);
BB: IF UNSPEC(TRANFL)>LAST THEN GO TO ST;
READ FILE(TRANFL) INTO (TRAN);
IF YEAR(1)=0 THEN GO TO BB;
IF MONTH(1)=0 & DAY(1)=2 THEN GO TO BB;
M=DAY(1)-1; DR=0; CR=0;
DO I=2 TO M;
IF AMT(I)>0 THEN DR=DR+AMT(I);
IF AMT(I)<0 THEN CR=CR-AMT(I);
END;
AMT(1)=AMT(1)+DR-CR;
DAY(1)=2; MONTH(1)=0;
REWRITE FILE(TRANFL) FROM (TRAN);
GO TO BB;
ST: END;