|
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: 8374 (0x20b6)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »VERIFIN1«
└─⟦d1c33ffd3⟧ Bits:30008583 DDMQ1-0017_Bokforingssystem_kallkod_Msab_790411
└─⟦this⟧ »VERIFIN1«
/*FÖRSTA RADEN*/
/*VERIFIN1 MANUELL INMATNING AV VERIFIKATIONER GENERELLT PGM.
REV: 781104 PROGR:TD */
/* MSAB HAR SPECIEL VARIANT ÄNDRA VID LABEL MSAB:
MODIFIERING JÅ 790306 */
DCL VERFIL FILE;CALL KFILE(VERFIL);
DCL 1 SISTAVER,2 SVERNR FIXED(7);
DCL 1 VER,2 KO FIXED(4),2 AVD CHAR(3),2 DAT FIXED(4),
2 VERNR FIXED(7),2 VTXT CHAR(20),2 BEL FIXED(11,2),2 KOD CHAR(1);
DCL 1 KTO,2 KSTR,3 KONTO FIXED(4),3 Z CHAR(1),2 K CHAR(4),2 TEXT CHAR(34),
2 IB FIXED(13,2);
DCL 1 DATREC,2 XDAG CHAR(6),2 MON CHAR(3),2 MNR FIXED(2),2 SK(14) CHAR(1),
2 CO FIXED(1);
DCL DATFIL FILE,KTOTX FILE,S CHAR(1),RAD FIXED(2),SIDA FIXED(4),IND FIXED(1),
DAG CHAR(6),SISTVER FILE,EX BINARY,
SVAR CHAR(7),AD FIXED(13,2),AK FIXED(13,2),TD FIXED(13,2),TK FIXED(13,2),
KOSVAR CHAR(13),KOSVAR2 CHAR(13),POS FIXED(1);
OPEN SISTVER;OPEN KTOTX;OPEN DATFIL;OPEN VERFIL;CALL SEOF(VERFIL);
READ FILE(DATFIL)INTO(DATREC);IF XDAG='XXXXXX' THEN GO TO SLUT;
DAG=XDAG;XDAG='XXXXXX';SK(MNR)=' ';
IF (MNR+0)¬=SUBSTR(DAG,3,2)&(MNR-0)¬=SUBSTR(DAG,3,2) THEN GO TO SLUT;
REWRITE FILE(DATFIL)FROM(DATREC);
READ FILE(SISTVER)INTO(SISTAVER);
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;
EX=0;POS=0;RAD=5;SIDA=0;IND=1;AD=0;AK=0;TD=0;TK=0;DAT=SUBSTR(DAG,3,4);
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(10))('TEXT')(A(23))('KONTO')(A(7))('AVD.')(A(14))('DEBET')(A(15))
('KREDIT')(A)SKIP;RAD=45;
IF POS=1 THEN PUT EDIT(' ')(A(33));
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;
PUT FILE(D)SKIP EDIT('VER.NR:')(A(37))('(OM LÖPANDE,TRYCK RETURN)')
(A(30));GET SKIP LIST(SVAR);IF SVAR='SLUT ' THEN GO TO UT;
IF VERIFY(SVAR,' 0123456789')=0 THEN GO TO ST;
MSAB: /*IF SVAR=' ' THEN VERNR=VERNR+1;
ELSE VERNR=SVAR;
SVERNR=VERNR;*/
ANDRA: IF SVAR=' ' THEN DO;VERNR=SVERNR+1;SVERNR=VERNR;END;
ELSE DO;VERNR=SVAR;END;
IF VERNR<1 THEN GOTO ST;
IND=0;
PUT FILE(D)SKIP EDIT('VERNR:')(A(6))(VERNR)(A(31))('TEXT:')(A(17));
GET SKIP LIST(VTXT);
PUT SKIP EDIT(VERNR)(A(10))(VTXT)(A(23));RAD=RAD-1;
MER:POS=1;IF RAD<12 THEN GO TO RUB;
PUT FILE(D)SKIP EDIT('VERNR:')(A(6))(VERNR)(A(31))
('KONTO.AVD:')(A(29));
GET SKIP LIST(KOSVAR);
KOIN:PUT FILE(D)EDIT(KOSVAR)(A(8));
J=INDEX(KOSVAR,'.');KO=SUBSTR(KOSVAR,1,J-1);
IF SUBSTR(KOSVAR,4,1)=' ' THEN GO TO FELKOD;
IF J=0&SUBSTR(KOSVAR,5,4)¬=' ' THEN GO TO FELKOD;
IF J=0 THEN GO TO X1;IF J¬=5 THEN GO TO FELKOD;
IF SUBSTR(KOSVAR,9,1)¬=' ' THEN GO TO FELKOD;
GO TO X2;
X1:AVD=' ';KO=SUBSTR(KOSVAR,1,4);
X2:IF J THEN AVD=SUBSTR(KOSVAR,6,3);ELSE AVD=' ';
NY:IF(KO<3000)&(AVD¬=' ')THEN GO TO FELKOD;
KTOIN:IF VERIFY(SUBSTR(KOSVAR,1,4),'0123456789')=0 THEN GO TO FELKO;
IF KO<0 THEN GO TO FELKO;
KONTO=KO;Z='A';
ON ERROR GO TO FELKO;READ KEY(KSTR)FILE(KTOTX)INTO(KTO);
KTOOK:PUT FILE(D)SKIP EDIT('VERNR:')(A(6))(VERNR)(A(31))('DIFF:')(A(6))
(AD-AK)(P'---------9V.99',X(18))('KONTO')(A(6))(KOSVAR)(A(31))
('BELOPP (+K7 DEB,-K6 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(7))(AVD)(A(6));
IF I=138 THEN PUT EDIT(' ')(A(16));
PUT EDIT(BEL)(P'---------9V.99')SKIP EDIT('')(A(33));RAD=RAD-1;
WRITE FILE(VERFIL)FROM(VER);
EX=1;
IF AD-AK¬=0 THEN GO TO MER;
REWRITE FILE(SISTVER)FROM(SISTAVER);
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(29));
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(29));
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;Z='A';K=KONTO CAT ' ';IB=0;
CALL SEOF(KTOTX);WRITE FILE(KTOTX)FROM(KTO);CLOSE KTOTX;OPEN KTOTX;
SK(14)=' ';REWRITE FILE(DATFIL)FROM(DATREC);GO TO KTOOK;
UT:PUT SKIP(2)EDIT('TOTALT ALLA TRANSAKTIONER:')(A(44))(TD)
(P'-----------9V.99')(TK)(P'------------9V.99')SKIP(RAD-7);
SLUT:CALL LOAD('BOKRUT',6);END;