|
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: 13667 (0x3563)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »BOKRUT1«
└─⟦1f3202981⟧ Bits:30008731 DDMQ1-0173_MSAB_Bokföring_Alla_Program_i_PL1_ref_ex_780428
└─⟦this⟧ »BOKRUT1«
/*FÖRSTA RADEN*/
/*BOKRUT TABLÅPROGRAM FÖR NYA VERS AV BOKFÖRINGSRUTINER
KLART 780428FÖR MSAB PROGR:TD */
DCL DATFIL FILE,S CHAR(2),ANT BINARY,SUB CHAR(90),INFO(5) CHAR(128),
LB(24) LABEL INIT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,
A17,A18,A19,A20,A21,A22,A23,A24),SAMFIL FILE,INF CHAR(128);
DCL 1 DATREC,2 DAG CHAR(6),2 MON CHAR(3),2 MNR FIXED(2),2 SORTKOD(14) CHAR(1),
2 CO FIXED(1);
OPEN DATFIL;READ FILE(DATFIL)INTO(DATREC);
L0:
PUT FILE(D) SKIP EDIT (' ******* VAD VILL DU GÖRA? *******')
(A(37))(' (TRYCK RETURN FÖR NY TABLÅ)')(A(37))
(' "1"=AVSLUTA PROGRAMKÖRNINGEN')(A(37))
(' "2"=MAN. REGISTRERING AV VERIF.')(A(37))
(' "3"=VERIFIKATIONSLISTA')(A(37))
(' "4"=... ')(A(37))
(' "5"=UTSKRIFT AV KONTOPLANEN')(A(37))
(' "6"=HUVUDBOK')(A(35));
GET SKIP LIST(S);PUT FILE(D) SKIP;
IF S='1 ' THEN GO TO A1;
IF S='2 'öS='3 'öS='4 'öS='5 'öS='6 ' THEN GO TO PER;
L1:PUT FILE(D) SKIP EDIT(' "7"=... ')(A(37))
(' "8"=... ')(A(37))
(' "9"=RESULTATRÄKNING')(A(37))
('"10"=BALANSRÄKNING')(A(37))
('"11"=MOMSREDOVISNING (FINNS EJ ÄNNU)')(A(37))
('"12"=RÅBALANS FÖR BOKSLUT(FINNS EJ)')(A(37))
('"13"=UTSKRIFT AV INGÅENDE BALANSER')(A(37))
('"14"=... ')(A(34));GET SKIP LIST(S);PUT FILE(D)SKIP;
IF S='7 'öS='8 'öS='9 'öS='10'öS='11'öS='12'öS='13'öS='14' THEN GO TO PER;
L2:PUT FILE(D)EDIT
('"15"=UPPLÄGGNING AV NYA KONTON')(A(37))
('"16"=ÄNDRINGAR I KONTOPLANEN')(A(37))
('"17"=INMATNING AV INGÅENDE BALANSER')(A(37))
('"18"=... ')(A(37))
('"19"=RUTIN FÖR NYTT BOKFÖRINGSÅR')(A(37))
('"20"=...')(A(37))
('"21"=...')(A(37))
('"22"=...')(A(34));
GET SKIP LIST(S);PUT FILE(D)SKIP;
IF S='15'öS='16'öS='17'öS='18'öS='20'öS='21'öS='22' THEN GO TO PER;
IF S='19' THEN GO TO A19;
GO TO L0;
PER:MON=' ';MNR=0;PUT FILE(D)SKIP;
IF S='2 ' THEN PUT FILE(D)EDIT(' BOKF.')(A);
ELSE PUT FILE(D)SKIP EDIT(' ANGE ')(A);
PUT FILE(D)EDIT('DAGENS DATUM (ÅÅMMDD):')(A(25));
GET SKIP LIST(DAG);PUT FILE(D) SKIP;
IF S='11'öS='6 'ö
S='9 'öS='2 'öS='3 'öS='4 'öS='10' THEN GO TO MONIN;GO TO VX;
MONIN:PUT FILE(D) SKIP EDIT('VILKEN MÅNAD SKA AVSES?')(A(37))
('SVARA "JAN" "APR" ELLER LIKN')(A(37))('ANGE ALLTID TRE BOKSTÄVER:')(A(34));
GET SKIP LIST(MON);PUT FILE(D) SKIP;
MNR=0;
MNR=INDEX(' JAN,FEB,MAR,APR,MAJ,JUN,JUL,AUG,SEP,OKT,NOV,DEC',MON)/4;
IF MNR=0 THEN GO TO MONIN;
VX:II=S;IF II¬=0 THEN GO TO LB(II);
GO TO L0;
A2:INF='VERIFIN ' CAT MON;
REWRITE FILE(DATFIL)FROM(DATREC);
CALL LOAD(INF,11);GO TO UT;
A3:ANT=0;
IF SORTKOD(MNR)¬='V' THEN DO;INFO(1)='DISK C ' CAT MON CAT ' VERCOPY ' CAT
'SORT,O ' CAT MON CAT ' VERSORT 10 ';ANT=41;END;
ELSE DO;INFO(1)='';ANT=0;END;
SORTKOD(MNR)='V';REWRITE FILE(DATFIL)FROM(DATREC);
INFO(2)='VERIFUT ' CAT MON;ANT=ANT+11;
INF=INFO(1) CAT INFO(2);
CALL LOAD(INF,ANT);GO TO UT;
A6:ANT=0;OPEN SAMFIL;CALL SEOF(SAMFIL);
IF UNSPEC(SAMFIL)=0 THEN SORTKOD(13)='K';
IF SORTKOD(MNR)¬='K' THEN DO;INFO(1)='DISK C ' CAT MON CAT ' VERCOPY ' CAT
'SORT ' CAT MON CAT ' VERSORT ';ANT=36;END;
ELSE DO;INFO(1)='';ANT=0;END;
IF SORTKOD(13)¬='K' THEN DO;INFO(2)=' SORT SAMFIL '
CAT 'VERSORT ';ANT=ANT+42;END;
ELSE DO;INFO(2)='';END;
SORTKOD(MNR)='K';SORTKOD(13)='K';REWRITE FILE(DATFIL)FROM(DATREC);
INF=INFO(1) CAT INFO(2) CAT 'HUVBOK ' CAT MON;ANT=ANT+10;
CALL LOAD(INF,ANT);
GO TO UT;
A9:S='2 ';
INFO(1)='';
IF S='2 ' THEN DO;CO=0;
OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN GO TO L0;
ANT=0;IF SORTKOD(13)¬='K' THEN DO;INFO(1)=' SORT ' CAT
'SAMFIL VERSORT ';ANT=42;SORTKOD(13)='K';END;END;
INF=INFO(1) CAT 'RESRÄKN';ANT=ANT+7;
REWRITE FILE(DATFIL)FROM(DATREC);
CALL LOAD(INF,ANT);GO TO UT;
A10:OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN GO TO L0;
ANT=0;IF SORTKOD(13)¬='K' THEN DO;INFO(1)=' ' CAT
'SORT SAMFIL VERSORT ';ANT=42;END;
ELSE DO;INFO(1)='';END;
INF=INFO(1) CAT 'BALRÄKN';ANT=ANT+7;
SORTKOD(13)='K';REWRITE FILE(DATFIL)FROM(DATREC);
CALL LOAD(INF,ANT);GO TO UT;
A15:REWRITE FILE(DATFIL)FROM(DATREC);CALL LOAD('KOUPP',5);GO TO UT;
A17:ANT=0;IF SORTKOD(14)¬='K' THEN DO;
INFO(1)='DISK C KTOTX KTOCOPY SORT KTOTX KTOSORT ';ANT=40;END;
ELSE DO;INFO(1)='';END;
SORTKOD(14)='K';REWRITE FILE(DATFIL)FROM(DATREC);
INF=INFO(1) CAT 'IBALIN';ANT=ANT+6;
CALL LOAD(INF,ANT);GO TO UT;
A16:REWRITE FILE(DATFIL)FROM(DATREC);CALL LOAD('KOALT',5);GO TO UT;
A5:ANT=0;IF SORTKOD(14)¬='K' THEN DO;
INFO(1)='DISK C KTOTX KTOCOPY SORT KTOTX KTOSORT ';ANT=40;END;
ELSE DO;INFO(1)='';END;
INF=INFO(1) CAT 'KOUT';ANT=ANT+4;
SORTKOD(14)='K';REWRITE FILE(DATFIL)FROM(DATREC);
CALL LOAD(INF,ANT);GO TO UT;
A13:OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN GO TO L0;
ANT=0;IF SORTKOD(13)¬='K' THEN DO;INFO(1)=' ' CAT
'SORT SAMFIL VERSORT ';ANT=42;END;
ELSE DO;INFO(1)='';END;
INF=INFO(1) CAT 'IBALUT';ANT=ANT+6;
SORTKOD(13)='K';REWRITE FILE(DATFIL)FROM(DATREC);
CALL LOAD(INF,ANT);GO TO UT;
A18:OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN SORTKOD(13)='K';
ANT=0;IF SORTKOD(13)¬='K' THEN DO;INFO(1)=' ' CAT
'SORT SAMFIL VERSORT ';ANT=42;END;
ELSE DO;INFO(1)='';END;
INF=INFO(1) CAT 'BUDGIN';ANT=ANT+6;
SORTKOD(13)='K';REWRITE FILE(DATFIL)FROM(DATREC);
CALL LOAD(INF,ANT);GO TO UT;
A14:OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN GO TO L0;
ANT=0;IF SORTKOD(13)¬='K' THEN DO;INFO(1)=' ' CAT
'SORT SAMFIL VERSORT ';ANT=42;END;
ELSE DO;INFO(1)='';END;
INF=INFO(1) CAT 'BUDGUT';ANT=ANT+6;
SORTKOD(13)='K';REWRITE FILE(DATFIL)FROM(DATREC);
CALL LOAD(INF,ANT);GO TO UT;
A12:OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN GO TO L0;
ANT=0;IF SORTKOD(13)¬='K' THEN DO;INFO(1)=' ' CAT
'SORT SAMFIL VERSORT ';ANT=42;END;
ELSE DO;INFO(1)='';END;
INF=INFO(1) CAT 'BOKSLUT';ANT=ANT+7;
SORTKOD(13)='K';REWRITE FILE(DATFIL)FROM(DATREC);
CALL LOAD(INF,ANT);GO TO UT;
A1:GO TO UT;
A4:OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN SORTKOD(13)='K';
ANT=0;IF SORTKOD(13)¬='K' THEN DO;INFO(1)=' ' CAT
'SORT SAMFIL VERSORT ';ANT=42;END;
ELSE DO;INFO(1)='';END;
INF=INFO(1) CAT 'AKTSAL ' CAT MON;ANT=ANT+10;
SORTKOD(13)='K';REWRITE FILE(DATFIL)FROM(DATREC);
CALL LOAD(INF,ANT);GO TO UT;
A11:GO TO L0;
A19:PUT FILE(D) SKIP EDIT('FINNS DET EN FIL SOM HETER NYSAM,')(A(37))
('MED SAMMA RECORD-LÄNGD SOM SAMFIL, I MASKINEN?')(A(74))
('SVARA "J" ELLER "N":')(A(36));GET SKIP LIST(S);
IF S¬='J ' THEN GO TO L0;
PUT FILE(D)SKIP;
ANT=0;OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN SORTKOD(13)='K';
IF SORTKOD(13)¬='K' THEN DO;INFO(1)=' ' CAT
'SORT SAMFIL VERSORT ';ANT=42;END;
ELSE DO;INFO(1)='';END;
INF=INFO(1) CAT 'NYÅR';ANT=ANT+4;
DAG='YYYYYY';SORTKOD(13)='K';REWRITE FILE(DATFIL)FROM(DATREC);
CALL LOAD(INF,ANT);GO TO UT;
A7:OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN GO TO L0;
ANT=0;IF SORTKOD(13)¬='P' THEN DO;INFO(1)=' ' CAT
'ALTC SORT SAMFIL VERSORT ALTD ';ANT=52;END;
ELSE DO;INFO(1)='';END;
INF=INFO(1) CAT 'PROJRED';ANT=ANT+7;
SORTKOD(13)='P';REWRITE FILE(DATFIL)FROM(DATREC);
CALL LOAD(INF,ANT);GO TO UT;
A8:REWRITE FILE(DATFIL)FROM(DATREC);CALL LOAD('PRSLUT',6);GO TO UT;
A20:GO TO L0;
A21:GO TO L0;
A22:GO TO L0;
UT:END;