|
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: 11692 (0x2dac)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »BOKRUT1«
└─⟦2d3ae9df8⟧ Bits:30008654 DDMQ1-0094_Nya_bokforingssystemet_I_LMC_MSAB_COPY_Skriv_BOKRUT_780220_TD
└─⟦this⟧ »BOKRUT1«
/*FÖRSTA RADEN*/
/*BOKRUT TABLÅPROGRAM FÖR NYA VERS AV BOKFÖRINGSRUTINER.
KLART XXXXXX PROGR:TD */
DCL DATFIL FILE,S CHAR(2),ANT BINARY,SUB CHAR(90),INFO(5) CHAR(128),
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);
L0:
PUT FILE(D) SKIP EDIT (' ******* VAD VILL DU GÖRA? *******')
(A(37))(' (TRYCK RETURN FÖR NY TABLÅ)')(A(37))
(' "1"=REGISTRERA VERIFIKATIONER')(A(37))
(' "2"=SKRIVA UT VERIFIKATIONSLISTA')(A(37))
(' "3"=SKRIVA UT HUVUDBOK')(A(37))
(' "4"=SKRIVA UT RESULTATRÄKNING')(A(37))
(' "5"=SKRIVA UT BALANSRÄKNING')(A(37))
(' "6"=LÄGGA UPP NYA KONTON')(A(35));
GET SKIP LIST(S);PUT FILE(D) SKIP;
IF S='1 'öS='2 'öS='3 'öS='4 'öS='5 'öS='6 ' THEN GO TO PER;
L1:PUT FILE(D) SKIP EDIT(' "7"=INLÄGGNING AV ING.BALANSER')(A(37))
(' "8"=ÄNDRINGAR I KONTOPLANEN')(A(37))
(' "9"=UTSKRIFT AV KONTOPLANEN')(A(37))
('"10"=UTSKRIFT AV ING. BALANSER')(A(37))
('"11"=INMATNING AV BUDGET')(A(37))
('"12"=UTSKRIFT AV BUDGET')(A(37))
('"13"=RÅBALANS FÖR BOKSLUT')(A(37))
('"14"=AVSLUTA PROGRAMKÖRNINGEN')(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' THEN GO TO PER;
IF S='14' THEN GO TO A14;
L2:PUT FILE(D)EDIT
('"15"=SALDO KTO 1010,1020,1040,2720')(A(37))
('"16"=MOMSREDOVISNING')(A(37))
('"17"=RUTINER FÖR NYTT BOKF.ÅR')(A(37))
('"18"=...')(A(37))
('"19"=...')(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='19'öS='20'öS='21'öS='22' THEN GO TO PER;
GO TO L0;
PER:MON=' ';MNR=0;PUT FILE(D)SKIP;
OPEN DATFIL;READ FILE(DATFIL)INTO(DATREC);
IF S='1 ' THEN PUT FILE(D)SKIP EDIT('BOKF.')(A);ELSE PUT FILE(D)SKIP;
PUT FILE(D)EDIT('DAGENS DATUM (ÅÅMMDD):')(A(26));IF S¬='1 ' THEN PUT FILE(D)
EDIT(' ')(A(5));
GET SKIP LIST(DAG);PUT FILE(D) SKIP;
IF S='15'öS='16'ö
S='1 'öS='2 'öS='3 'öS='4 'öS='5 'öS='13' 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 EDIT('VILKET ÅR AVSER MÅNADEN ?')(A(37))
('SVARA MED HELA ÅRTALET, tex 1984')(A(37));GET SKIP LIST(FTAAR);
PUT FILE(D) SKIP;
MNR=0;
IF MON='JAN' THEN MNR=1;IF MON='FEB' THEN MNR=2;
IF MON='MAR' THEN MNR=3;IF MON='APR' THEN MNR=4;
IF MON='MAJ' THEN MNR=5;IF MON='JUN' THEN MNR=6;
IF MON='JUL' THEN MNR=7;IF MON='AUG' THEN MNR=8;
IF MON='SEP' THEN MNR=9;IF MON='OKT' THEN MNR=10;
IF MON='NOV' THEN MNR=11;IF MON='DEC' THEN MNR=12;
IF MNR=0 THEN GO TO MONIN;
VX:REWRITE FILE(DATFIL)FROM(DATREC);
IF S='1 ' THEN GO TO A1;IF S='2 ' THEN GO TO A2;IF S='3 ' THEN GO TO A3;
IF S='4 ' THEN GO TO A4;IF S='5 ' THEN GO TO A5;IF S='6 ' THEN GO TO A6;
IF S='7 ' THEN GO TO A7;IF S='8 ' THEN GO TO A8;IF S='9 ' THEN GO TO A9;
IF S='10' THEN GO TO A10;IF S='11' THEN GO TO A11;IF S='12' THEN GO TO A12;
IF S='13' THEN GO TO A13;IF S='14' THEN GO TO A14;IF S='15' THEN GO TO A15;
IF S='16' THEN GO TO A16;IF S='17' THEN GO TO A17;IF S='18' THEN GO TO A18;
IF S='19' THEN GO TO A19;IF S='20' THEN GO TO A20;IF S='21' THEN GO TO A21;
IF S='22' THEN GO TO A22;GO TO L0;
A1:INF='VERIFIN ' CAT MON CAT '┣0d┫';
REWRITE FILE(DATFIL)FROM(DATREC);
CALL TYPIST(INF,12);GO TO UT;
A2:ANT=0;
IF SORTKOD(MNR)¬='V' THEN DO;INFO(1)='DISK C ' CAT MON CAT ' VERCOPY' CAT
' SORT,O ' CAT MON CAT ' VERSORT 12 ';ANT=41;END;
ELSE DO;INFO(1)='';ANT=0;END;
SORTKOD(MNR)='V';REWRITE FILE(DATFIL)FROM(DATREC);
INFO(2)='VERIFUT ' CAT MON CAT '┣0d┫';ANT=ANT+12;
INF=INFO(1) CAT INFO(2);
CALL TYPIST(INF,ANT);GO TO UT;
A3: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 ' VERFIL SORT '
CAT VERFIL CAT ' VERSORT ';ANT=38;END;
ELSE DO;INFO(1)='';ANT=0;END;
IF SORTKOD(13)¬='K' THEN DO;INFO(2)='DISK C SAMFIL SAMCOPY 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 CAT '┣0d┫';ANT=ANT+11;
CALL TYPIST(INF,ANT);
GO TO UT;
A4:CALL TYPIST('RESRÄKN┣0d┫',8);GO TO UT;
A5:OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN SORTKOD(13)='K';
ANT=0;IF SORTKOD(13)¬='K' THEN DO;INFO(1)='DISK C SAMFIL SAMCOPY ' CAT
'SORT SAMFIL VERSORT ';ANT=42;END;
ELSE DO;INFO(1)='';END;
INF=INFO(1) CAT 'BALRÄKN┣0d┫';ANT=ANT+8;
SORTKOD(13)='K';REWRITE FILE(DATFIL)FROM(DATREC);
CALL TYPIST(INF,ANT);GO TO UT;
A6:CALL TYPIST('KOUPP┣0d┫',6);GO TO UT;
A7:ANT=0;IF SORTKOD(14)¬='K' THEN DO;INFO(1)='DISK C KTOTX KTOCOPY ' CAT
'SORT KTOTX KTOSORT ';ANT=40;END;
ELSE DO;INFO(1)='';END;
SORTKOD(14)='K';REWRITE FILE(DATFIL)FROM(DATREC);
INF=INFO(1) CAT 'IBALIN┣0d┫';ANT=ANT+7;
CALL TYPIST(INF,ANT);GO TO UT;
A8:CALL TYPIST('KOALT┣0d┫',6);GO TO UT;
A9:ANT=0;IF SORTKOD(14)¬='K' THEN DO;INFO(1)='DISK C KTOTX KTOCOPY ' CAT
'SORT KTOTX KTOSORT ';ANT=40;END;
ELSE DO;INFO(1)='';END;
INF=INFO(1) CAT 'KOUT┣0d┫';ANT=ANT+5;
SORTKOD(14)='K';REWRITE FILE(DATFIL)FROM(DATREC);
CALL TYPIST(INF,ANT);GO TO UT;
A10:OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN SORTKOD(13)='K';
ANT=0;IF SORTKOD(13)¬='K' THEN DO;INFO(1)='DISK C SAMFIL SAMCOPY ' CAT
'SORT SAMFIL VERSORT ';ANT=42;END;
ELSE DO;INFO(1)='';END;
INF=INFO(1) CAT 'IBALUT┣0d┫';ANT=ANT+7;
SORTKOD(13)='K';REWRITE FILE(DATFIL)FROM(DATREC);
CALL TYPIST(INF,ANT);GO TO UT;
A11:OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN SORTKOD(13)='K';
ANT=0;IF SORTKOD(13)¬='K' THEN DO;INFO(1)='DISK C SAMFIL SAMCOPY '
CAT 'SORT SAMFIL VERSORT ';ANT=42;END;
ELSE DO;INFO(1)='';END;
INF=INFO(1) CAT 'BUDGIN┣0d┫';ANT=ANT+7;
SORTKOD(13)='K';REWRITE FILE(DATFIL)FROM(DATREC);
CALL TYPIST(INF,ANT);GO TO UT;
A12:OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN SORTKOD(13)='K';
ANT=0;IF SORTKOD(13)¬='K' THEN DO;INFO(1)='DISK C SAMFIL SAMCOPY ' CAT
'SORT SAMFIL VERSORT ';ANT=42;END;
ELSE DO;INFO(1)='';END;
INF=INFO(1) CAT 'BUDGUT┣0d┫';ANT=ANT+7;
SORTKOD(13)='K';REWRITE FILE(DATFIL)FROM(DATREC);
CALL TYPIST(INF,ANT);GO TO UT;
A13:CALL TYPIST('BOKSLUT┣0d┫',8);GO TO UT;
A14:GO TO UT;
A15:GO TO L0;
A16:GO TO L0;
A17:GO TO L0;
A18:GO TO L0;
A19:GO TO L0;
A20:GO TO L0;
A21:GO TO L0;
A22:GO TO L0;
UT:END;