|
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: 7505 (0x1d51)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »VERIFIN1«
└─⟦1f3202981⟧ Bits:30008731 DDMQ1-0173_MSAB_Bokföring_Alla_Program_i_PL1_ref_ex_780428
└─⟦this⟧ »VERIFIN1«
/*FÖRSTA RADEN*/
/*VERIFIN1 MANUELL INMATNING AV VERIFIKATIONER
KLART: 780602 FÖR MSAB PROGR:TD */
DCL VERFIL FILE;CALL KFILE(VERFIL);
DCL 1 VER,2 KO CHAR(4),2 AVD CHAR(2),2 DAT CHAR(4),
2 VERNR FIXED(5),2 VTX CHAR(20),2 BEL FIXED(11,2),2 KOD CHAR(1);
DCL 1 KTO,2 KONTO FIXED(4),2 TEXT CHAR(34);
DCL 1 DATREC,2 DAG CHAR(6),2 MON CHAR(3),2 MNR FIXED(2),2 SK(14) CHAR(1),
2 CO FIXED(1);
DCL 1 XDATREC,2 XDAG CHAR(9),2 XMNR FIXED(2),2 XSK(14) CHAR(1),2 XCO FIXED(1);
XDAG='XXXXXX ';XMNR=0;
DCL DATFIL FILE,KTOTX FILE,S CHAR(1),RAD FIXED(2),SIDA FIXED(4),IND FIXED(1),
SVAR CHAR(6),AD FIXED(13,2),AK FIXED(13,2),TD FIXED(13,2),TK FIXED(13,2),
KOSVAR CHAR(7),KOSVAR2 CHAR(13),POS FIXED(1);
OPEN KTOTX;OPEN DATFIL;OPEN VERFIL;CALL SEOF(VERFIL);
READ FILE(DATFIL)INTO(DATREC);IF DAG='XXXXXX' THEN GO TO SLUT;
IF MNR¬=SUBSTR(DAG,3,2) THEN GO TO SLUT;
DO I=1 TO 14;XSK(I)=SK(I);END;XSK(MNR)=' ';XCO=CO;
REWRITE FILE(DATFIL)FROM(XDATREC);
PUT FILE(D) SKIP EDIT(' ')(A(37))('** REGISTRERING AV VERIFIKATIONER **')
(A(74))('STÄLL IN PERFORERINGEN')(A(37))('TRYCK SEDAN RETURN.')(A(37));
GET SKIP LIST(S);PUT FILE(D) SKIP;
POS=0;RAD=5;SIDA=0;IND=1;AD=0;AK=0;TD=0;TK=0;DAT=SUBSTR(DAG,3,4);TYP='M';
RUB:SIDA=SIDA+1;PUT SKIP(RAD)EDIT('MANUELL REGISTRERING AV VERIFIKATIONER.')(A)
('AVSEENDE MÅNAD ')(A)(MON)(A(9))
('DATUM:')(A)(DAG)(A(10))('SIDA:')(A)(SIDA)(A)SKIP(2)EDIT
('VER.NR')(A(8))('KONTO')(A(9))('TEXT')(A(29))('DEBET')(A(15))
('KREDIT')(A)SKIP;RAD=45;
IF POS=1 THEN GO TO MER;
ST:POS=0;IF RAD<12 THEN GO TO RUB;TD=TD+AD;AD=0;TK=TK+AK;AK=0;
IF IND THEN DO;PUT FILE(D)SKIP EDIT('FÖRSTA VER.NR:')(A(31));
GET SKIP LIST(VERNR);END;
ELSE DO;PUT FILE(D)SKIP EDIT('VER.NR:')(A(37))('(OM LÖPANDE,TRYCK RETURN)')
(A(31));GET SKIP LIST(SVAR);IF SVAR='SLUT ' THEN GO TO UT;
IF VERIFY(SVAR,' 0123456789')=0 THEN GO TO ST;
IF SVAR=' ' THEN VERNR=VERNR+1;ELSE VERNR=SVAR;END;
IF VERNR<1 THEN GO TO ST;IND=0;
PUT SKIP EDIT(VERNR)(P'ZZZZZ9',X(3));RAD=RAD-1;
MER:POS=1;IF RAD<12 THEN GO TO RUB;
PUT FILE(D)SKIP EDIT('VERNR:')(A(7))(VERNR)(P'ZZZZZ9',X(24));
IF AD-AK=0 THEN DO;PUT FILE(D)EDIT('TEXT:')(A(17));GET SKIP LIST(VTX);
PUT FILE(D)EDIT(VTX)(A(20));END;PUT FILE(D)EDIT('KONTO.AVD:')(A(25));
GET SKIP LIST(KOSVAR);
KOIN:PUT FILE(D) EDIT(KOSVAR)(A(12));
J=INDEX(KOSVAR,'.');KO=SUBSTR(KOSVAR,1,J-1);
IF SUBSTR(KOSVAR,4,1)=' ' THEN GO TO FELKOD;
IF J=0&SUBSTR(KOSVAR,5,3)¬=' ' THEN GO TO FELKOD;
IF J=0 THEN GO TO X1;IF J¬=5 THEN GO TO FELKOD;
AVD=SUBSTR(KOSVAR,6,2);
GO TO NY;
X1:AVD=' ';KO=SUBSTR(KOSVAR,1,4);
NY:
KTOIN:IF VERIFY(SUBSTR(KOSVAR,1,4),'0123456789')=0 THEN GO TO FELKO;
KONTO=KO;
ON ERROR GO TO FELKO;READ KEY(KONTO)FILE(KTOTX)INTO(KTO);
KTOOK:PUT FILE(D)SKIP EDIT('VER.NR:')(A(31))(VERNR)(P'ZZZZZ9')('TEXT:')(A(17))
(VTX)(A(20))('DIFF')
(A(24))(AD-AK)(P'---------9V.99')('KONTO')(A(25))(KOSVAR)(A(12))
('BELOPP (K7 FÖR DEB, K6 FÖR KRE) :')(A(61));
BELIN:GET SKIP LIST(BEL);CALL KEYFUN(I);
IF I=139 THEN DO;AD=AD+BEL;KOD='D';END;IF I=138 THEN DO;AK=AK+BEL;KOD='K';END;
IF(I¬=138)&(I¬=139) THEN GO TO BELIN;
PUT FILE(D)SKIP;
PUT EDIT(KO)(A(4))(AVD)(A(4))(VTX)(A(21));
IF I=138 THEN PUT EDIT(' ')(A(16));
PUT EDIT(BEL)(P'---------9V.99')SKIP EDIT(' ')(A(9));RAD=RAD-1;
WRITE FILE(VERFIL)FROM(VER);
IF AD-AK¬=0 THEN GO TO MER;
CLOSE VERFIL;OPEN VERFIL;CALL SEOF(VERFIL);GO TO ST;
FELKO:CALL OUTPUT(1,6);
PUT FILE(D) SKIP EDIT('KONTO ')(A)(KO)(A(5))('FINNS EJ.')(A(26))
('ANGE RÄTT KONTO.AVD')(A(37))('ELLER SVARA "NYTT":')(A(25));
GET SKIP LIST(KOSVAR2);
IF SUBSTR(KOSVAR2,1,2)='NY' THEN GO TO NYKO;
KOSVAR=KOSVAR2;GO TO KOIN;
FELKOD:CALL OUTPUT(1,6);
PUT FILE(D) SKIP EDIT(KOSVAR)(A(8))('ÄR EN FELAKTIG KOD!')(A(29))
('FÖRSÖK IGEN:')(A(25));
GET SKIP LIST(KOSVAR);GO TO KOIN;
NYKO:PUT FILE(D)SKIP EDIT('KONTO:')(A(33))(KO)(A(4))('TEXT:')(A(40));
GET SKIP LIST(TEXT);
PUT FILE(D)SKIP;
KONTO=KO;
CALL SEOF(KTOTX);WRITE FILE(KTOTX)FROM(KTO);CLOSE KTOTX;OPEN KTOTX;
XSK(14)=' ';REWRITE FILE(DATFIL) FROM(XDATREC);GO TO KTOOK;
UT:PUT SKIP(2)EDIT('TOTALT ALLA TRANSAKTIONER:')(A(36))(TD)
(P'-----------9V.99')(TK)(P'------------9V.99',X(6))('DIFF:')(A)
(TD-TK)(P'---------9V.99')SKIP(RAD-7);
SLUT:CALL LOAD('BOKRUT',6);END;