|
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: »VERIFIN1«
└─⟦aeb45b905⟧ Bits:30008623 DDMQ1-0063__LMC_Original_Generella_pgm_for_bokforing_Sid1_PL1_Sid2_kompil_781105_side1
└─⟦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;
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),
MON_# BINARY,
OFFSET BINARY INIT(8), /* BOKFÖRINGSÅRETS OFF */
T20 CHAR(20);
GET_VER_TEXT:PROC;
PUT FILE(D) SKIP EDIT('VERNR:')(A(6))(VERNR)(A(31))('TEXT:')(A(17));
GET SKIP LIST(VTXT);
PUT FILE(D) EDIT(VTXT)(A(20));
RETURN;
END;
CALL KFILE(VERFIL);
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)=' ';
MON_#=MNR+OFFSET;
IF MON_#>12 THEN MON_#=MON_#-12;
IF MON_#¬=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));
RAD=RAD-1;
T20=VTXT;
MER:POS=1;IF RAD<12 THEN GO TO RUB;
PUT FILE(D)SKIP EDIT('VERNR:')(A(6))(VERNR)(A(31))
('REGISTRERA MED "F8" FÖR NY VERTEXT')(A(37))('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: CALL KEYFUN(II);
IF II=24 THEN DO;
CALL GET_VER_TEXT;
T20=VTXT;
END;
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(T20)(A(23))(KO)(A(7))(AVD)(A(6));
T20=' ';
IF I=138 THEN PUT EDIT(' ')(A(16));
PUT EDIT(BEL)(P'---------9V.99')SKIP EDIT('')(A(10));
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;