|
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: 7979 (0x1f2b)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »VERIFIN1«
└─⟦2d3ae9df8⟧ Bits:30008654 DDMQ1-0094_Nya_bokforingssystemet_I_LMC_MSAB_COPY_Skriv_BOKRUT_780220_TD
└─⟦this⟧ »VERIFIN1«
/*FÖRSTA RADEN*/
/*VERIFIN1 MANUELL INMATNING AV VERIFIKATIONER
KLART: XXXXXX PROGR:TD */
DCL VERFIL FILE;CALL KFILE(VERFIL);
DCL 1 VER,2 KO FIXED(4),2 AVD FIXED(2),2 PROJ FIXED(4),2 DAT FIXED(4),
2 TYP CHAR(1),2 VERNR FIXED(6),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);
DCL 1 XDATREC,2 XDAG CHAR(9),2 XMNR FIXED(2),2 XSK(14) CHAR(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(12,2),AK FIXED(12,2),TD FIXED(13,2),TK FIXED(13,2),
KOSVAR CHAR(13),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)=' ';
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(7))('AVD.')(A(6))('PROJ.NR')(A(17))('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))
('KONTO.AVD.PROJ:')(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,9)¬=' ' THEN GO TO FELKOD;
IF J=0 THEN GO TO X1;IF J¬=5 THEN GO TO FELKOD;
SUBSTR(KOSVAR,J,1)=' ';K=INDEX(KOSVAR,'.');SUBSTR(KOSVAR,J,1)='.';
IF K=0 & SUBSTR(KOSVAR,8,6)¬=' ' THEN GO TO FELKOD;
IF SUBSTR(KOSVAR,13,1)¬=' ' THEN GO TO FELKOD;
IF K=0 THEN GO TO X2;
AVD=SUBSTR(KOSVAR,J+1,K-1);IF (K-J)>3ö(K-J)<2 THEN GO TO FELKOD;
PROJ=SUBSTR(KOSVAR,K+1,4);
GO TO NY;
X1:AVD=0;KO=SUBSTR(KOSVAR,1,4);
X2:PROJ=0;IF J THEN AVD=SUBSTR(KOSVAR,J+1,2);ELSE AVD=0;
IF AVD<0 THEN GO TO FELKOD;
NY:IF(KO<3000&KO¬=1210)&(AVD¬=0öPROJ¬=0)THEN GO TO FELKOD;
IF(KO=1210)&((PROJ=0&AVD¬=0)ö(PROJ¬=0&AVD=0))THEN GO TO FELKOD;
IF KO=1210&PROJ¬=0 THEN PROJ=9999;
KTOIN:IF VERIFY(SUBSTR(KOSVAR,1,4),'0123456789')=0 THEN GO TO FELKO;
IF KO<0 THEN GO TO FELKO;
ON ERROR GO TO FELKO;READ KEY(KO)FILE(KTOTX)INTO(KTO);
KTOOK:PUT FILE(D)SKIP EDIT('VER.NR:')(A(31))(VERNR)(P'ZZZZZ9',X(37))('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(6))(AVD)(P'ZZ9',X(4))(PROJ)(P'ZZZZZ9',X(2));
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.PROJ,')(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(14))('ÄR EN FELAKTIG KOD!')(A(23))
('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(28))(TD)
(P'-----------9V.99')(TK)(P'------------9V.99',X(6))('DIFF:')(A)
(TD-TK)(P'---------9V.99')SKIP(RAD-7);
SLUT:CALL TYPIST('BOKRUT┣0d┫',7);END;