|
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: 12166 (0x2f86)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »KONTUT_T«
└─⟦45145b6cc⟧ Bits:30008636 DDMQ1-0075_Bokrut_diskett_2_Original_JÅ_800504_PL1_LMC
└─⟦this⟧ »KONTUT_T«
/* KONTUT ÄR ENRUTIN FÖR UTSKRIFT AV SMMTLIGA KONTERINGAR UNDER EN MÅNAD
BEGRÄNSNINGARNA ANGES SOM KONTO OCH AVDELNINGS GRÄNSER
EN ELLER FLERA MÅNADER KAN OMFATTAS AV RAPPORTEN
PRG JÅ 800609 */
DCL FILNAMN CHAR(1),
INFIL FILE,
FIL FILE,
1 VER_STR,
2 VER_ID,
3 KONTO FIXED(4),
3 AVD CHAR(3),
2 DAT FIXED(4),
2 VERNR FIXED(7),
2 VTXT CHAR(20),
2 BEL FIXED(11,2),
2 KOD CHAR(1),
1 IN_STR(64),
2 CH CHAR(40),
IN_SIZE BINARY INIT(64),
D_T BINARY INIT(37),
VERSION CHAR(37)
INIT('KONTUT Version 2.1 800609'),
1 BREC,
2 FILLER FIXED(11) INIT(0),
2 DATUM CHAR(6),
2 S_STR,
3 SKONTO FIXED(4),
3 SAVD CHAR(3),
2 E_STR,
3 EKONTO FIXED(4),
3 EAVD CHAR(3),
T3 CHAR(3),
T8 CHAR(8),
SLUT BINARY,
OK BINARY,
MAX_P_FIL BINARY INIT(0),
MAX_P_STR BINARY INIT(0),
POS_STR BINARY INIT(0),
1 DATREC,
2 FIRMA_NAMN CHAR(20) INIT(' ');
START:PROC;
PUT FILE(D) SKIP EDIT(VERSION)(A(D_T*2))('DAGENS DATUM')(A(D_T-6));
GET SKIP LIST(DATUM);
PUT FILE(D) EDIT(DATUM)(A(6));
RETURN;
END;
GET_KONTO:PROC;
PUT FILE(D) EDIT('FRÅN OCH MED KONTO AVD')(A(D_T-8));
GET SKIP LIST(T8);
SKONTO=SUBSTR(T8,1,4);
SAVD=SUBSTR(T8,5,3);
PUT FILE(D) EDIT(SKONTO)(A(5))(SAVD)(A(3))('TILL OCH MED KONTO AVD')
(A(D_T-8));
GET SKIP LIST(T8);
EKONTO=SUBSTR(T8,1,4);
EAVD=SUBSTR(T8,5,3);
PUT FILE(D) EDIT(EKONTO)(A(5))(EAVD)(A(3));
OPEN FIL;
WRITE FILE(FIL) FROM(BREC);
RETURN;
END;
DO_EXIT:PROC;
CLOSE FIL;
CALL LOAD('S FIL SORTFIL KONTUTU',21);
STOP;
END;
GET_FIL:PROC;
IF SUBSTR(FILNAMN,4,8) = 'INFIL ' THEN
PUT FILE(D) EDIT('VILKEN MÅNAD (te.x. JAN FEB)')(A(D_T-3));
OPEN_LOOP:
IF SUBSTR(FILNAMN,4,8) ¬= 'INFIL ' THEN CALL OUTPUT(1,6);
GET SKIP LIST(T8);
IF T8 = ' ' THEN CALL DO_EXIT;
SUBSTR(FILNAMN,4,8)=T8;
ON ERROR GO TO OPEN_LOOP;
OPEN INFIL;
CALL SEOF(INFIL);
MAX_P_FIL=UNSPEC(INFIL);
UNSPEC(INFIL)=0;
SLUT=0;
RETURN;
END;
GET_POST:PROC;
IF POS_STR = MAX_P_STR THEN DO;
IF MAX_P_FIL = 0 THEN DO;
SLUT=1;
RETURN;
END;
ELSE DO;
ON ENDFILE GO TO VIDARE;
READ FILE(INFIL) INTO(IN_STR);
VIDARE: MAX_P_STR=IN_SIZE;
IF MAX_P_STR > MAX_P_FIL THEN MAX_P_STR=MAX_P_FIL;
MAX_P_FIL=MAX_P_FIL-MAX_P_STR;
POS_STR=1;
END;
END;
ELSE DO;
POS_STR=POS_STR+1;
END;
VER_STR=IN_STR(POS_STR);
RETURN;
END;
DO_KONT_TEST:PROC;
OK=1;
IF KONTO < SKONTO ö KONTO > EKONTO THEN OK=0;
IF SAVD ¬= ' ' & AVD < SAVD THEN OK=0;
IF EAVD ¬= ' ' & AVD > EAVD THEN OK=0;
RETURN;
END;
/* H Ä R B Ö R J A R H U V U D P R O G R A M M E T */
CALL START;
CALL GET_KONTO;
FILE_LOOP:
CALL GET_FIL;
POST_LOOP:
CALL GET_POST;
IF SLUT THEN GO TO FILE_LOOP;
CALL DO_KONT_TEST;
IF OK THEN DO;
T3=AVD;
AVD=SUBSTR(AVD,-2,3);
SUBSTR(AVD,-2,3)=T3;
WRITE FILE(FIL) FROM(VER_STR);
END;
GO TO POST_LOOP;
END;