DataMuseum.dk

Presents historical artifacts from the history of:

Q1 computer

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Q1 computer

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦2e29c82dd⟧ Q1_Text, reclen=79

    Length: 12877 (0x324d)
    Types: Q1_Text, reclen=79
    Notes: q1file
    Names: »ADRUTSKR«

Derivation

└─⟦169de8b1d⟧ Bits:30008745 50001578
    └─⟦this⟧ »ADRUTSKR« 

Text

/*  PROGRAM-ID.                                ADRUTSKR                        
    DATE-WRITTEN.                              1978-12-13.                     
    AUTHOR.                                    OLLE                            
    REMARKS.                                   PROGRAMMET SKRIVER ETIKETTER    
                                               FRÅN ADRESSREGISTER             
    WORKING-STORAGE SECTION.                                                 */
    DCL     FOREKOD                            CHAR (1);                       
    DCL     BLANK           CHAR (30) INIT ('                              '); 
    DCL     BLANK2          CHAR (15) INIT ('               ');                
    DCL KNUTTAR FILE;                                                          
    DCL KVVADR FILE;                                                           
    DCL AROSADR FILE;                                                          
    DCL 1   WRPOST,                                                            
            2   FKOD                           CHAR (1),                       
            2   FUKOD                          CHAR (1),                       
            2   LOPNR                          CHAR (3),                       
            2   NAMN                           CHAR (30),                      
            2   FORETAG                        CHAR (30),                      
            2   AVDELNING                      CHAR (15),                      
            2   ADRESS                         CHAR (30),                      
            2   PADR                           CHAR (21),                      
            2   FILLER                         CHAR (19);                      
    DCL 1   RAD,                                                               
            2   FILL                           CHAR (3),                       
            2   RNAMN                          CHAR (30);                      
    DCL 1   HJRAD (5,3),                                                       
            2   HJFILL                         CHAR (3),                       
            2   HJNAMN                         CHAR (30);                      
/*  PROCEDURE DIVISION                                                       */
    TAB: PROC;                                                                 
            HJRAD (I,J) = RAD;                                                 
            RETURN;                                                            
            END;                                                               
    BLANKA: PROC;                                                              
            DO I = 1 TO 5;                                                     
                DO J = 1 TO 3;                                                 
                    RNAMN = BLANK;                                             
                    HJRAD (I,J) = RAD;                                         
                END;                                                           
                END;                                                           
            RETURN;                                                            
            END;                                                               
    BLRAD3: PROC;                                                              
            PUT SKIP (3) EDIT (' ') (A(1));                                    
            RETURN;                                                            
            END;                                                               
    BLRAD4: PROC;                                                              
            PUT SKIP (4) EDIT (' ') (A(1));                                    
            L = 0;                                                             
            RETURN;                                                            
            END;                                                               
    LNOLL: PROC;                                                               
            L = 0;                                                             
            RETURN;                                                            
            END;                                                               
    A050:                                                                      
        L = 0;                                                                 
    A100:                                                                      
        PUT FILE (D) SKIP EDIT                                                 
            ('VAR GOD ANGIV FÖRETAGSKOD FÖR ETIKETTUTSKRIFT:') (A(46));        
        GET SKIP LIST (FOREKOD);                                               
        IF FOREKOD = 'S' THEN GO TO A700;                                      
        PUT FILE (D) EDIT (' ') (A(48));                                       
        PUT FILE (D) EDIT ('SKALL UTSKRIFT GÖRAS PÅ NY SIDA SVARA J eller N')  
            (A(47));                                                           
        GET SKIP LIST (FILL);                                                  
        IF FILL = ('J  ') THEN CALL LNOLL;                                     
        CALL BLANKA;                                                           
        J = 0;                                                                 
        K = 0;                                                                 
        IF FOREKOD = '7' THEN OPEN KNUTTAR;                                    
        IF FOREKOD = '8' THEN OPEN KVVADR;                                     
        IF FOREKOD = '9' THEN OPEN AROSADR;                                    
        IF FOREKOD = '7' THEN GO TO A210;                                      
        IF FOREKOD = '8' THEN GO TO A220;                                      
        IF FOREKOD = '9' THEN GO TO A230;                                      
        GO TO A100;                                                            
    A210:                                                                      
        ON ENDFILE GO TO A399;                                                 
        READ FILE (KNUTTAR) INTO (WRPOST);                                     
        GO TO A400;                                                            
    A220:                                                                      
        ON ENDFILE GO TO A399;                                                 
        READ FILE (KVVADR) INTO (WRPOST);                                      
        GO TO A400;                                                            
    A230:                                                                      
        ON ENDFILE GO TO A399;                                                 
        READ FILE (AROSADR) INTO (WRPOST);                                     
        GO TO A400;                                                            
    A300:                                                                      
        IF FOREKOD = '7' THEN CLOSE KNUTTAR;                                   
        IF FOREKOD = '8' THEN CLOSE KVVADR;                                    
        IF FOREKOD = '9' THEN CLOSE AROSADR;                                   
        GO TO A100;                                                            
    A399:                                                                      
        K = 1;                                                                 
        GO TO A500;                                                            
                                                                               
/*      LADDNING AV NAMN- / ADRESSTABELLEN                                   */
                                                                               
                                                                               
    A400:                                                                      
        I = 0;                                                                 
        J = J + 1;                                                             
        IF NAMN = BLANK THEN GO TO A410;                                       
        I = I + 1;                                                             
        RNAMN = NAMN;                                                          
        CALL TAB;                                                              
    A410:                                                                      
        IF FORETAG = BLANK THEN GO TO A420;                                    
        I = I + 1;                                                             
        RNAMN = FORETAG;                                                       
        CALL TAB;                                                              
    A420:                                                                      
        IF AVDELNING = BLANK2 THEN GO TO A430;                                 
        I = I + 1;                                                             
        RNAMN = AVDELNING;                                                     
        CALL TAB;                                                              
    A430:                                                                      
        IF ADRESS = BLANK THEN GO TO A440;                                     
        I = I + 1;                                                             
        RNAMN = ADRESS;                                                        
        CALL TAB;                                                              
    A440:                                                                      
        IF PADR = BLANK THEN GO TO A499;                                       
        I = I + 1;                                                             
        RNAMN = PADR;                                                          
        CALL TAB;                                                              
    A499:                                                                      
        IF K = 1 THEN GO TO A100;                                              
        IF J = 3 THEN GO TO A500;                                              
        IF FOREKOD = '7' THEN GO TO A210;                                      
        IF FOREKOD = '8' THEN GO TO A220;                                      
        IF FOREKOD = '9' THEN GO TO A230;                                      
                                                                               
                                                                               
/*      UTSKRIFT FRÅN NAMN- / ADRESSTABELLEN                                */ 
                                                                               
    A500:                                                                      
        I = 0;                                                                 
        L = L + 1;                                                             
    A505:                                                                      
        J = 0;                                                                 
    A510:                                                                      
        I = I + 1;                                                             
        IF I = 6 THEN GO TO A600;                                              
        J = J + 1;                                                             
        RAD = HJRAD (I,J);                                                     
        PUT SKIP EDIT ('   ') (A(3)) (RNAMN) (A(30));                          
    A520:                                                                      
        J = J + 1;                                                             
        IF J = 4 THEN GO TO A505;                                              
        RAD = HJRAD (I,J);                                                     
        PUT EDIT ('   ') (A(3)) (RNAMN) (A(30));                               
        GO TO A520;                                                            
    A600:                                                                      
        CALL BLANKA;                                                           
        J = 0;                                                                 
        IF L = 1 THEN CALL BLRAD3;                                             
        IF L = 2 THEN CALL BLRAD4;                                             
        GO TO A499;                                                            
    A700:                                                                      
        END;