Mostrar mensagens com a etiqueta Natural. Mostrar todas as mensagens
Mostrar mensagens com a etiqueta Natural. Mostrar todas as mensagens

quinta-feira, agosto 13, 2026

Criando Sistemas em Natural/Adabas - RMM

Neste post, apresento a estrutura inicial de um sistema desenvolvido em Natural/Adabas, criado com o objetivo de tornar mais simples, rápida e eficiente a consulta e o gerenciamento de informações relacionadas aos cartuchos no ambiente de grande porte. A aplicação no mainframe que gerencia os cartuchos é o RMM (Removable Media Manager), responsável pelo controle, inventário, movimentação e retenção de mídias utilizadas no ambiente mainframe. A ideia surgiu de uma necessidade bastante prática: embora o TSO seja uma ferramenta extremamente importante e que faz parte da rotina de administração do mainframe, algumas consultas poderiam ser realizadas de maneira muito mais rápida e amigável por meio de uma aplicação desenvolvida em Natural. Um dos exemplos é justamente a consulta de cartuchos. No dia a dia, muitas vezes precisamos localizar rapidamente um volume, verificar seu status, consultar informações da mídia ou simplesmente confirmar alguma informação relacionada ao armazenamento. Fazer esse tipo de consulta diretamente pelo TSO funciona, mas nem sempre oferece a praticidade necessária para uma consulta operacional rápida. Foi pensando nisso que surgiu a proposta deste sistema: utilizar os recursos do Natural/Adabas para criar uma interface simples, objetiva e rápida, permitindo que a equipe técnica tenha acesso às principais informações dos cartuchos sem a necessidade de executar diversos comandos ou navegar por diferentes processos. A solução foi desenvolvida com uma estrutura enxuta, aproveitando a integração direta entre o Natural e o Adabas. Dessa forma, é possível realizar consultas de forma praticamente imediata, utilizando os próprios recursos disponíveis no ambiente de grande porte. Mais do que criar uma aplicação complexa, a proposta é demonstrar como uma ferramenta relativamente simples pode resolver uma necessidade operacional do dia a dia. O Natural permite construir interfaces bastante funcionais, enquanto o Adabas oferece o suporte necessário para armazenar e consultar essas informações com excelente desempenho. Ao longo deste post, apresento a arquitetura inicial da solução, os principais programas envolvidos, a estrutura das consultas, o fluxo de navegação e a forma como o sistema foi organizado para facilitar o trabalho da equipe responsável pela administração das mídias. A ideia é mostrar, na prática, que mesmo utilizando tecnologias consideradas antigas, como Natural e Adabas, ainda é possível desenvolver soluções rápidas, eficientes e perfeitamente adequadas às necessidades atuais de um ambiente mainframe.

AADPA000

Tela do menu inicial
                                                                                
  ------------------------------------------------------------------------------
  DBAP055           SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS           AADPA000
  09:41:53 ------------------------------------------------------------ 13/08/26
                                                                        RMM
                                                                                
  ------------------------------------------------------------------------------
                              01 - Pesquisa de Cartucho          
                              02 - Pesquisa de Label             
                              03 - Pesquisa de Data              
                              04 - Pesquisa de OWNER             
  ------------------------------------------------------------------------------
                                                                                
                           DIGITE A OPCAO DESEJADA 0__                          
                                                                                
                              TECLE PF3 PARA SAIR                               
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   MENU                                                         

Programa Natural
* ==================================================================== *
* FUNCAO: SUBMETE JOBS PARA PESQUISAR OS CARTUCHOS DO RMM              *
*  AUTOR: CLAUDEMAR MARTINS DE SA                                      *
* CRIADO: 01/12/2022                                                   *
* ==================================================================== *
DEFINE DATA LOCAL                                                       
1 #ARQ1 (N3)                                                            
END-DEFINE                                                              
* ==================================================================== *
FORMAT KD=ON                                                            
SET CONTROL 'U'                                                         
* SET KEY PF3 = 'AABP300M' NAMED 'MENU'                                   
REPEAT                                                                  
* ==================================================================== *
  INPUT (IP=OFF SG=OFF AD=MIL'_')                                       
    02T '-' (78)                                                        
    / 02T *USER                                                         
    20T 'SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS' (I)72T *PROGRAM      
    / 02T *TIME(AL=8) 11T '-' (60) 72T  *DATE                           
    /72T *LIBRARY-ID                                                    
    //                                               
    02T '-' (78)                                        /                                                
    29T '01 - Pesquisa de Cartucho ' (I)                /                                                
    29T '02 - Pesquisa de Label    ' (I)                /                                                
    29T '03 - Pesquisa de Data     ' (I)                /                                                
    29T '04 - Pesquisa de OWNER    ' (I)                /                                                
    29T '-' (78)                                     
    //27T'DIGITE A OPCAO DESEJADA'(YE) #ARQ1(AD=MIL'_')                 
    //30T'TECLE PF3 PARA SAIR'(I)                                       
* ==================================================================== *
  DECIDE ON FIRST VALUE OF #ARQ1                                        
    VALUE 01 FETCH 'AADPA001'                                           
    VALUE 02 FETCH 'AADPA002'                                           
    VALUE 03 FETCH 'AADPA003'                                           
    VALUE 04 FETCH 'AADPA004'                                           
    NONE VALUE REINPUT ' OPCAO INVALIDA'                                
  END-DECIDE                                                            
* ==================================================================== *
END                                                                     

AADPA002

Pesquisa pelo nome do dataset (label) do cartucho;
                                                                                
  ------------------------------------------------------------------------------
  DBAP055           SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS            AADPA002
  09:55:43 ------------------------------------------------------------ 13/08/26
                            PESQUISA LABEL DE CARTUCHO                  RMM
                                                                                
           ------------------------------------------------------------         
                                                                                
                 LABEL : RMM_________________________________________           
                                                                                
           ------------------------------------------------------------         
                                                                                
                              TECLE PF3 PARA SAIR                               
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   EXIT                                                          

Resultado da pesquisa
                                                                                
 09:56:29                  CARTUCHO DO TLMS                            13/08/26 
                    DATASET                     CART   OWNER      DATA    SEQ   
 --------------------------------------------- ------ -------- ---------- ---   
                                                                                
 RMM.C.BACKUP.DIARIO.G0078V00                  VC1108          01/10/2025 1     
 RMM.C.BACKUP.DIARIO.G0080V00                  VC1110          03/10/2025 1     
 RMM.C.BACKUP.DIARIO.G0081V00                  VC1029          04/10/2025 1     
 RMM.C.BACKUP.DIARIO.G0082V00                  VC1121          05/10/2025 1     
 RMM.C.BACKUP.DIARIO.G0083V00                  VC1125          06/10/2025 1     
 RMM.C.BACKUP.DIARIO.G0084V00                  VC1133          07/10/2025 1     
 RMM.C.BACKUP.DIARIO.G0085V00                  VC1135          08/10/2025 1     
 RMM.C.BACKUP.DIARIO.G0086V00                  VC1058          09/10/2025 1     
 RMM.C.BACKUP.DIARIO.G0087V00                  VC1137          10/10/2025 1     
 RMM.C.BACKUP.DIARIO.G0088V00                  VC1064          11/10/2025 1     
 RMM.C.BACKUP.DIARIO.G0089V00                  VC1140          12/10/2025 1     
 RMM.C.BACKUP.DIARIO.G0090V00                  VC1142          13/10/2025 1     
 RMM.C.BACKUP.DIARIO.G0091V00                  VC1147          14/10/2025 1     
 RMM.C.BACKUP.DIARIO.G0092V00                  VC1153          15/10/2025 1     
 RMM.C.BACKUP.DIARIO.G0093V00                  VC0987          16/10/2025 1     
 RMM.C.BACKUP.DIARIO.G0094V00                  VC1075          17/10/2025 1     
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   EXIT                                                         

Programa Natural
* -------------------------------------------------------------------- *
* FUNCAO .: PESQUISA CARTUCHO NO TLMS USANDO O NOME DO LABEL           *
* AUTOR ..: CLAUDEMAR MARTINS                                          *
* -------------------------------------------------------------------- *
DEFINE DATA                                                             
LOCAL                                                                   
01 #DIRECTION (A1) INIT <'D'>   /* 'A' = ASCENDING                      
01 MONITORAMENTO VIEW OF AAFU-FITOTECA-RMM                              
  02 AAF-DATASET                                                        
  02 AAF-CARTUCHO                                                       
  02 AAF-OWNER                                                          
  02 AAF-DATA                                                           
  02 AAF-SEQUENCIA                                                      
01 #LABEL (A44) /* INIT <'ADABAS.C.SAVE.DB240.MES.G0199V00'>            
* -------------------------------------------------------------------- *
END-DEFINE                                                              
FORMAT LS=180 PS=20 KD=ON                                               
* -------------------------------------------------------------------- *
FORMAT KD=ON                                                            
SET KEY                                                                 
PF3  = PGM  NAMED 'EXIT'                                                
* -------------------------------------------------------------------- *
INPUT (IP=OFF SG=OFF AD=MIL'_')                                         
  02T '-' (78)                                                          
  /       02T *USER                                                     
  20T 'SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS' (I)                    
  72T  *PROGRAM                                                         
  /       02T  *TIME(AL=8)                                              
  11T '-' (60)                                                          
  72T  *DATE                                                            
  /    28T 'PESQUISA LABEL DE CARTUCHO'(I) 72T *LIBRARY-ID /            
* -------------------------------------------------------------------- *
  /                                                                     
  11T '-' (60)                                                          
  /                                                                     
  /14T'   LABEL :' #LABEL (AD=MIL'_')                                   
  //                                                                    
  11T '-' (60)                                                          
* -------------------------------------------------------------------- *
  //30T'TECLE PF3 PARA SAIR' (I)                                        
* -------------------------------------------------------------------- *
IF *PF-KEY EQ 'PF3'                                                     
  FETCH 'AADPA000'                                                      
END-IF                                                                  
* -------------------------------------------------------------------- *
READ MONITORAMENTO BY AAF-DATASET = #LABEL                              
* -------------------------------------------------------------------- *
DISPLAY                                                               
'DATASET' AAF-DATASET                                                   
'CART'    AAF-CARTUCHO                                                  
'OWNER'   AAF-OWNER                                                     
'DATA'    AAF-DATA                                                      
'SEQ'     AAF-SEQUENCIA                                                 
* -------------------------------------------------------------------- *
  WRITE TITLE LEFT JUSTIFIED                                            
    *TIME(AL=8) 27T 'CARTUCHO DO RMM' (I) 71T *DATE                    
  AT END OF PAGE                                                        
    INPUT ' '                                                           
    IF *PF-KEY EQ 'PF3'                                                 
      FETCH 'AADPA000'                                                  
    END-IF                                                              
  END-ENDPAGE                                                           
* -------------------------------------------------------------------- *
END-READ                                                                
FETCH 'AADPA002'                                                        
END                                                                     

AADPA003

Busca pelo dia, interessante pra gente saber o que rodou em um dia especifico no mainframe
                                                                                
  ------------------------------------------------------------------------------
  DBAP055           SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS            AADPA003
  10:02:30 ------------------------------------------------------------ 13/08/26
                      PESQUISA CARTUCHO - DATA DE GRAVACAO              RMM
                                                                                
           ------------------------------------------------------------         
                                                                                
                       DATA DE GRAVACAO .....: 13/08/2026                       
                                                                                
           ------------------------------------------------------------         
                                                                                
                              TECLE PF3 PARA SAIR                               
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   EXIT                                                         

Resultado
 MORE                                                                           
 10:03:43                  CARTUCHO DO TLMS                            13/08/26 
                    DATASET                     CART    DONO      DATA    SEQ   
 --------------------------------------------- ------ -------- ---------- ---   
                                                                                
 AAA.C.ACCOUNT.DIARIO.G4307V00                 VC1393 AAASMFDB 13/08/2026 1     
 AAB.C.RACF.BACKUP.DIARIO.G0446V00             VC1155 AABSRA02 13/08/2026 1     
 ADABAS.C.DB240.PLOG.G8182V00                  VC1360 ADABA01  13/08/2026 1     
 ADABAS.C.SAVE.DB240.DIA.G5628V00              VC1189 ADABA01  13/08/2026 1     
 ADABAS.C.SAVE.DB240.DIA.G5628V00              VC1286 ADABA01  13/08/2026 1     
 ADABAS.C.SAVE.DB240.DIA.G5628V00              VC1356 ADABA01  13/08/2026 1     
 ADABAS.C.SAVE.DB240.DIA.G5628V00              VC1357 ADABA01  13/08/2026 1     
 ADABAS.C.SAVE.DB240.DIA.G5628V00              VC1358 ADABA01  13/08/2026 1     
 ADABAS.C.SAVE.DB240.DIA.G5628V00              VC1359 ADABA01  13/08/2026 1     
 ADABAS.C.SAVE.DB240.DIA.G5628V00              VC1392 ADABA01  13/08/2026 1     
 RMM.C.BACKUP.DIARIO.G0396V00                  VC1452 RMM00010 13/08/2026 1     
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   MENU                                                         

Programa Natural
* -------------------------------------------------------------------- *
* FUNCAO .: PESQUISA CARTUCHO CRIADOS NO DIA ESPECIFICADO              *
* AUTOR ..: CLAUDEMAR MARTINS                                          *
* -------------------------------------------------------------------- *
DEFINE DATA                                                             
LOCAL                                                                   
01 MONITORAMENTO VIEW OF AAFU-FITOTECA-RMM                              
02 AAF-DATASET                                                          
02 AAF-CARTUCHO                                                         
02 AAF-OWNER                                                            
02 AAF-DATA                                                             
02 AAF-SEQUENCIA                                                        
01 #DIA   (A10)                                                         
* -------------------------------------------------------------------- *
END-DEFINE                                                              
FORMAT LS=80 PS=20                                                      
* -------------------------------------------------------------------- *
MOVE *DAT4E TO #DIA                                                     
* -------------------------------------------------------------------- *
FORMAT KD=ON                                                            
SET KEY                                                                 
PF3  = PGM  NAMED 'EXIT'                                                
* -------------------------------------------------------------------- *
  INPUT (IP=OFF SG=OFF AD=MIL'_')                                       
    02T '-' (78)                                                        
    /       02T *USER                                                   
    20T 'SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS' (I)                  
    72T  *PROGRAM                                                       
    /       02T  *TIME(AL=8)                                            
    11T '-' (60)                                                        
    72T  *DATE                                                          
/    22T 'PESQUISA CARTUCHO - DATA DE GRAVACAO'(I) 72T *LIBRARY-ID /    
* -------------------------------------------------------------------- *
/                                                                       
11T '-' (60)                                                            
/                                                                       
/12T'           DATA DE GRAVACAO .....:' #DIA (AD=MIL'_')               
//                                                                      
11T '-' (60)                                                            
* -------------------------------------------------------------------- *
//30T'TECLE PF3 PARA SAIR' (I)                                          
* -------------------------------------------------------------------- *
   IF *PF-KEY EQ 'PF3'                                                  
   FETCH 'AADPA000'                                                     
   END-IF                                                               
* -------------------------------------------------------------------- *
* READ     MONITORAMENTO            BY AAF-DSN  = #DIA                  
* -------------------------------------------------------------------- *
  FIND  MONITORAMENTO WITH AAF-DATA  = #DIA                             
   SORTED BY AAF-DATASET   /* AAF-VOLSEQ  /* DESCENDING                 
   IF NO RECORDS FOUND                                                  
   REINPUT 'NAO TEM CARTUCHO GRAVADO NESTE DIA' /*  MARK #CARTUCHO      
   END-NOREC                                                            
* -------------------------------------------------------------------- *
 DISPLAY                                                                
'DATASET' AAF-DATASET                                                   
'CART'    AAF-CARTUCHO                                                  
'DONO'    AAF-OWNER                                                     
'DATA'    AAF-DATA                                                      
'SEQ'     AAF-SEQUENCIA                                                 
* -------------------------------------------------------------------- *
  WRITE TITLE LEFT JUSTIFIED                                            
  *TIME(AL=8) 27T 'CARTUCHO DO TLMS' (I) 71T *DATE                      
  AT END OF PAGE                                                        
     INPUT ' '                                                          
     IF *PF-KEY EQ 'PF3'                                                
        FETCH 'AADPA000'                                                
     END-IF                                                             
  END-ENDPAGE                                                           
* -------------------------------------------------------------------- *
  END-FIND                                                              
    FETCH 'AADPA003'                                                    
  END                                                                   

AADPA004

Pesquisando quem é o Owner
                                                                                
  ------------------------------------------------------------------------------
  DBAP055           SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS            AADPA004
  10:07:34 ------------------------------------------------------------ 13/08/26
                                PESQUISA OWNER                          RMM
                                                                                
           ------------------------------------------------------------         
                                                                                
                         DIGITE O OWNER ..: RMM_____                            
                                                                                
           ------------------------------------------------------------         
                                                                                
                              TECLE PF3 PARA SAIR                               
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   EXIT                                                         

Resultado
                                                                                
 10:07:51                 PESQUISANDO OS OWNER DO RMM                  13/08/26 
                                                                                
 ALA.C.AUT.L.BKP1.R111997.COM0                 CT0774 RMM      08/10/1998 2     
 ALA.C.AUT.L.BKP2.R111997.COM0                 CT0774 RMM      08/10/1998 3     
 ALA.C.AUT.L.BKP1.R131997.FOL0                 CT0774 RMM      08/10/1998 4     
 ALA.C.AUT.L.BKP2.R131997.FOL0                 CT0774 RMM      08/10/1998 5     
 ALA.C.AUT.L.BKP1.R131997.COM1                 CT0774 RMM      08/10/1998 6     
 ALA.C.AUT.L.BKP2.R131997.COM2                 CT0774 RMM      08/10/1998 7     
 ALA.C.AUT.L.BKP1.R121997.FOL2                 CT0774 RMM      08/10/1998 8     
 ALA.C.AUT.L.BKP2.R121997.FOL2                 CT0774 RMM      08/10/1998 9     
 ALA.C.AUT.L.BKP3.R121997.FOL2                 CT0774 RMM      08/10/1998 10    
 ALA.C.AUT.L.BKP1.R121997.COM0                 CT0774 RMM      08/10/1998 11    
 ALA.C.AUT.L.BKP2.R121997.COM0                 CT0774 RMM      08/10/1998 12    
 ADABAS.C.SAVE.RH.DATA.ALL210.MES.G0018V00     CT0775 RMM      13/11/2005 1     
 ALA.C.DIR.L.BKP.A1997                         CT0777 RMM      07/04/2010 1     
 ALA.C.DIR.L.BKP2.R061997.PRE0.SEFOP.PG02      CT0777 RMM      07/04/2010 2     
 ALA.C.DIR.L.BKP3.R061997.PRE0.SEFOP.PG02      CT0777 RMM      07/04/2010 3     
 AAH.C.SAVE.F2324.G0010V00                     CT0778 RMM      17/01/2001 1     
 ALA.C.DIR.S.BKP1.R011998.FOL2                 CT0779 RMM      10/03/1998 1     
 ALA.C.DIR.S.BKP2.R011998.FOL2                 CT0779 RMM      10/03/1998 2     
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   EXIT                                                         

Programa Natural
* -------------------------------------------------------------------- *
* FUNCAO .: PESQUISA O OWNER NO TLMS USANDO O NUMERO DO CARTUCHO       *
* AUTOR ..: CLAUDEMAR MARTINS DE SA                                    *
* -------------------------------------------------------------------- *
DEFINE DATA                                                             
LOCAL                                                                   
01 TLMS VIEW OF AAFU-FITOTECA-RMM                                       
  02 AAF-DATASET                                                        
  02 AAF-CARTUCHO                                                       
  02 AAF-OWNER                                                          
  02 AAF-DATA                                                           
  02 AAF-SEQUENCIA                                                      
01 #CARTUCHO                      (A8)                                  
* -------------------------------------------------------------------- *
END-DEFINE                                                              
FORMAT LS=80 PS=20                                                      
* -------------------------------------------------------------------- *
FORMAT KD=ON                                                            
SET KEY                                                                 
PF3  = PGM  NAMED 'EXIT'                                                
* -------------------------------------------------------------------- *
INPUT (IP=OFF SG=OFF AD=MIL'_')                                         
  02T '-' (78)                                                          
  /       02T *USER                                                     
  20T 'SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS' (I)                    
  72T  *PROGRAM                                                         
  /       02T  *TIME(AL=8)                                              
  11T '-' (60)                                                          
  72T  *DATE                                                            
  /                                                                     
  32T 'PESQUISA OWNER'(I) 72T *LIBRARY-ID /                             
  /                                                                     
  11T '-' (60)                                                          
  /                                                                     
  /15T'          DIGITE O OWNER ..:'#CARTUCHO (AD=MIL'_')               
  //                                                                    
  11T '-' (60)                                                          
  /                                                                     
  /30T'TECLE PF3 PARA SAIR' (I)                                         
IF *PF-KEY EQ 'PF3'                                                     
  FETCH 'AADPA000'                                                      
END-IF                                                                  
* -------------------------------------------------------------------- *
* READ     MONITORAMENTO            BY AAF-CARTUCHO  = #CARTUCHO        
* -------------------------------------------------------------------- *
FIND  TLMS WITH AAF-OWNER     = #CARTUCHO                               
* -------------------------------------------------------------------- *
  WRITE                                                                 
    AAF-DATASET                                                         
    AAF-CARTUCHO                                                        
    AAF-OWNER                                                           
    AAF-DATA                                                            
    AAF-SEQUENCIA                                                       
* -------------------------------------------------------------------- *
  WRITE  TITLE LEFT                                                     
    *TIME(AL=8) 26T 'PESQUISANDO OS OWNER DO RMM' (I) 71T *DATE         
    /                                                                   
  AT END OF PAGE                                                        
    INPUT ' '                                                           
    IF *PF-KEY EQ 'PF3'                                                 
      FETCH 'AADPA000'                                                  
    END-IF                                                              
  END-ENDPAGE                                                           
* -------------------------------------------------------------------- *
END-FIND                                                                
FETCH   'AADPA004'                                                      
END                                                                     

View

Esses programas usaram a view abaixo
 09:31:20               ***** NATURAL LIST COMMAND *****              13/08/2026
 User DBAP055            - List DDM AAFU-FITOTECA-RMM -         Library RMM
                                                                                
 DDM DBID 0      DDM FNR 433   VSAM Name          Default Sequence     Page   1 
                                                                                
 T L  DB  Name                             F Leng  S D Remark                   
 - -  --  -------------------------------- - ----  - - ------------------------ 
 *        Generation started                                                    
 *        at 2025-12-29 09:09:11                                                
 *        by user DBAP055                                                       
 *                                                                              
   1  AA  AAF-DATASET                      A   45  N D                          
   1  AB  AAF-CARTUCHO                     A    6  N D                          
   1  AC  AAF-OWNER                        A    8  N D                          
   1  AD  AAF-DATA                         A   10  N D                          
   1  AE  AAF-SEQUENCIA                    A    3  N                            
   1  AF  AAF-LIBERADO                     A    7  N                            
                                                                                
                                                                                
                                                                                
 End of List.                                                                   
 Command ===>                                                                   
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
       Help  Print Exit  Short       --    -     +     ++                Canc

Carga do RMM

Esse foi o JCL utilizado para fazer a carga dos dados do RMM para o Adabas
//AADPA001 JOB (AABS,DIST),CLAUDEMAR,CLASS=S,MSGCLASS=A,USER=AASUB06
//*UQ ALLOW                                                         
//* ----------------------------------------------------------------
//*       LISTAR OS CARTUCHOS DO RMM E SALVAR NO BANCO ADABAS       
//* ----------------------------------------------------------------
//  SET DSN1=AAF.S.TSSUSER.CLAU                                     
//  SET DSN2=AAF.S.BKP242                                           
//* ----------------------------------------------------------------
//*       DELETANDO REGISTROS DO FILE ANTES DE CARREGAR - 240       
//* ----------------------------------------------------------------
//STEP0105 EXEC NATURAL,PARM1='SYS=P,MT=0,STACK=(LOGON RMM)'   
//SYSPRINT DD SYSOUT=A                                              
//CMWKF01  DD SYSOUT=A                                              
//CMPRT01  DD DUMMY                                                 
//SYSIN    DD *                                                     
AADPA005                                                            
//* ----------------------------------------------------------------
//*               GERANDO DADOS DOS CARTUCHOS DO RMM                
//* ----------------------------------------------------------------
//STEP0205 EXEC PGM=IKJEFT01,REGION=4096K                           
//SYSTSPRT DD DISP=SHR,DSN=&DSN1                                    
//SYSPRINT DD SYSOUT=A                                              
//SYSTSIN  DD *                                                     
  RMM SEARCHDATASET OWNER(*) SINCE(91073) LIMIT(*)                  
//* ----------------------------------------------------------------
//*           FILTRO/CLASSFICACAO DOS CARTUCHOS RETIDOS             
//* ----------------------------------------------------------------
//STEP0305 EXEC PGM=SORT                                            
//SYSPRINT DD SYSOUT=Z                                              
//SYSOUT   DD SYSOUT=Z                                              
//SORTIN   DD DISP=SHR,DSN=&DSN1                                    
//SORTOUT  DD DISP=SHR,DSN=&DSN2                                    
//SORTWK1  DD DSN=&&TEMP01,DISP=(NEW,PASS),                         
//           SPACE=(CYL,2),UNIT=SYSDA,                              
//           DCB=(LRECL=133,BLKSIZE=1330,RECFM=FBA)                 
//* --------------------------------------------------------------  
//SYMNAMES  DD *                                                    
  LABEL;1,46,CH                                                     
  CT;47,2,CH                                                        
  CARTUCHO;49,4,CH                                                  
  DATA;63,10,CH                                                     
  SEQ;75,4,CH                                                       
//SYSIN    DD *                                                     
  SORT FIELDS=(CT,A,CARTUCHO,A,75,4,UFF,A)                          
  INCLUDE COND=(CT,EQ,C'CT',OR,CT,EQ,C'TP',OR,CT,EQ,C'VC')          
/*                                                                  
//* --------------------------------------------------------------- 
//*                      ICEGENER PARA A SYSOUT                     
//* --------------------------------------------------------------- 
//STEP0405 EXEC PGM=ICEGENER                                        
//SYSPRINT DD SYSOUT=A                                              
//SYSUT1   DD DISP=SHR,DSN=&DSN2                                    
//SYSUT2   DD SYSOUT=A                                              
//SYSIN    DD DUMMY                                                 
//* ----------------------------------------------------------------
//*                  GRAVANDO NO FILE 433 BANCO 240                 
//* ----------------------------------------------------------------
//STEP0505 EXEC NATURAL,PARM1='SYS=P,MT=0,STACK=(LOG RMM)'     
//CMWKF01  DD DISP=SHR,DSN=&DSN2                                    
//CMPRINT  DD SYSOUT=A                                              
//CMPRT01  DD SYSOUT=A,HOLD=YES
//SYSIN    DD *                
RMM0003                        
/*

AADPA005

Limpando os dados antes de fazer a carga no file onde estão os dados do RMM no Adabas
* -------------------------------------------------------------------- *
* FUNCAO: LIMPAR OS DADOS DO FILE 433 DO ADABAS ANTES DA RECARGA       *
* AUTOR : CLAUDEMAR MARTINS DE SA                                      *
* -------------------------------------------------------------------- *
DEFINE DATA LOCAL                                                       
01 RMM VIEW OF AAFU-FITOTECA-RMM                                        
  02 AAF-DATASET  /* CAMPO APENAS PARA REFERENCIA NA VIEW               
01 #TOTAL-DELETED (N7)                                                  
01 #CTR-COMMIT    (N7)                                                  
END-DEFINE                                                              
* -------------------------------------------------------------------- *
* LER TODOS OS REGISTROS DO ARQUIVO                                    *
* -------------------------------------------------------------------- *
READ RMM BY ISN                                                         
  DELETE (0140)                                                         
  ADD 1 TO #TOTAL-DELETED                                               
  ADD 1 TO #CTR-COMMIT                                                  
* -------------------------------------------------------------------- *
* QUANDO CHEGAR EM 500, ZERA O CONTADOR E FAZ O COMMIT                  
* -------------------------------------------------------------------- *
  IF #CTR-COMMIT GE 500                                                 
    END TRANSACTION                                                     
    RESET #CTR-COMMIT                                                   
  END-IF                                                                
END-READ                                                                
END TRANSACTION                                                         
* -------------------------------------------------------------------- *
WRITE 'PROCESSAMENTO CONCLUIDO.'                                        
WRITE 'TOTAL DE REGISTROS DELETADOS:' #TOTAL-DELETED                    
END                                                                     

RMM0003

Programa que faz a carga dos dados do RMM que estão em um dataset e grava em um file Adabas
* -------------------------------------------------------------------- *
*  FUNCAO: GRAVANDO OS DADOS DO RMM PARA UM FILE ADABAS                 
*  AUTOR : CLAUDEMAR MARTINS                                            
* -------------------------------------------------------------------- *
DEFINE DATA LOCAL                                                       
01 RMM VIEW OF AAFU-FITOTECA-RMM                                        
  02 AAF-DATASET                                                        
  02 AAF-CARTUCHO                                                       
  02 AAF-OWNER                                                          
  02 AAF-DATA                                                           
  02 AAF-SEQUENCIA                                                      
* -------------------------------------------------------------------- *
01 #DADOS-GENERICOS (A79)                                               
01 REDEFINE #DADOS-GENERICOS                                            
  02 FILLER                   1X                                        
  02 #DSN                     (A44)                                     
  02 FILLER                   1X                                        
  02 #VOLUME                  (A06)                                     
  02 FILLER                   1X                                        
  02 #OWNER                   (A08)                                     
  02 FILLER                   1X                                        
  02 #CREATE_DATE             (A11)                                     
  02 REDEFINE  #CREATE_DATE                                             
    03 #DIA                   (A02)                                     
    03 #SEPARATOR1            (A01)                                     
    03 #MES                   (A02)                                     
    03 #SEPARATOR2            (A01)                                     
    03 ANO                    (A04)                                     
  02 FILLER                   1X                                        
  02 #SEQ                     (N05)                                     
END-DEFINE                                                              
* -------------------------------------------------------------------- *
* GRAVANDO OS DADOS                                                     
* -------------------------------------------------------------------- *
READ WORK FILE 1 #DADOS-GENERICOS                                       
* -------------------------------------------------------------------- *
  IF   #SEPARATOR1 EQ '/'                                               
    AAF-DATASET     :=  #DSN                                            
    AAF-CARTUCHO    :=  #VOLUME                                         
    AAF-OWNER       :=  #OWNER                                          
    AAF-DATA        :=  #CREATE_DATE
    AAF-SEQUENCIA   :=  #SEQ        
  END-IF                            
* -------------------------------------------------------------------- *
* GRAVAR NO BANCO DE DADOS                                          
* -------------------------------------------------------------------- *
  STORE RMM                                                             
  END TRANSACTION                                                       
END-WORK                                                                
END
Leia Mais

quarta-feira, agosto 12, 2026

Criando Sistemas em Natural/Adabas - Infoprint

Neste post, apresento a estrutura inicial de um sistema desenvolvido em Natural/Adabas, projetado para centralizar a administração do InfoPrint Server no ambiente Mainframe — solução responsável pelo gerenciamento de impressões dos usuários. O objetivo principal da aplicação é reunir, em uma única interface, as rotinas operacionais, de suporte e de manutenção do ambiente de impressão. Em vez de o operador executar programas isolados, o sistema oferece um menu principal intuitivo que atua como porta de entrada. A partir da seleção de opções numéricas, o operador acessa rotinas específicas para consultas, inclusões, alterações, exclusões, processamentos e rotinas de backup, simplificando significativamente o dia a dia da equipe de suporte.

                                                                                
  ------------------------------------------------------------------------------
  DBAP055           SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS           INFOMENU
  07:42:04 ------------------------------------------------------------ 12/08/26
                                INFOPRINT SERVER                        INFOPRIN
                                                                                
  ------------------------------------------------------------------------------
        010 - INFOPRINT LOG PRINT            050 - CRIACAO DE PICS              
        020 - CONSULTAR IMPRESSORA           060 - DELETAR PICS                 
        030 - DISPONIVEL PICS/TICS           070 - BACKUP INFOPRINT             
        040 - MODIFICAR IMPRESSORA           080 - FORMS INFOPRINT              
  ------------------------------------------------------------------------------
                                                                                
                           DIGITE A OPCAO DESEJADA 0__                          
                                                                                
                              TECLE PF3 PARA SAIR                               
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   EXIT                                            LOG   QUIT   

Programa inicial - infomenu
* ==================================================================== *
* FUNCAO: MENU DE OPCOES PARA O INFOPRINT                              *
*  AUTOR: CLAUDEMAR MARTINS DE SA                                      *
*  DATA : 15/12/2024                                                   *
* ==================================================================== *
DEFINE DATA LOCAL                                                       
1 #ARQ1 (N3)                                                            
END-DEFINE                                                              
* ==================================================================== *
FORMAT KD=ON                                                            
SET KEY                                                                 
  TREQ        NAMED ' '   /* NOVAS PFS /*                               
PF3  = PGM NAMED 'EXIT'                                                 
PF11 = 'INFO0107' NAMED 'LOG'                                           
PF12 = PGM  NAMED 'QUIT'                                                
* ==================================================================== *
REPEAT                                                                  
  INPUT (IP=OFF SG=OFF AD=MIL'_')                                       
    02T '-' (78)                                                        
    /02T *USER                                                          
        20T 'SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS' (I)                  
    72T *PROGRAM                                                        
    /02T *TIME(AL=8) 11T '-' (60) 72T  *DATE                            
    /32T 'INFOPRINT SERVER'(I) 72T *LIBRARY-ID /                        
* ==================================================================== *
    /2T '-' (78)                                                        
    /8T '010 - INFOPRINT LOG PRINT  '(I)                                
    45T '050 - CRIACAO DE PICS      '(I)                                
    /8T '020 - CONSULTAR IMPRESSORA '(I)                                
    45T '060 - DELETAR PICS         '(I)                                
    /8T '030 - DISPONIVEL PICS/TICS '(I)                                
    45T '070 - BACKUP INFOPRINT     '(I)                                
    /8T '040 - MODIFICAR IMPRESSORA '(I)                                
    45T '080 - FORMS INFOPRINT      '(I)                                
    /2T '-' (78)                                                        
* ==================================================================== *
    // 27T'DIGITE A OPCAO DESEJADA'(YE) #ARQ1(AD=MIL'_')                
    // 30T'TECLE PF3 PARA SAIR'(I)                                      
* ==================================================================== *
  IF #ARQ1 EQ  10   FETCH 'INFO0123'                                    
  IF #ARQ1 EQ  20   FETCH 'INFO0105'                                    
  IF #ARQ1 EQ  30   FETCH 'INFO0101'                                    
  IF #ARQ1 EQ  40   FETCH 'INFO0109'                                    
  IF #ARQ1 EQ  50   FETCH 'INFO0103'                                    
  IF #ARQ1 EQ  60   FETCH 'INFO0104'                                    
  IF #ARQ1 EQ  70   FETCH 'INFO0108'                                    
  IF #ARQ1 EQ  80   FETCH 'INFO0113'                                    
* ==================================================================== *
  IF *PF-KEY EQ 'PF3' OR = 'PF12' TERMINATE                             
  IF *PF-KEY EQ 'PF11' FETCH 'INFO0107'                                 
* ==================================================================== *
END                                                                     

Opção 10

Essa opção submete um job para ver o log das impressoras do Infoprint;
                                                                                
  ------------------------------------------------------------------------------
  DBAP055           SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS           INFO0123
  07:47:27 ------------------------------------------------------------ 12/08/26
                              INFOPRINT PRINT LOG                               
                                                                                
           ------------------------------------------------------------         
                                                                                
                           TECLE ENTER PARA CONTINUAR                           
                                                                                
           ------------------------------------------------------------         
                                                                                
                                                                                
                            TECLE PF3 PARA VOLTAR                               
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   MENU                                                         

Esse é o programa Natural que submete um job
* ------------------------------------------------------------------- *
* FUNCAO: LISTAR O LOG DO INFOPRINT                                   *
*  AUTOR: CLAUDEMAR MARTINS DE SA                                     *
* ------------------------------------------------------------------- *
DEFINE DATA LOCAL                                                      
1 #CALLER   (A4) INIT <'NAT '>                                         
1 #JOBNUM   (A8)                                                       
1 REDEFINE #JOBNUM                                                     
  2 #JOBA   (A3)                                                       
  2 #JOBN   (N5)                                                       
1 #I        (P3)                                                       
1 #RC       (B4)                                                       
1 #TOT      (B2)                                                       
1 #ARQ      (A32)                                                      
1 #DBID     (A3)                                                       
1 #FILE     (N3)                                                       
1 #ISNSIZE  (N1)                                                       
1 #NISIZE   (N9)                                                       
1 #UISIZE   (N9)                                                       
1 #DSSIZE   (N9)                                                       
1 #MAXISN   (N13)                                                    
1 #C01 (A80) INIT                                                    
    <'//AAFSNATB JOB (XXXX,OSB),XXXXXXX,CLASS=S,MSGCLASS=A'>         
1 REDEFINE #C01                                                      
  2 FILLER  2X                                                       
  2 #JOBNAME (A8)                                                    
  2 #FIL1 (A06)                                                      
  2 #ACC  (A04)                                                      
  2 #FIL2 (A06)                                                      
  2 #USER (A07)                                                      
1 #C02 (A80) INIT <'//*UQ ALLOW'>                                    
1 #C03 (A80) INIT                                                    
  <'//* -----------------------------------------------------'>      
1 #C04 (A80) INIT                                                    
  <'//*         INFOPRINT LOG DE ERRO NA SYSOUT DO JOB'>             
1 #C05 (A80) INIT                                                    
  <'//* -----------------------------------------------------'>      
1 #C06 (A80) INIT <'//STEP1    EXEC PGM=ICEGENER'>                   
1 #C07 (A80) INIT <'//SYSPRINT DD SYSOUT=A'>                         
1 #C08 (A80) INIT <'//SYSUT1   DD DSN=AOP.PRINTWAY.MSGFILE,DISP=SHR'>
1 #C09 (A80) INIT <'//SYSUT2   DD SYSOUT=G'>                            
1 #C10 (A80) INIT <'//SYSIN    DD DUMMY'>                               
1 #Y2K (A1)  INIT <'N'>                                                 
END-DEFINE                                                              
* ==================================================================== *
FORMAT KD=ON                                                            
SET CONTROL 'U'                                                         
SET KEY PF3 NAMED 'MENU'                                                
  PF8 NAMED '    ' PF9 NAMED '     '                                    
MOVE *INIT-USER TO #USER                                                
REPEAT                                                                  
  RESET INITIAL #Y2K                                                    
* ==================================================================== *
  INPUT (IP=OFF SG=OFF AD=MIL'_')                                       
    02T '-' (78)                              /                         
    02T *USER                                                           
    20T 'SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS' (I)                  
    72T  *PROGRAM                             /                         
    02T  *TIME(AL=8)                                                    
    11T '-' (60)                                                        
    72T  *DATE                                /                         
    30T 'INFOPRINT PRINT LOG' (I)   //                                  
    11T '-' (60)                              //                        
    27T 'TECLE ENTER PARA CONTINUAR' (I)      //                        
    11T '-' (60)                              //                        
*                                                                       
    /28T'TECLE PF3 PARA VOLTAR'(I)                                      
  IF *PF-KEY EQ 'PF3'                                                   
    FETCH 'INFOMENU'                                                    
  END-IF                                                                
* ==================================================================== *
  COMPUTE #TOT = 10 * 80                                                
  CALL 'RJE' #RC #C01 #TOT                                              
  CALL 'GETJOB' #JOBNUM #CALLER                                         
* ==================================================================== *
  FORMAT KD=OFF                                                         
  DEFINE WINDOW NUMJOB                                                  
    SIZE 08 * 50    BASE 08/17   TITLE ' NUMERO DO JOB '                
    FRAMED ON                                                           
  INPUT WINDOW = 'NUMJOB'                                               
    01/01 'FOI SUBMETIDO O JOB:  ' #JOBNAME  (AD=IO)                    
    02/01 'COM O NUMERO ......:'  #JOBN     (AD=IO)                     
    03/01 '                       '                                     
    04/11 'TECLE ENTER PARA VOLTAR'(I)                                  
* ==================================================================== *
  FETCH 'INFOMENU'                                                      
END-REPEAT                                                              
END                                                                     

Opção 20

Essa opção pesquisa as impressoras cadastradas no infoprint na carga que foi feita para um arquivo Adabas - essa opção é um menu para pesquisar o nome da impressora e pesquisar o IP
                                                                                
  ------------------------------------------------------------------------------
  DBAP055           SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS           INFO0105
  07:58:25 ------------------------------------------------------------ 12/08/26
                                CONSULTANDO PICS                        INFOPRIN
                                                                                
           ------------------------------------------------------------         
                        10 - PESQUISANDO PICS DA IMPRESSORA                     
                        20 - PESQUISANDO IP DA IMPRESSORA                       
           ------------------------------------------------------------         
                                                                                
                           DIGITE A OPCAO DESEJADA 0__                          
                                                                                
                              TECLE PF3 PARA SAIR                               
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   EXIT                                            LOG   QUIT   

Esse é o programa Natural
* ==================================================================== *
* FUNCAO: MENU DE PESQUISA DE IMPRESSORA                               *
*  AUTOR: CLAUDEMAR MARTINS DE SA                                      *
*  DATA : 15/12/2024                                                   *
* ==================================================================== *
DEFINE DATA LOCAL                                                       
1 #ARQ1 (N3)                                                            
END-DEFINE                                                              
* ==================================================================== *
FORMAT KD=ON                                                            
SET KEY                                                                 
  TREQ        NAMED ' '   /* NOVAS PFS /*                               
PF3  = PGM NAMED 'EXIT'                                                 
PF11 = 'INFO0107' NAMED 'LOG'                                           
PF12 = PGM  NAMED 'QUIT'                                                
* ==================================================================== *
REPEAT                                                                  
  INPUT (IP=OFF SG=OFF AD=MIL'_')                                       
    02T '-' (78)                                                        
    /02T *USER                                                          
    /02T *USER                                                          
    20T 'SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS' (I)                  
    72T *PROGRAM                                                        
    /02T *TIME(AL=8) 11T '-' (60) 72T  *DATE                            
    /32T 'CONSULTANDO PICS'(I) 72T *LIBRARY-ID /                        
    /11T '-' (60)                                                       
    /24T '10 - PESQUISANDO PICS DA IMPRESSORA'(I)                       
    /24T '20 - PESQUISANDO IP DA IMPRESSORA'(I)                         
    /11T'-' (60)                                                        
* ==================================================================== *
    // 27T'DIGITE A OPCAO DESEJADA'(YE) #ARQ1(AD=MIL'_')                
    // 30T'TECLE PF3 PARA SAIR'(I)                                      
* ==================================================================== *
  IF #ARQ1 EQ  10   FETCH 'INFO0995'                                    
  IF #ARQ1 EQ  20   FETCH 'INFO0106'                                    
* ==================================================================== *
  IF *PF-KEY EQ 'PF3' OR = 'PF12' FETCH 'INFOMENU'                      
  IF *PF-KEY EQ 'PF11' FETCH 'INFO0107'                                 
* ==================================================================== *
END                                                                     

Pesquisando Nome da Impressora

INFO0995 - Pesquisando o nome da impressora
                                                                                
  ------------------------------------------------------------------------------
  DBAP055           SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS           INFO0995
  08:22:54 ------------------------------------------------------------ 12/08/26
                           CONSULTANDO APLICATIVOS                              
                                                                                
           ------------------------------------------------------------         
                                                                                
                     DIGITE A PICS .................: ________                  
                                                                                
           ------------------------------------------------------------         
                                                                                
                              TECLE PF3 PARA VOLTAR                             
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   MENU                                            LOG          

Esse é o programa Natural
* -------------------------------------------------------------------- *
* FUNCAO ...: PESQUISAR IMPRESSORAS DO INFOPRINT                       *
* CRIADO ...: CLAUDEMAR MARTINS DE SA                                  *
* -------------------------------------------------------------------- *
DEFINE DATA LOCAL                                                       
1 IMPRESSORA-VIEW VIEW OF AAFU-INFOPRINT-PRINTWAY                       
  2 PRINTER-NAME                                                        
  2 PRINTER-TYPE                                                        
  2 LOCATION                                                            
  2 LUNAME                                                              
  2 DESTINATION                                                         
  2 OUTPUT-CLASS                                                        
  2 PRINT-QUEUE-NAME                                                    
  2 PRINTER-IP-ADDRESS                                                  
  2 DESCRIPTION                                                         
  2 LPR-PRINT-FUNCTION                                                  
  2 LPR-MODE                                                            
  2 INCLUDE-PRINTWAY-OPTIONS                                            
* -------------------------------------------------------------------- *
1 #PICS                 (A8)                                            
1 #PRINTER-NAME         (A10/01)                                        
1 #PRINTER-TYPE         (A20/01)                                        
1 #LOCATION             (A53/01)                                        
1 #LUNAME               (A10/01)                                        
1 #DESTINATION          (A10/01)                                        
1 #OUTPUT-CLASS         (A01/01)                                        
1 #PRINT-QUEUE-NAME     (A20/01)                                        
1 #PRINTER-IP-ADDRESS   (A15/01)                                        
1 #DESCRIPTION          (A53/01)                                        
1 #LPR-PRINT-FUNCTION   (A02/01)                                        
1 #LPR-MODE             (A18/01)                                        
1 #INCLUDE-PRINTWAY-OPTIONS (A9/01)                                     
1 #CONTA                (N2)                                            
END-DEFINE                                                              
FORMAT LS=180 PS=60                                                     
* =====================================================================*
FORMAT KD=ON                                                            
SET CONTROL 'U'                                                         
SET KEY PF3 = 'INFO0105' NAMED 'MENU'                                   
REPEAT                                                                  
* ===================================================================== 
  INPUT (IP=OFF SG=OFF AD=MIL'_')                                       
    02T '-' (78)                                                        
    /       02T *USER                                                   
    20T 'SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS' (I)                  
    72T  *PROGRAM                                                       
    /       02T  *TIME(AL=8)                                            
    11T '-' (60)                                                        
    72T  *DATE                                                          
    /      27T 'CONSULTANDO APLICATIVOS' (I)                            
    //                                                                  
    11T '------------------------------------------------------------'  
    //                                                                  
    11T '          DIGITE A PICS .................:' #PICS              
    //                                                                  
    11T '------------------------------------------------------------'  
    //30T'TECLE PF3 PARA VOLTAR'(I)                                     
* ==================================================================== *
  IF *PF-KEY EQ 'PF3' FETCH 'OPERP600' END-IF                           
  IF *PF-KEY EQ 'PF4' FETCH 'OPERP602' END-IF                           
* ==================================================================== *
  FIND (1) IMPRESSORA-VIEW WITH PRINTER-NAME =  #PICS                   
    IF NO RECORDS FOUND                                                 
* ==================================================================== *
      INPUT USING MAP 'OPERM502'                                        
      FETCH 'INFO0995'                                                  
    END-NOREC                                                           
    ADD 1 TO #CONTA                                                     
* ==================================================================== *
 MOVE PRINTER-NAME                 TO #PRINTER-NAME             (#CONTA)
 MOVE PRINTER-TYPE                 TO #PRINTER-TYPE             (#CONTA)
 MOVE LOCATION                     TO #LOCATION                 (#CONTA)
 MOVE LUNAME                       TO #LUNAME                   (#CONTA)
 MOVE DESTINATION                  TO #DESTINATION              (#CONTA)
 MOVE OUTPUT-CLASS                 TO #OUTPUT-CLASS             (#CONTA)
 MOVE PRINT-QUEUE-NAME             TO #PRINT-QUEUE-NAME         (#CONTA)
 MOVE PRINTER-IP-ADDRESS           TO #PRINTER-IP-ADDRESS       (#CONTA)
 MOVE DESCRIPTION                  TO #DESCRIPTION              (#CONTA)
 MOVE LPR-PRINT-FUNCTION           TO #LPR-PRINT-FUNCTION       (#CONTA)
 MOVE LPR-MODE                     TO #LPR-MODE                 (#CONTA)
 MOVE INCLUDE-PRINTWAY-OPTIONS     TO #INCLUDE-PRINTWAY-OPTIONS (#CONTA)
* ===================================================================== 
  INPUT USING MAP 'INFO0996'                                            
  END-FIND        
  FETCH 'INFO0995'
* ===================================================================== 
END-REPEAT        
END

Pesquisando IP da Impressora

Programa INFO0106 - Pesquisando pelo IP
                                                                                
  ------------------------------------------------------------------------------
  DBAP055           SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS           INFO0106
  08:25:38 ------------------------------------------------------------ 12/08/26
                           CONSULTANDO APLICATIVOS                              
                                                                                
           ------------------------------------------------------------         
                                                                                
                 DIGITE O IP ...................: ________________              
                                                                                
           ------------------------------------------------------------         
                                                                                
                              TECLE PF3 PARA VOLTAR                             
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   MENU                                            LOG           

Esse programa - abaixa vamos criar a view
* -------------------------------------------------------------------- *
* FUNCAO ...: PESQUISAR IMPRESSORAS DO INFOPRINT                       *
* CRIADO ...: CLAUDEMAR MARTINS DE SA                                  *
* -------------------------------------------------------------------- *
DEFINE DATA LOCAL                                                       
1 IMPRESSORA-VIEW VIEW OF AAFU-INFOPRINT-PRINTWAY                       
  2 PRINTER-NAME                                                        
  2 PRINTER-TYPE                                                        
  2 LOCATION                                                            
  2 LUNAME                                                              
  2 DESTINATION                                                         
  2 OUTPUT-CLASS                                                        
  2 PRINT-QUEUE-NAME                                                    
  2 PRINTER-IP-ADDRESS                                                  
  2 DESCRIPTION                                                         
  2 LPR-PRINT-FUNCTION                                                  
  2 LPR-MODE                                                            
  2 INCLUDE-PRINTWAY-OPTIONS                                            
* -------------------------------------------------------------------- *
1 #PICS                       (A16)                                     
1 #PRINTER-NAME               (A10/11)                                  
1 #PRINTER-TYPE               (A20/11)                                  
1 #LOCATION                   (A53/11)                                  
1 #LUNAME                     (A10/11)                                  
1 #DESTINATION                (A10/11)                                  
1 #OUTPUT-CLASS               (A01/11)                                  
1 #PRINT-QUEUE-NAME           (A20/11)                                  
1 #PRINTER-IP-ADDRESS         (A15/11)                                  
1 #DESCRIPTION                (A53/11)                                  
1 #LPR-PRINT-FUNCTION         (A02/11)                                  
1 #LPR-MODE                   (A18/11)                                  
1 #INCLUDE-PRINTWAY-OPTIONS   (A9/11)                                   
1 #CONTA                      (N2)                                      
END-DEFINE                                                              
FORMAT LS=180 PS=60                                                     
* =====================================================================*
FORMAT KD=ON                                                            
SET CONTROL 'U'                                                         
SET KEY PF3 = 'INFO0105' NAMED 'MENU'                                   
REPEAT                                                                  
* ===================================================================== 
  INPUT (IP=OFF SG=OFF AD=MIL'_')                                       
    02T '-' (78)                                                        
    /       02T *USER                                                   
    20T 'SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS' (I)                  
    72T  *PROGRAM                                                       
    /       02T  *TIME(AL=8)                                            
    11T '-' (60)                                                        
    72T  *DATE                                                          
    /      27T 'CONSULTANDO APLICATIVOS' (I)                            
    //                                                                  
    11T '------------------------------------------------------------'  
    //                                                                  
    07T '          DIGITE O IP ...................:' #PICS              
    //                                                                  
    11T '------------------------------------------------------------'  
    //30T'TECLE PF3 PARA VOLTAR'(I)                                     
* ==================================================================== *
  IF *PF-KEY EQ 'PF3' FETCH 'INFO0105' END-IF                           
  IF *PF-KEY EQ 'PF4' FETCH 'INFO0105' END-IF                           
* ==================================================================== *
  FIND IMPRESSORA-VIEW WITH PRINTER-IP-ADDRESS =  #PICS                 
    IF NO RECORDS FOUND                                                 
* ==================================================================== *
      INPUT USING MAP 'OPERM502'                                        
      FETCH 'INFO0995'                                                  
    END-NOREC                                                           
    ADD 1 TO #CONTA                                                     
* ==================================================================== *
 MOVE PRINTER-NAME                 TO #PRINTER-NAME             (#CONTA)
 MOVE PRINTER-TYPE                 TO #PRINTER-TYPE             (#CONTA)
 MOVE LOCATION                     TO #LOCATION                 (#CONTA)
 MOVE LUNAME                       TO #LUNAME                   (#CONTA)
 MOVE DESTINATION                  TO #DESTINATION              (#CONTA)
 MOVE OUTPUT-CLASS                 TO #OUTPUT-CLASS             (#CONTA)
 MOVE PRINT-QUEUE-NAME             TO #PRINT-QUEUE-NAME         (#CONTA)
 MOVE PRINTER-IP-ADDRESS           TO #PRINTER-IP-ADDRESS       (#CONTA)
 MOVE DESCRIPTION                  TO #DESCRIPTION              (#CONTA)
 MOVE LPR-PRINT-FUNCTION           TO #LPR-PRINT-FUNCTION       (#CONTA)
 MOVE LPR-MODE                     TO #LPR-MODE                 (#CONTA)
 MOVE INCLUDE-PRINTWAY-OPTIONS     TO #INCLUDE-PRINTWAY-OPTIONS (#CONTA)
* ===================================================================== 
  PRINT                                                                 
/                                                                       
 'PRINTER-NAME .........: ' PRINTER-NAME           /                    
 'PRINTER-TYPE .........: ' PRINTER-TYPE           /                    
 'DESTINATION ..........: ' DESTINATION            /                    
 'LOCATION .............: ' LOCATION               /                    
 'OUTPUT-CLASS .........: ' OUTPUT-CLASS           /                    
 'PRINT-QUEUE-NAME .....: ' PRINT-QUEUE-NAME       /                    
 'PRINTER-IP-ADDRESS ...: ' PRINTER-IP-ADDRESS     /                    
 'DESCRIPTION ..........: ' DESCRIPTION            /                    
 'LPR-PRINT-FUNCTION ...: ' LPR-PRINT-FUNCTION     /                    
 'LPR-MODE .............: ' LPR-MODE                                    
/                                                                       
* -------------------------------------------------------------------- *
  END-FIND                                                              
* -------------------------------------------------------------------- *
WRITE TITLE LEFT                                                        
  *TIME(AL=8) 27T 'CONSULTANDO PICS' (I) 71T *DATE                      
AT END OF PAGE                                                          
  INPUT ' '                                                             
  IF *PF-KEY EQ 'PF3'                                                   
   FETCH 'INFOMENU'                                                     
  END-IF                                                                
END-ENDPAGE                                                             
  FETCH 'INFO0106'                                                      
END-REPEAT                                                              
* -------------------------------------------------------------------- *
END                                                                     

A view criada para fazer essa consulta
 08:53:35               ***** NATURAL LIST COMMAND *****              12/08/2026
 User DBAP055         - List DDM AAFU-INFOPRINT-PRINTWAY -      Library INFOPRIN
                                                                                
 DDM DBID 0      DDM FNR 492   VSAM Name          Default Sequence     Page   1 
                                                                                
 T L  DB  Name                             F Leng  S D Remark                   
 - -  --  -------------------------------- - ----  - - ------------------------ 
 *        Generation started                                                    
 *        at 2025-06-19 10:30:27                                                
 *        by user DBAP055                                                       
 *                                                                              
   1  AA  LINE                             A   80  N                            
   1  AB  PRINTER-NAME                     A   10  N D                          
   1  AC  PRINTER-TYPE                     A   20  N                            
   1  AD  LOCATION                         A   53  N                            
   1  AE  LUNAME                           A   10  N                            
   1  AF  DESTINATION                      A   10  N                            
   1  AG  OUTPUT-CLASS                     A    1  N                            
   1  AH  PRINT-QUEUE-NAME                 A   20  N                            
   1  AI  PRINTER-IP-ADDRESS               A   15  N D                          
   1  AJ  DESCRIPTION                      A   53  N 
   1  AK  LPR-PRINT-FUNCTION               A    2  N 
   1  AL  LPR-MODE                         A   18  N 
   1  AM  INCLUDE-PRINTWAY-OPTIONS         A    9  N 

 Top of List.                                                                   
 Command ===>                                                                   
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
       Help  Print Exit  Short       --    -     +     ++                Canc   

Opção 30

Essa opção vamos criar um controle id da impressora e terminal disponivel para cadastro - tem uma view criada no Adabas
                                                                                
  ------------------------------------------------------------------------------
  DBAP055           SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS           INFO0101
  08:48:36 ------------------------------------------------------------ 12/08/26
                                INFOPRINT SERVER                        INFOPRIN
                                                                                
                          LIVRE.....: PICS2698                                  
                          USUÁRIO...: SUP0169                                   
                          DATA/HORA.: 18/11/25 15:49:01                         
                                                                                
                          LIVRE.....: TICS6828                                  
                          USUÁRIO...: DBAP055                                   
                          DATA/HORA.: 20/01/25 11:03:23                         
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                         +TICS                   +PICS             LOG          

Programa Natural
* -------------------------------------------------------------------- *
* PROGRAMA : INFO0490                                                  *
* OBJETIVO : EXIBIR PICS/TICS LIVRES                                   *
* NATURAL  : 4.1.4                                                     *
* -------------------------------------------------------------------- *
DEFINE DATA LOCAL                                                       
01 CADASTRO VIEW OF AAFU-LUNAME-TCPIP-INFOPRINT                         
   02 AAF-LUNAME                                                        
   02 AAF-MODEL                                                         
   02 AAF-USER                                                          
   02 AAF-DATA                                                          
   02 AAF-HORA                                                          
01 #RESULTADO  (A08)                                                    
01 #DATAHORA   (A17)                                                    
END-DEFINE                                                              
* -------------------------------------------------------------------- *
FORMAT LS=132 PS=21 KD=ON                                               
SET KEY PF3 PF4 PF8 = ' '                                               
PF4 = PGM NAMED '+TICS'                                                 
PF8 = PGM NAMED '+PICS'                                                 
  WRITE TITLE LEFT                                                      
    02T '-' (78)                                                        
    /02T *USER                                                          
    20T 'SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS' (I)                  
    72T *PROGRAM                                                        
    /02T *TIME(AL=8) 11T '-' (60) 72T  *DATE                            
    /32T 'INFOPRINT SERVER'(I) 72T *LIBRARY-ID /                        
* -------------------------------------------------------------------- *
FIND CADASTRO                                                           
  WITH AAF-MODEL = 'PICS'                                               
    OR AAF-MODEL = 'TICS'                                               
  SORTED BY AAF-LUNAME                                                  
* -------------------------------------------------------------------- *
  COMPRESS AAF-MODEL AAF-LUNAME                                         
      INTO #RESULTADO LEAVING NO                                        
* -------------------------------------------------------------------- *
  COMPRESS AAF-DATA AAF-HORA                                            
      INTO #DATAHORA                                                    
* -------------------------------------------------------------------- *
WRITE NOTITLE                                                           
   26T 'LIVRE.....:' #RESULTADO                                         
 / 26T 'USUôRIO...:' AAF-USER                                           
 / 26T 'DATA/HORA.:' #DATAHORA                                          
 /                                                                      
* -------------------------------------------------------------------- *
  AT END OF PAGE                                                        
     INPUT ' '                                                          
     DECIDE ON FIRST VALUE OF *PF-KEY                                   
        VALUE 'PF4'                                                     
           FETCH 'INFO0500'                                             
        VALUE 'PF8'                                                     
           FETCH 'INFO0600'                                             
        NONE VALUE                                                      
           FETCH 'INFOMENU'                                             
* -------------------------------------------------------------------- *
     END-DECIDE                                                         
  END-ENDPAGE                                                           
END-FIND                                                                
* -------------------------------------------------------------------- *
* END-IF                                                                
END

INFO0500 - Programa adicionando id de terminal
* -------------------------------------------------------------------- *
* FUNCAO .: ATUALIZA A ULTIMA TICS CADASTRADA PARA CONTROLE            *
* AUTOR ..: CLAUDEMAR MARTINS                                          *
* -------------------------------------------------------------------- *
DEFINE DATA                                                             
LOCAL                                                                   
01 LUNAME VIEW OF AAFU-LUNAME-TCPIP-INFOPRINT                           
  02 AAF-LUNAME                                                         
  02 AAF-MODEL                                                          
  02 AAF-USER                                                           
  02 AAF-DATA                                                           
  02 AAF-HORA                                                           
01 #INCREMENTO-LUNAME (N04)                                             
01 #USUARIO (A09)                                                       
01 #DATA    (A08)                                                       
01 #HORA    (A08)                                                       
END-DEFINE                                                              
* -------------------------------------------------------------------- *
FORMAT LS=250 PS=60                                                     
* -------------------------------------------------------------------- *
FIND LUNAME WITH AAF-MODEL = 'TICS'                                     
  ON ERROR                                                              
    WRITE 'Erro ao tentar localizar o registro TICS.'                   
    ESCAPE ROUTINE                                                      
  END-ERROR                                                             
* -------------------------------------------------------------------- *
  IF *COUNTER > 0                                                       
* -------------------------------------------------------------------- *
* INICIALIZA O INCREMENTO COM O VALOR ATUAL E CALCULA O NOVO VALOR      
* -------------------------------------------------------------------- *
    MOVE AAF-LUNAME          TO #INCREMENTO-LUNAME                      
    ADD 1                    TO #INCREMENTO-LUNAME                      
    MOVE #INCREMENTO-LUNAME  TO AAF-LUNAME                              
    MOVE *INIT-USER          TO AAF-USER                                
    MOVE *DATE               TO AAF-DATA                                
    MOVE *TIMX               TO AAF-HORA                                
* -------------------------------------------------------------------- *
* ATUALIZA O REGISTRO ENCONTRADO                                        
* -------------------------------------------------------------------- *
    UPDATE (0210)                                                       
    IF *ERROR EQ 0                                                      
      WRITE 'Registro TICS atualizado com sucesso: ' AAF-LUNAME         
      END TRANSACTION                                                   
      FETCH 'INFO0101'                                                  
    ELSE                                                                
      BACKOUT TRANSACTION                                               
      WRITE 'Erro ao tentar atualizar o registro TICS.'                 
    END-IF                                                              
  ELSE                                                                  
* -------------------------------------------------------------------- *
* REGISTRO TICS NãO ENCONTRADO                                          
* -------------------------------------------------------------------- *
    WRITE 'Registro TICS não encontrado no arquivo.'                    
  END-IF                                                                
END-FIND                                                                
* -------------------------------------------------------------------- *
END                                                                     

INFO0600 - Programa adicionando id da impressora
* -------------------------------------------------------------------- *
* FUNCAO .: ATUALIZA A ULTIMA PICS CADASTRADA PARA CONTROLE            *
* AUTOR ..: CLAUDEMAR MARTINS                                          *
* -------------------------------------------------------------------- *
DEFINE DATA                                                             
LOCAL                                                                   
01 LUNAME VIEW OF AAFU-LUNAME-TCPIP-INFOPRINT                           
  02 AAF-LUNAME                                                         
  02 AAF-MODEL                                                          
  02 AAF-USER                                                           
  02 AAF-DATA                                                           
  02 AAF-HORA                                                           
01 #INCREMENTO-LUNAME (N04)                                             
01 #USUARIO (A09)                                                       
01 #DATA    (A08)                                                       
01 #HORA    (A08)                                                       
END-DEFINE                                                              
* -------------------------------------------------------------------- *
FORMAT LS=250 PS=60                                                     
* -------------------------------------------------------------------- *
FIND LUNAME WITH AAF-MODEL = 'PICS'                                     
  ON ERROR                                                              
    WRITE 'Erro ao tentar localizar o registro PICS.'                   
    ESCAPE ROUTINE                                                      
  END-ERROR                                                             
* -------------------------------------------------------------------- *
  IF *COUNTER > 0                                                       
* -------------------------------------------------------------------- *
* INICIALIZA O INCREMENTO COM O VALOR ATUAL E CALCULA O NOVO VALOR      
* -------------------------------------------------------------------- *
    MOVE AAF-LUNAME          TO #INCREMENTO-LUNAME                      
    ADD 1                    TO #INCREMENTO-LUNAME                      
    MOVE #INCREMENTO-LUNAME  TO AAF-LUNAME                              
    MOVE *INIT-USER          TO AAF-USER                                
    MOVE *DATE               TO AAF-DATA                                
    MOVE *TIMX               TO AAF-HORA                                
* -------------------------------------------------------------------- *
* ATUALIZA O REGISTRO ENCONTRADO                                        
* -------------------------------------------------------------------- *
    UPDATE (0210)                                                       
    IF *ERROR EQ 0                                                      
      WRITE 'Registro PICS atualizado com sucesso: ' AAF-LUNAME         
      END TRANSACTION                                                   
      FETCH 'INFO0101'                                                  
    ELSE                                                                
      BACKOUT TRANSACTION                                               
      WRITE 'Erro ao tentar atualizar o registro PICS.'                 
    END-IF                                                              
  ELSE                                                                  
* -------------------------------------------------------------------- *
* REGISTRO TICS NãO ENCONTRADO                                          
* -------------------------------------------------------------------- *
    WRITE 'Registro PICS não encontrado no arquivo.'                    
  END-IF                                                                
END-FIND                                                                
* -------------------------------------------------------------------- *
END                                                                     

View criada foi essa
 08:50:16               ***** NATURAL LIST COMMAND *****              12/08/2026
 User DBAP055       - List DDM AAFU-LUNAME-TCPIP-INFOPRINT -    Library INFOPRIN
                                                                                
 DDM DBID 0      DDM FNR 431   VSAM Name          Default Sequence     Page   1 
                                                                                
 T L  DB  Name                             F Leng  S D Remark                   
 - -  --  -------------------------------- - ----  - - ------------------------ 
 *        Generation started                                                    
 *        at 2025-01-20 08:22:08                                                
 *        by user DBAP055                                                       
 *                                                                              
   1  AA  AAF-MODEL                        A    4  N D                          
   1  AB  AAF-LUNAME                       N  4,0  N D                          
   1  AC  AAF-USER                         A    9  N                            
   1  AD  AAF-DATA                         A    8  N                            
   1  AE  AAF-HORA                         A    8  N                            
                                                                                
                                                                                
                                                                                
                                                                                
 End of List.                                                                   
 Command ===>                                                                   
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
       Help  Print Exit  Short       --    -     +     ++                Canc   

Tela 40

Essa são as opções disponiveis - Alterar IP e alterar o Form (essa opção altera o formato paisagem/retrato)
                                                                                
  ------------------------------------------------------------------------------
  DBAP055           SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS           INFO0109
  10:12:16 ------------------------------------------------------------ 12/08/26
                            ALTERACAO DE IMPRESSORAS                    INFOPRIN
                                                                                
           ------------------------------------------------------------         
                        10 - ALTERAR IP IMPRESSORA                              
                        20 - ALTERAR FORM IMPRESSORA                            
           ------------------------------------------------------------         
                                                                                
                           DIGITE A OPCAO DESEJADA 0__                          
                                                                                
                              TECLE PF3 PARA SAIR                               
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   EXIT                                            LOG   QUIT   

Programa Natural
* ==================================================================== *
* FUNCAO: MENU DE ALTERACAO DE IMPRESSORAS                             *
*  AUTOR: CLAUDEMAR MARTINS DE SA                                      *
*  DATA : 14/10/2025                                                   *
* ==================================================================== *
DEFINE DATA LOCAL                                                       
1 #ARQ1 (N3)                                                            
END-DEFINE                                                              
* ==================================================================== *
FORMAT KD=ON                                                            
SET KEY                                                                 
  TREQ        NAMED ' '   /* NOVAS PFS /*                               
PF3  = PGM NAMED 'EXIT'                                                 
** PF11 = 'INFO0107' NAMED 'LOG'                                        
PF12 = PGM  NAMED 'QUIT'                                                
* ==================================================================== *
REPEAT                                                                  
  INPUT (IP=OFF SG=OFF AD=MIL'_')                                       
    02T '-' (78)                                                        
    /02T *USER                                                          
    20T 'SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS' (I)                  
    72T *PROGRAM                                                        
    /02T *TIME(AL=8) 11T '-' (60) 72T  *DATE                            
    /28T 'ALTERACAO DE IMPRESSORAS' (I) 72T *LIBRARY-ID /               
*    /                             72T *LIBRARY-ID /                    
    /11T '-' (60)                                                       
    /24T '10 - ALTERAR IP IMPRESSORA'(I)                                
    /24T '20 - ALTERAR FORM IMPRESSORA'(I)                              
    /11T'-' (60)                                                        
* ==================================================================== *
    // 27T'DIGITE A OPCAO DESEJADA'(YE) #ARQ1(AD=MIL'_')                
    // 30T'TECLE PF3 PARA SAIR'(I)                                      
* ==================================================================== *
  IF #ARQ1 EQ  10   FETCH 'INFO0102'                                    
  IF #ARQ1 EQ  20   FETCH 'INFO0110'                                    
* ==================================================================== *
  IF *PF-KEY EQ 'PF3' OR = 'PF12' FETCH 'INFOMENU'                      
* ==================================================================== *
END

Alterar IP da Impressora

Essa é o menu para alterar o IP da impressora
                                                                                
  ------------------------------------------------------------------------------
  DBAP055           SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS           INFO0102
  10:14:53 ------------------------------------------------------------ 12/08/26
                               ALTERAR IP IMPRESSORA                    INFOPRIN
                                                                                
           ------------------------------------------------------------         
                                                                                
             PICS ................ :  ________                                  
                                                                                
             NUMERO DO IP ........ :  ___________________                       
                                                                                
           ------------------------------------------------------------         
                                                                                
                              TECLE PF3 PARA VOLTAR                             
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   EXIT                                            LOG          

Programa Natural
* ------------------------------------------------------------------- *
* FUNCAO: MUDAR O IP DE UMA IMPRESSORA NO INFOPRINT                   *
* ------------------------------------------------------------------- *
DEFINE DATA LOCAL                                                      
1 #CALLER   (A4) INIT <'NAT '>                                         
1 #JOBNUM   (A8)                                                       
1 REDEFINE #JOBNUM                                                     
  2 #JOBA   (A3)                                                       
  2 #JOBN   (N5)                                                       
1 #I   (P3)                                                            
1 #RC  (B4)                                                            
1 #TOT (B2)                                                            
1 #ARQ (A32)                                                           
1 #PICS (A08)                                                          
1 #IP   (A19)                                                          
1 #C01 (A80) INIT                                                      
 <'//AAFSNATB JOB (XXXX,OSB),XXXXXXX,CLASS=S,MSGCLASS=A,TYPRUN=HOLD'>  
1 REDEFINE #C01                                                        
  2 FILLER  2X                                                         
  2 #JOBNAME (A8)                                                      
  2 #FIL1 (A06)                                                   
  2 #ACC  (A04)                                                   
  2 #FIL2 (A06)                                                   
  2 #USER (A07)                                                   
1 #C02 (A80) INIT <'//*UQ ALLOW'>                                 
1 #C03 (A80) INIT <'//* ----------------------------------------'>
1 #C04 (A80) INIT <'//* ALTERAR O IP DA IMPRESSORA #PICS        '>
1 #C05 (A80) INIT <'//* ----------------------------------------'>
1 #C06 (A80) INIT <"//PIDU     EXEC PGM=AOPBATCH,PARM='pidu'">    
1 #C07 (A80) INIT <"//STDOUT   DD  SYSOUT=*">                     
1 #C08 (A80) INIT <"//STDERR   DD  SYSOUT=*">                     
1 #C09 (A80) INIT <"//STDIN    DD  *">                            
1 #C10 (A80)                                                      
1 #C11 (A80)                                                      
**                                                                
1 #C12 (A80) INIT <'//IFABEND  IF RC EQ 0 THEN'>                  
1 #C13 (A80) INIT                                                 
  <'//* GRAVANDO O LOG NO BANCO ADABAS'>                          
1 #C14 (A80) INIT                                                 
  <'//* -----------------------------------------------------'>   
1 #C15 (A80) INIT                                                       
  <'//STEP01   EXEC NATURAL,PARM1="SYS=P,MT=0,STACK=(LOG INFOPRIN)"'>   
1 #C16 (A80) INIT <'//CMWKF01  DD SYSOUT=Z'>                            
1 #C17 (A80) INIT <'//CMWKF02  DD SYSOUT=Z'>                            
1 #C18 (A80) INIT <'//CMPRT01  DD SYSOUT=Z,HOLD=YES'>                   
1 #C19 (A80) INIT <'//CMPRINT  DD SYSOUT=Z'>                            
1 #C20 (A80) INIT <'//SYSIN    DD *'>                                   
1 #C21 (A80)                                                            
1 #C22 (A80) INIT <'//FIMABEND ENDIF'>                                  
**                                                                      
1 #Y2K (A1)  INIT <'N'>                                                 
END-DEFINE                                                              
* ==================================================================== *
FORMAT KD=ON                                                            
SET KEY                                                                 
PF3  = PGM  NAMED 'EXIT'                                                
* ==================================================================== *
MOVE *INIT-USER TO #USER                                                
REPEAT                                                                  
  RESET #ARQ                                                            
  RESET INITIAL #Y2K                                                    
  INPUT (IP=OFF SG=OFF AD=MIL'_')                                       
    02T '-' (78)                                                        
    /       02T *USER                                                   
    20T 'SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS' (I)                  
    72T  *PROGRAM                                                       
    /       02T  *TIME(AL=8)                                            
    11T '-' (60)                                                        
    72T  *DATE                                                          
/    31T 'ALTERAR IP IMPRESSORA'(I) 72T *LIBRARY-ID /                   
/                                                                       
11T '-' (60)                                                            
//                                                                      
11T '  PICS ................ : ' #PICS                                  
//                                                                      
11T '  NUMERO DO IP ........ : ' #IP                                    
//                                                                      
11T '-' (60)                                                            
//30T'TECLE PF3 PARA VOLTAR'(I)                                         
* ==================================================================== *
  IF *PF-KEY EQ 'PF3'                                                   
    FETCH 'INFOMENU'                                                    
  END-IF                                                                
* ==================================================================== *
  IF #PICS = ' '                                                        
    REINPUT 'NOME DE IMPRESSORA EM BRANCO' MARK *#ARQ ALARM             
  END-IF                                                                
* ==================================================================== *
  IF #IP  = '        '                                                  
    REINPUT 'NOME DE IP EM BRANCO' MARK *#IP ALARM                      
  END-IF                                                                
* ==================================================================== *
  EXAMINE #PICS   TRANSLATE INTO UPPER CASE                             
* ==================================================================== *
  COMPRESS 'modify printer ' #PICS 'printer-ip-address = ' #IP          
  ';' INTO #C10                                                         
  COMPRESS 'display printer '#PICS                                      
  ';' INTO #C11                                                         
* ==================================================================== *
  COMPRESS 'INFO9033 ' *INIT-USER  *PROGRAM #PICS INTO #C21             
* ==================================================================== *
  COMPUTE #TOT = 22 * 80                                                
  CALL 'RJE' #RC #C01 #TOT                                              
  CALL 'GETJOB' #JOBNUM #CALLER                                         
* ==================================================================== *
FORMAT KD=OFF                                                           
DEFINE WINDOW NUMJOB                                                    
  SIZE 08 * 50    BASE 07/17   TITLE ' NUMERO DO JOB '                  
     FRAMED ON                                                          
  INPUT WINDOW = 'NUMJOB'                                               
  01/01 'FOI SUBMETIDO O JOB:  ' #JOBNAME  (AD=IO)                      
  02/01 'COM O NUMERO ......:'  #JOBN     (AD=IO)                       
  03/01 '                       '                                       
  04/11 'TECLE ENTER PARA VOLTAR'(I)                                    
* ==================================================================== *
FETCH 'INFOMENU'                                                        
END-REPEAT                                                              
END                                                                     

Alterar o Forms da Impressora

Essa é uma opção que usamos muito para alterar o formulario da impressora (retrato/paisagem);
                                                                                
  ------------------------------------------------------------------------------
  DBAP055           SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS           INFO0110
  10:32:02 ------------------------------------------------------------ 12/08/26
                               ALTERAR FORMS IMPRESSORA                 INFOPRIN
                                                                                
           ------------------------------------------------------------         
                                                                                
                        PICS ................ :  ________                       
                                                                                
                        FORMS ............... :  FORM000_                       
                                                                                
           ------------------------------------------------------------         
                                                           FORM0007  - RETRATO  
                                                           FORM0001  - PAISAGEM 
                                                                                
                                                                                
                              TECLE PF3 PARA VOLTAR                             
                                                                                
                                                                                
                                                                                
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   EXIT                                            LOG           

Programa Natural
* -------------------------------------------------------------------- *
* FUNCAO: MUDAR O FORM DE UMA IMPRESSORA NO INFOPRINT                  *
* -------------------------------------------------------------------- *
DEFINE DATA LOCAL                                                       
1 #CALLER   (A4) INIT <'NAT '>                                          
1 #JOBNUM   (A8)                                                        
1 REDEFINE #JOBNUM                                                      
  2 #JOBA   (A3)                                                        
  2 #JOBN   (N5)                                                        
1 #I        (P3)                                                        
1 #RC       (B4)                                                        
1 #TOT      (B2)                                                        
1 #ARQ      (A32)                                                       
1 #PICS     (A08)                                                       
1 #FORMS    (A08) INIT <'FORM000'>                                      
1 #C01 (A80) INIT                                                       
 <'//AAFSNATB JOB (XXXX,OSB),XXXXXXX,CLASS=S,MSGCLASS=A,TYPRUN=HOLD'>   
1 REDEFINE #C01                                                         
  2 FILLER  2X                                                          
  2 #JOBNAME (A8)                                                       
  2 #FIL1 (A06)                                                   
  2 #ACC  (A04)                                                   
  2 #FIL2 (A06)                                                   
  2 #USER (A07)                                                   
1 #C02 (A80) INIT <'//*UQ ALLOW'>                                 
1 #C03 (A80) INIT <'//* ----------------------------------------'>
1 #C04 (A80) INIT <'//* ALTERAR O IP DA IMPRESSORA #PICS        '>
1 #C05 (A80) INIT <'//* ----------------------------------------'>
1 #C06 (A80) INIT <"//PIDU     EXEC PGM=AOPBATCH,PARM='pidu'">    
1 #C07 (A80) INIT <"//STDOUT   DD  SYSOUT=*">                     
1 #C08 (A80) INIT <"//STDERR   DD  SYSOUT=*">                     
1 #C09 (A80) INIT <"//STDIN    DD  *">                            
1 #C10 (A80)                                                      
1 #C11 (A80)                                                      
**                                                                
1 #C12 (A80) INIT <'//IFABEND  IF RC EQ 0 THEN'>                  
1 #C13 (A80) INIT                                                 
  <'//* GRAVANDO O LOG NO BANCO ADABAS'>                          
1 #C14 (A80) INIT                                                 
  <'//* -----------------------------------------------------'>   
  RESET INITIAL #Y2K                                    
  INPUT (IP=OFF SG=OFF AD=MIL'_')                       
    02T '-' (78)                                        
    /       02T *USER                                   
    20T 'SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS' (I)  
    72T  *PROGRAM                                       
    /       02T  *TIME(AL=8)                            
    11T '-' (60)                                        
    72T  *DATE                                          
/    31T 'ALTERAR FORMS IMPRESSORA'(I) 72T *LIBRARY-ID /
/                                                       
11T '-' (60)                                            
//                                                      
22T '  PICS ................ : ' #PICS                  
//                                                      
22T '  FORMS ............... : ' #FORMS                 
//                                                      
11T '-' (60)                                            
/                                                       
59T  'FORM0007 ' (I) '- RETRATO'                        
/                                                                       
59T  'FORM0001 ' (I) '- PAISAGEM'                                       
/                                                                       
* 19T 'FORM0007 ' (I) '- RETRATO  / ' 'FORM0001 ' (I) '- PAISAGEM'      
//30T'TECLE PF3 PARA VOLTAR'(I)                                         
* ==================================================================== *
  IF *PF-KEY EQ 'PF3'                                                   
    FETCH 'INFOMENU'                                                    
  END-IF                                                                
* ==================================================================== *
  IF #PICS = ' '                                                        
    REINPUT 'NOME DE IMPRESSORA EM BRANCO' MARK *#ARQ ALARM             
  END-IF                                                                
* ==================================================================== *
  IF #FORMS = 'FORM000 '                                                
    REINPUT 'COMPLETE O CAMPO FORMS' MARK *#FORMS ALARM                 
  END-IF                                                                
* ==================================================================== *
  EXAMINE #PICS   TRANSLATE INTO UPPER CASE                             
  EXAMINE #FORMS  TRANSLATE INTO UPPER CASE                             
* ==================================================================== *
  COMPRESS 'modify printer ' #PICS 'include-printway-options = ' #FORMS 
  ';' INTO #C10                                                         
  COMPRESS 'display printer '#PICS                                      
  ';' INTO #C11                                                         
* ==================================================================== *
  COMPRESS 'INFO9033 ' *INIT-USER  *PROGRAM #PICS INTO #C21             
* ==================================================================== *
  COMPUTE #TOT = 22 * 80                                                
  CALL 'RJE' #RC #C01 #TOT                                              
  CALL 'GETJOB' #JOBNUM #CALLER                                         
* ==================================================================== *
FORMAT KD=OFF                                                           
DEFINE WINDOW NUMJOB                                                    
  SIZE 08 * 50    BASE 07/17   TITLE ' NUMERO DO JOB '                  
     FRAMED ON                                                          
  INPUT WINDOW = 'NUMJOB'                                               
  01/01 'FOI SUBMETIDO O JOB:  ' #JOBNAME  (AD=IO)                      
  02/01 'COM O NUMERO ......:'  #JOBN     (AD=IO)                       
  03/01 '                       '  
  04/11 'TECLE ENTER PARA VOLTAR'(I)                                    
* ==================================================================== *
FETCH 'INFOMENU'
END-REPEAT      
END             

Opção 50

Essa é o menu que vamos criar uma nova impressora no Infoprint;
                                                                                
  ------------------------------------------------------------------------------
  DBAP055           SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS           INFO0103
  10:35:36 ------------------------------------------------------------ 12/08/26
                             CADASTRAR IMPRESSORA                       INFOPRIN
                                                                                
       --------------------------------------------------------------------     
                                                                                
       IMPRESSORA ... ________                                                  
                                                                                
       DESCRICAO .... _____________________________________________________     
                                                                                
       LOCALICACAO .. _____________________________________________________     
                                                                                
       ENDERECO IP .. ___________________                                       
                                                                                
       FORMATO ...... FORM0007  (5 - PAISAGEM OU 7 - RETRATO)                   
                                                                                
       --------------------------------------------------------------------     
                                                                                
                              TECLE PF3 PARA VOLTAR                             
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   EXIT                                            LOG          

Programa Natural
* ------------------------------------------------------------------- *
* FUNCAO: CADASTRAR UMA IMPRESSORA NO INFOPRINT                       *
* AUTOR : CLAUDEMAR MARTINS                                           *
* ------------------------------------------------------------------- *
DEFINE DATA LOCAL                                                      
1 #CALLER         (A4) INIT <'NAT '>                                   
1 #JOBNUM         (A8)                                                 
1 REDEFINE        #JOBNUM                                              
  2 #JOBA         (A3)                                                 
  2 #JOBN         (N5)                                                 
1 #I              (P3)                                                 
1 #RC             (B4)                                                 
1 #TOT            (B2)                                                 
1 #ARQ            (A32)                                                
1 #PICS           (A08)                                                
1 #DESCRICAO      (A53)                                                
1 #LOCALIZACAO    (A53)                                                
1 #IP             (A19)                                                
1 #FORM           (A08) INIT <'FORM0007'>                              
1 #USUARIO        (A08)                                                
1 #C01 (A80) INIT                                                     
  <'//AAFSNATB JOB (XXXX,OSB),XXXXXXX,CLASS=S,MSGCLASS=A,TYPRUN=HOLD'>
1 REDEFINE #C01                                                       
  2 FILLER  2X                                                        
  2 #JOBNAME (A8)                                                     
  2 #FIL1 (A06)                                                       
  2 #ACC  (A04)                                                       
  2 #FIL2 (A06)                                                       
  2 #USER (A07)                                                       
1 #C02 (A80) INIT <'//*UQ ALLOW'>                                     
1 #C03 (A80) INIT <'//* ----------------------------------------'>    
1 #C04 (A80) INIT <'//* CADASTRAR IMPRESSORA NO INFOPRINT       '>    
1 #C05 (A80) INIT <'//* ----------------------------------------'>    
1 #C06 (A80) INIT <"//PIDU     EXEC PGM=AOPBATCH,PARM='pidu'">        
1 #C07 (A80) INIT <"//STDOUT   DD  SYSOUT=*">                         
1 #C08 (A80) INIT <"//STDERR   DD  SYSOUT=*">                         
1 #C09 (A80) INIT <"//STDIN    DD  *">                                
1 #C10 (A80)                                                          
1 #C11 (A80)                                                          
1 #C12 (A80)                                                          
1 #C13 (A80)                                                   
1 #C14 (A80)                                                   
1 #C15 (A80)                                                   
1 #C16 (A80)                                                   
1 #C17 (A80)                                                   
1 #C18 (A80)                                                   
1 #C19 (A80)                                                   
1 #C20 (A80)                                                   
1 #C21 (A80)                                                   
1 #C22 (A80)                                                   
1 #C23 (A80)                                                   
1 #C24 (A80)                                                   
1 #C25 (A80)                                                   
1 #C26 (A80)                                                   
1 #C27 (A80)                                                   
1 #C28 (A80)                                                   
1 #C29 (A80) INIT <'//IFABEND  IF RC EQ 0 THEN'>               
1 #C30 (A80) INIT                                              
  <'//* -----------------------------------------------------'>
1 #C31 (A80) INIT                                              
  <'//* GRAVANDO O LOG NO BANCO ADABAS'>                                
1 #C32 (A80) INIT                                                       
  <'//* -----------------------------------------------------'>         
1 #C33 (A80) INIT                                                       
  <'//STEP01   EXEC NATURAL,PARM1="SYS=P,MT=0,STACK=(LOG INFOPRIN)"'>   
1 #C34 (A80) INIT <'//CMWKF01  DD SYSOUT=Z'>                            
1 #C35 (A80) INIT <'//CMWKF02  DD SYSOUT=Z'>                            
1 #C36 (A80) INIT <'//CMPRT01  DD SYSOUT=Z,HOLD=YES'>                   
1 #C37 (A80) INIT <'//CMPRINT  DD SYSOUT=Z'>                            
1 #C38 (A80) INIT <'//SYSIN    DD *'>                                   
1 #C39 (A80)                                                            
1 #C40 (A80) INIT <'//FIMABEND ENDIF'>                                  
1 #Y2K (A1)  INIT <'N'>                                                 
END-DEFINE                                                              
* ==================================================================== *
FORMAT KD=ON                                                            
SET KEY                                                                 
PF3  = PGM  NAMED 'EXIT'                                                
* ==================================================================== *
MOVE *INIT-USER TO #USER                                                
REPEAT                                                               
  RESET #ARQ                                                         
  RESET INITIAL #Y2K                                                 
  INPUT (IP=OFF SG=OFF AD=MIL'_')                                    
    02T '-' (78)                                                     
    /       02T *USER                                                
    20T 'SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS' (I)               
    72T  *PROGRAM                                                    
    /       02T  *TIME(AL=8)                                         
    11T '-' (60)                                                     
    72T  *DATE                                                       
    /    29T 'CADASTRAR IMPRESSORA'(I) 72T *LIBRARY-ID /             
    /                                                                
    07T '-' (68)                                                    /
/                                                                    
    07T 'IMPRESSORA ...' #PICS                                      /
/                                                                    
    07T 'DESCRICAO ....' #DESCRICAO                                 /
/                                                                    
    07T 'LOCALICACAO ..' #LOCALIZACAO                               /
/                                                                       
    07T 'ENDERECO IP ..' #IP                                        /   
/                                                                       
    07T 'FORMATO ......' #FORM ' (5 - PAISAGEM OU 7 - RETRATO) '    /   
/                                                                       
    07T '-' (68)                                                        
    //30T'TECLE PF3 PARA VOLTAR'(I)                                     
* ==================================================================== *
  IF *PF-KEY EQ 'PF3'                                                   
    FETCH 'INFOMENU'                                                    
  END-IF                                                                
* ==================================================================== *
  IF #PICS = '        '                                                 
    REINPUT 'NOME DE IMPRESSORA EM BRANCO' MARK *#PICS ALARM            
  END-IF                                                                
* ==================================================================== *
  IF #IP  = '                  '                                        
    REINPUT 'NOME DE IP EM BRANCO' MARK *#IP ALARM                      
  END-IF                                                                
* ==================================================================== *
  EXAMINE #FORM   TRANSLATE INTO UPPER CASE                             
  EXAMINE #PICS   TRANSLATE INTO UPPER CASE                             
* ==================================================================== *
  IF #FORM EQ 'FORM0005'                                                
    COMPRESS 'create printer ' #PICS                           INTO #C10
    COMPRESS 'printer-type = ip-printway'                      INTO #C11
    COMPRESS 'lu-classes = {20}'                               INTO #C12
    COMPRESS 'location = "' #LOCALIZACAO '"'                   INTO #C13
      LEAVING NO                                                        
    COMPRESS 'luname = '     #PICS                             INTO #C14
    COMPRESS 'dcf-routing = yes'                               INTO #C15
    COMPRESS 'include-printway-options = '#FORM                INTO #C16
    COMPRESS 'destination = ' #PICS                            INTO #C17
    COMPRESS 'output-class = P'                                INTO #C18
    COMPRESS 'netspool-formatting = convert-to-pcl'            INTO #C19
    COMPRESS 'include-processing = PCL_ACENTO'                 INTO #C20
    COMPRESS 'print-queue-name = ' #PICS                       INTO #C21
    COMPRESS 'printer-ip-address = ' #IP                       INTO #C22
    COMPRESS 'description = "' #DESCRICAO '"'                  INTO #C23
      LEAVING NO                                                        
    COMPRESS 'lpr-print-function = l'                          INTO #C24
    COMPRESS 'lpr-mode = control-file-first ;'                 INTO #C25
    COMPRESS 'display printer' #PICS  ';'                      INTO #C26
    MOVE '/*'                                                TO #C27    
    MOVE '/*'                                                TO #C28    
    COMPRESS 'INFO9033 ' *INIT-USER *PROGRAM #PICS INTO #C39            
  END-IF                                                                
* ==================================================================== *
  IF #FORM EQ 'FORM0007'                                                
    COMPRESS 'create printer ' #PICS                           INTO #C10
    COMPRESS 'printer-type = ip-printway'                      INTO #C11
    COMPRESS 'lu-classes = {20}'                               INTO #C12
    COMPRESS 'location = "' #LOCALIZACAO '"'                   INTO #C13
      LEAVING NO                                                        
    COMPRESS 'luname = '     #PICS                             INTO #C14
    COMPRESS 'dcf-routing = yes'                               INTO #C15
    COMPRESS 'include-printway-options = '#FORM                INTO #C16
    COMPRESS 'destination = ' #PICS                            INTO #C17
    COMPRESS 'output-class = P'                                INTO #C18
    COMPRESS 'netspool-formatting = convert-to-pcl'            INTO #C19
    COMPRESS 'include-processing = PCL_ACENTO'                 INTO #C20
    COMPRESS 'print-queue-name = ' #PICS                       INTO #C21
    COMPRESS 'printer-ip-address = ' #IP                       INTO #C22
    COMPRESS 'description = "' #DESCRICAO '"'                  INTO #C23
      LEAVING NO                                                        
    COMPRESS 'lpr-print-function = l'                          INTO #C24
    COMPRESS 'lpr-mode = control-file-first'                   INTO #C25
    COMPRESS 'scs-maximum-line-length = 250'                   INTO #C26
    COMPRESS 'scs-right-margin = 250 ;'                        INTO #C27
    COMPRESS 'display printer' #PICS  ';'                      INTO #C28
 COMPRESS 'INFO9033 ' *INIT-USER *PROGRAM #PICS INTO #C39               
  END-IF                                                                
* ==================================================================== *
  IF #FORM NE 'FORM0005' AND #FORM NE 'FORM0007'                        
    REINPUT                                                             
    'FORMATO DIFERENTE DE FORM0005 / FORM0007' MARK *#FORM ALARM        
  END-IF                                                                
* ==================================================================== *
  COMPUTE #TOT = 40 * 80                                                
  CALL 'RJE' #RC #C01 #TOT                                              
  CALL 'GETJOB' #JOBNUM #CALLER                                         
* ==================================================================== *
  FORMAT KD=OFF                                                         
  DEFINE WINDOW NUMJOB                                                  
    SIZE 08 * 50    BASE 07/17   TITLE ' NUMERO DO JOB '                
    FRAMED ON                                                           
  INPUT WINDOW = 'NUMJOB'                                               
    01/01 'FOI SUBMETIDO O JOB:  ' #JOBNAME  (AD=IO)                    
    02/01 'COM O NUMERO ......:'  #JOBN     (AD=IO)                     
    03/01 '                       '                                     
    04/11 'TECLE ENTER PARA VOLTAR'(I)                                  
* ==================================================================== *
  FETCH 'INFOMENU'                                                      
END-REPEAT                                                              
END                                                                     

Opção 60

Essa opção deleta impressoras cadastradas no Infoprint - tela
                                                                                
  ------------------------------------------------------------------------------
  DBAP055           SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS           INFO0104
  10:41:37 ------------------------------------------------------------ 12/08/26
                        DELETAR IMPRESSORA NO INFOPRINT                 INFOPRIN
                                                                                
           ------------------------------------------------------------         
                                                                                
                     PICS ................ :  ________                          
                                                                                
           ------------------------------------------------------------         
                                                                                
                              TECLE PF3 PARA VOLTAR                             
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   EXIT                                            LOG          

Programa Natural
* ------------------------------------------------------------------- *
* FUNCAO: DELETAR IMPRESSORA NO INFOPRINT                             *
* AUTOR : CLAUDEMAR MARTINS DE SA                                     *
* ------------------------------------------------------------------- *
DEFINE DATA LOCAL                                                      
1 #CALLER   (A4) INIT <'NAT '>                                         
1 #JOBNUM   (A8)                                                       
1 REDEFINE #JOBNUM                                                     
  2 #JOBA   (A3)                                                       
  2 #JOBN   (N5)                                                       
1 #I   (P3)                                                            
1 #RC  (B4)                                                            
1 #TOT (B2)                                                            
1 #ARQ (A32)                                                           
1 #PICS (A08)                                                          
1 #IP   (A19)                                                          
1 #C01 (A80) INIT                                                      
 <'//AAFSNATB JOB (XXXX,OSB),XXXXXXX,CLASS=S,MSGCLASS=A,TYPRUN=HOLD'>  
1 REDEFINE #C01                                                        
  2 FILLER  2X                                                         
  2 #JOBNAME (A8)                                                 
  2 #FIL1 (A06)                                                   
  2 #ACC  (A04)                                                   
  2 #FIL2 (A06)                                                   
  2 #USER (A07)                                                   
1 #C02 (A80) INIT <'//*UQ ALLOW'>                                 
1 #C03 (A80) INIT <'//* ----------------------------------------'>
1 #C04 (A80) INIT <'//* ALTERAR O IP DA IMPRESSORA #PICS        '>
1 #C05 (A80) INIT <'//* ----------------------------------------'>
1 #C06 (A80) INIT <"//PIDU     EXEC PGM=AOPBATCH,PARM='pidu'">    
1 #C07 (A80) INIT <"//STDOUT   DD  SYSOUT=*">                     
1 #C08 (A80) INIT <"//STDERR   DD  SYSOUT=*">                     
1 #C09 (A80) INIT <"//STDIN    DD  *">                            
1 #C10 (A80)                                                      
1 #C11 (A80)                                                      
*                                                                 
1 #C12 (A80) INIT <'//IFABEND  IF RC EQ 0 THEN'>                  
1 #C13 (A80) INIT                                                 
  <'//* -----------------------------------------------------'>   
1 #C14 (A80) INIT                                                 

Opção 70

Essa opção vamos fazer o backup do Infoprint e carregamos as informações das impressoras em um arquivo Adabas
                                                                                
  ------------------------------------------------------------------------------
  DBAP055           SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS           INFO0108
  10:45:48 ------------------------------------------------------------ 12/08/26
                          CARGA DO INFOPRINT NO ADABAS                  INFOPRIN
                                                                                
           ------------------------------------------------------------         
                                                                                
                            TECLE (ENTER) PARA CONTINUAR                        
                                                                                
           ------------------------------------------------------------         
                                                                                
                             SUBMETER A CARGA: _ (SIM)                          
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   EXIT                                            LOG          

Programa Natural
* ------------------------------------------------------------------- *
* FUNCAO: CARREGAR OS DADOS DO INFOPRINT NO ADABAS                    *
* AUTOR : CLAUDEMAR MARTINS                                           *
* ------------------------------------------------------------------- *
DEFINE DATA LOCAL                                                      
1 #CALLER   (A4) INIT <'NAT '>                                         
1 #JOBNUM   (A8)                                                       
1 REDEFINE #JOBNUM                                                     
  2 #JOBA   (A3)                                                       
  2 #JOBN   (N5)                                                       
1 #I   (P3)                                                            
1 #RC  (B4)                                                            
1 #TOT (B2)                                                            
1 #ARQ (A1)                                                            
1 #PICS (A08)                                                          
1 #C01 (A80) INIT                                                      
  <'//AAFSNATB JOB (INFO,OSB),CLAUD,CLASS=S,MSGCLASS=A TYPRUN=HOLD'>   
1 REDEFINE #C01                                                        
  2 FILLER  2X                                                         
  2 #JOBNAME (A8)                                                      
  2 #FIL1 (A06)                                                   
  2 #ACC  (A04)                                                   
  2 #FIL2 (A06)                                                   
  2 #USER (A07)                                                   
1 #C02 (A80) INIT <'//*UQ ALLOW'>                                 
1 #C03 (A80) INIT <'//* ----------------------------------------'>
1 #C04 (A80) INIT <'//*      CARREGANDO OS DADOS DO INFOPRINT   '>
1 #C05 (A80) INIT <'//* ----------------------------------------'>
1 #C06 (A80)                                                      
1 #C07 (A80) INIT <'//INVENT   DD   DSN=AOP.INV.BACKUP(+1),'>     
1 #C08 (A80) INIT <'//         DISP=(NEW,CATLG),'>                
1 #C09 (A80) INIT                                                 
  <'//         DCB=(RECFM=VB,LRECL=32756,BLKSIZE=32760),'>        
1 #C10 (A80) INIT                                                 
  <'//         UNIT=SYSDA,SPACE=(CYL,(11,10),RLSE),'>             
1 #C11 (A80) INIT <'//         VOL=SER=PRD902'>                   
1 #C12 (A80) INIT <'//STDOUT   DD   SYSOUT=*'>                    
1 #C13 (A80) INIT <'//STDERR   DD   SYSOUT=*'>                    
1 #C14 (A80) INIT <'//STDENV   DD   *'>                           
1 #C15 (A80) INIT <'NLSPATH=/usr/lpp/Printsrv/En_US/%N'>          
1 #C16 (A80) INIT <'AOPCONF=/etc/Printsrv/aopd.conf'>              
1 #C17 (A80) INIT <'//* ----------------------------------------'> 
1 #C18 (A80) INIT <'//*           REFRESH NO FILE 492           '> 
1 #C19 (A80) INIT <'//* ----------------------------------------'> 
1 #C20 (A80) INIT <'//ADADBS   EXEC AAFAU240'>                     
1 #C21 (A80) INIT <'//DDCARD   DD *'>                              
1 #C22 (A80) INIT <'ADARUN PROG=ADADBS,DBID=240'>                  
1 #C23 (A80) INIT <'//DDKARTE  DD *'>                              
1 #C24 (A80) INIT <'ADADBS     REFRESH FILE=492'>                  
1 #C25 (A80) INIT <'//* ----------------------------------------'> 
1 #C26 (A80) INIT <'//*     CARREGA OS REGISTROS NO FILE 492    '> 
1 #C27 (A80) INIT <'//* ----------------------------------------'> 
1 #C28 (A80)                                                       
1 #C29 (A80) INIT <'//CMWKF01  DD DSN=AOP.INV.BACKUP(+1),DISP=SHR'>
1 #C30 (A80) INIT <'//CMWKF02  DD SYSOUT=G'>                       
1 #C31 (A80) INIT <'//CMPRT01  DD SYSOUT=G,HOLD=YES'>              
1 #C32 (A80) INIT <'//SYSIN    DD *'>                              
1 #C33 (A80) INIT <'INFO0998'>                                     
1 #Y2K (A1)  INIT <'N'>                                            
1 #CSA (A80) INIT <'//AOPBATCH EXEC PGM=AOPBATCH,PARM='>           
1 #CSB (A80) INIT <'/pidu -c '>                                         
1 #CSC (A80) INIT <'export //DD:INVENT;'>                               
1 #CSE (A80) INIT <'/pidu -c "export //DD:INVENT;"'>                    
1 #1-QUOTE (A1)                                                         
1 #2-QUOTE (A1) /* INIT <'"'>                                           
END-DEFINE                                                              
* ==================================================================== *
FORMAT KD=ON                                                            
SET KEY PF3 = 'INFOMENU' NAMED 'EXIT'                                   
OPTIONS TQMARK=OFF                                                      
* ==================================================================== *
INPUT (IP=OFF SG=OFF AD=MIL'_')                                         
  02T '-' (78)                                                          
  /       02T *USER                                                     
  20T 'SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS' (I)                    
  72T  *PROGRAM                                                         
  /       02T  *TIME(AL=8)                                              
  11T '-' (60)                                                          
  72T  *DATE                                                            
  /  26T 'CARGA DO INFOPRINT NO ADABAS'(I) 72T *LIBRARY-ID /            
/ 11T '-' (60)                                                          
  /                                                                     
  /     28T 'TECLE (ENTER) PARA CONTINUAR' (I)                          
  /                                                                     
/ 11T '-' (60)                                                          
  /                                                                     
  /29T 'SUBMETER A CARGA:'(I)#ARQ '(SIM)'                               
* ==================================================================== *
MOVE "'" TO #1-QUOTE                                                    
MOVE '"' TO #2-QUOTE                                                    
REPEAT                                                                  
* ==================================================================== *
  COMPRESS                                                              
    #CSA                                                                
    #1-QUOTE                                                            
    #CSB                                                                
    #2-QUOTE                                                            
    #CSC                                                                
    #2-QUOTE                                                            
    #1-QUOTE                                                            
    INTO #C06                                                           
    LEAVING NO                                                          
* ==================================================================== *
* COMPRESS #CSA '"' #CSB '|'  #CSC '|' '"' INTO #C06     LEAVING NO     
  COMPRESS '//STEP01   EXEC NATURAL,PARM1='                             
    "'SYS=P,MT=0,STACK=(LOG INFOPRIN)'"                                 
    INTO #C28   LEAVING NO                                              
* ==================================================================== *
  COMPUTE #TOT = 33 * 80                                                
  CALL 'RJE' #RC #C01 #TOT                                              
  CALL 'GETJOB' #JOBNUM #CALLER                                         
* ==================================================================== *
  FORMAT KD=OFF                                                         
  DEFINE WINDOW NUMJOB                                                  
    SIZE 08 * 50    BASE 07/17   TITLE ' NUMERO DO JOB '                
    FRAMED ON                                                           
  INPUT WINDOW = 'NUMJOB'                                               
    01/01 'FOI SUBMETIDO O JOB:  ' #JOBNAME  (AD=IO)                    
    02/01 'COM O NUMERO ......:'  #JOBN     (AD=IO)                     
    03/01 '                       '                                     
    04/11 'TECLE ENTER PARA VOLTAR'(I)                                  
* ==================================================================== *
  FETCH 'INFOMENU'                                                      
END-REPEAT                                                              
END                                                                     

o programa INFO0998 carrega os dados do dataset para o banco Adabas
* -------------------------------------------------------------------- *
* FUNCAO - GRAVAR NO BANCO AS INFORMACOES DAS IMPRESSORAS DO INFOPRINT *
*  AUTOR - CLAUDEMAR MARTINS DE SA                                     *
* -------------------------------------------------------------------- *
DEFINE DATA LOCAL                                                       
1 #LINE (A80)                                                           
1 #PRINTER-NAME         (A10)                                           
1 #PRINTER-TYPE         (A20)                                           
1 #LOCATION             (A53)                                           
1 #LUNAME               (A10)                                           
1 #DESTINATION          (A10)                                           
1 #OUTPUT-CLASS         (A1)                                            
1 #PRINT-QUEUE-NAME     (A20)                                           
1 #PRINTER-IP-ADDRESS   (A15)                                           
1 #DESCRIPTION          (A53)                                           
1 #LPR-PRINT-FUNCTION   (A02)                                           
1 #LPR-MODE             (A18)                                           
1 #INCLUDE-PRINTWAY-OPTIONS (A09)                                       
1 #POS (I4)                                                             
1 IMPRESSORA-VIEW VIEW OF AAFU-INFOPRINT-PRINTWAY                       
  2 PRINTER-NAME                                                        
  2 PRINTER-TYPE                                                        
  2 LOCATION                                                            
  2 LUNAME                                                              
  2 DESTINATION                                                         
  2 OUTPUT-CLASS                                                        
  2 PRINT-QUEUE-NAME                                                    
  2 PRINTER-IP-ADDRESS                                                  
  2 DESCRIPTION                                                         
  2 LPR-PRINT-FUNCTION                                                  
  2 LPR-MODE                                                            
  2 INCLUDE-PRINTWAY-OPTIONS                                            
END-DEFINE                                                              
* -------------------------------------------------------------------- *
READ WORK FILE 1 #LINE                                                  
*                                                                       
  IF #LINE = ' '                                                        
    ESCAPE TOP                                                          
  END-IF                                                                
* -------------------------------------------------------------------- *
  IF SUBSTRING(#LINE, 1, 14) = 'create printer'                         
    MOVE SUBSTRING(#LINE,16,8) TO #PRINTER-NAME                         
    ESCAPE TOP                                                          
  END-IF                                                                
* -------------------------------------------------------------------- *
  IF SUBSTRING(#LINE, 1, 18) = '   printer-type = '                     
    MOVE SUBSTRING(#LINE, 19, 11) TO #PRINTER-TYPE                      
*   COMPRESS FULL #PRINTER-TYPE INTO #PRINTER-TYPE LEAVING NO           
  END-IF                                                                
* -------------------------------------------------------------------- *
  IF SUBSTRING(#LINE, 1, 13) = '   location = '                         
    MOVE SUBSTRING(#LINE, 15, 53) TO #LOCATION                          
  END-IF                                                                
* -------------------------------------------------------------------- *
  IF SUBSTRING(#LINE, 1,12) = '   luname = '                            
    MOVE SUBSTRING(#LINE, 13, 10) TO #LUNAME                            
  END-IF                                                                
* -------------------------------------------------------------------- *
  IF SUBSTRING(#LINE, 1,17) = '   destination = '                       
    MOVE SUBSTRING(#LINE, 18, 53) TO #DESTINATION                       
  END-IF                                                                
* -------------------------------------------------------------------- *
  IF SUBSTRING(#LINE, 1,18) = '   output-class = '                      
    MOVE SUBSTRING(#LINE, 19, 3) TO #OUTPUT-CLASS                       
  END-IF                                                                
* -------------------------------------------------------------------- *
  IF SUBSTRING(#LINE, 1,22) = '   print-queue-name = '                  
    MOVE SUBSTRING(#LINE, 23, 8) TO #PRINT-QUEUE-NAME                   
  END-IF                                                                
* -------------------------------------------------------------------- *
  IF SUBSTRING(#LINE,1,24) = '   printer-ip-address = '                 
    MOVE SUBSTRING(#LINE, 25, 15) TO #PRINTER-IP-ADDRESS                
  END-IF                                                                
* -------------------------------------------------------------------- *
  IF SUBSTRING(#LINE,1,17) = '   description = '                        
    MOVE SUBSTRING(#LINE, 18, 60) TO #DESCRIPTION                       
  END-IF                                                                
* -------------------------------------------------------------------- *
  IF SUBSTRING(#LINE,1,24) = '   lpr-print-function = '                 
    MOVE SUBSTRING(#LINE, 25, 2) TO #LPR-PRINT-FUNCTION                 
  END-IF                                                                
* -------------------------------------------------------------------- *
  IF SUBSTRING(#LINE,1,14) = '   lpr-mode = '                           
    MOVE SUBSTRING(#LINE, 15, 18) TO #LPR-MODE                          
  END-IF                                                                
* -------------------------------------------------------------------- *
  IF SUBSTRING(#LINE, 1,30) = '   include-printway-options = '          
    MOVE SUBSTRING(#LINE, 31, 9) TO #INCLUDE-PRINTWAY-OPTIONS           
  END-IF                                                                
* -------------------------------------------------------------------- *
  IF #LINE = ';'                                                        
    STORE RECORD IN IMPRESSORA-VIEW                                     
    MOVE #PRINTER-NAME         TO PRINTER-NAME                          
    MOVE #PRINTER-TYPE         TO PRINTER-TYPE                          
    MOVE #LOCATION             TO LOCATION                              
    MOVE #LUNAME               TO LUNAME                                
    MOVE #DESTINATION          TO DESTINATION                           
    MOVE #OUTPUT-CLASS         TO OUTPUT-CLASS                          
    MOVE #PRINT-QUEUE-NAME     TO PRINT-QUEUE-NAME                      
    MOVE #PRINTER-IP-ADDRESS   TO PRINTER-IP-ADDRESS                    
    MOVE #DESCRIPTION          TO DESCRIPTION                           
    MOVE #LPR-PRINT-FUNCTION   TO LPR-PRINT-FUNCTION                    
    MOVE #LPR-MODE             TO LPR-MODE                              
    MOVE #INCLUDE-PRINTWAY-OPTIONS TO INCLUDE-PRINTWAY-OPTIONS          
    END TRANSACTION                                                     
* -------------------------------------------------------------------- *
    RESET #PRINTER-NAME #PRINTER-TYPE #LOCATION #LUNAME                 
      #DESTINATION #OUTPUT-CLASS #PRINT-QUEUE-NAME                      
      #PRINTER-IP-ADDRESS #DESCRIPTION                                  
* -------------------------------------------------------------------- *
  END-IF                                                                
END-WORK                                                                
END                                                                     

Opção 80


Opção que temos para criar, alterar e pesquisar os FORMS que temos definidos na instalação
                                                                                
  ------------------------------------------------------------------------------
  DBAP055           SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS           INFO0113
  10:51:41 ------------------------------------------------------------ 12/08/26
                                   FORMULARIOS                          INFOPRIN
                                                                                
           ------------------------------------------------------------         
                        10 - CRIAR FORMS PARA O INFOPRINT                       
                        20 - ALTERAR TIMEOUT DOS FORMS                          
                        30 - PESQUISAR OS FORMS DEFINIDOS                       
           ------------------------------------------------------------         
                                                                                
                           DIGITE A OPCAO DESEJADA 0__                          
                                                                                
                              TECLE PF3 PARA SAIR                               
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   EXIT                                            LOG   QUIT   

Programa Natural
* ==================================================================== *
* FUNCAO: MENU DE PESQUISA DE IMPRESSORA                               *
*  AUTOR: CLAUDEMAR MARTINS DE SA                                      *
*  DATA : 15/12/2024                                                   *
* ==================================================================== *
DEFINE DATA LOCAL                                                       
1 #ARQ1 (N3)                                                            
END-DEFINE                                                              
* ==================================================================== *
FORMAT KD=ON                                                            
SET KEY                                                                 
  TREQ        NAMED ' '   /* NOVAS PFS /*                               
PF3  = PGM NAMED 'EXIT'                                                 
PF11 = 'INFO0107' NAMED 'LOG'                                           
PF12 = PGM  NAMED 'QUIT'                                                
* ==================================================================== *
REPEAT                                                                  
  INPUT (IP=OFF SG=OFF AD=MIL'_')                                       
    02T '-' (78)                                                        
    /02T *USER                                                          
    20T 'SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS' (I)                  
    72T *PROGRAM                                                        
    /02T *TIME(AL=8) 11T '-' (60) 72T  *DATE                            
    /35T 'FORMULARIOS'(I) 72T *LIBRARY-ID /                             
    /11T '-' (60)                                                       
    /24T '10 - CRIAR FORMS PARA O INFOPRINT'(I)                         
    /24T '20 - ALTERAR TIMEOUT DOS FORMS'(I)                            
    /24T '30 - PESQUISAR OS FORMS DEFINIDOS'(I)                         
    /11T'-' (60)                                                        
* ==================================================================== *
    // 27T'DIGITE A OPCAO DESEJADA'(YE) #ARQ1(AD=MIL'_')                
    // 30T'TECLE PF3 PARA SAIR'(I)                                      
* ==================================================================== *
  IF #ARQ1 EQ  10   FETCH 'INFO0114'                                    
  IF #ARQ1 EQ  20   FETCH 'INFO0112'                                    
  IF #ARQ1 EQ  30   FETCH 'INFO0111'                                    
* ==================================================================== *
  IF *PF-KEY EQ 'PF3' OR = 'PF12' FETCH 'INFOMENU'                      
  IF *PF-KEY EQ 'PF11' FETCH 'INFO0107'                                 
* ==================================================================== *
END

Criar FORM

Essa opção criamos um novo form no Infoprint
                                                                                
  ------------------------------------------------------------------------------
  DBAP055           SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS           INFO0114
  10:54:37 ------------------------------------------------------------ 12/08/26
                            CRIAR FORM NO INFOPRINT                     INFOPRIN
                                                                                
  ------------------------------------------------------------------------------
                                                                                
     NOME DO FORM ... :  ________                                               
                                                                                
     DESCRICAO ...... :  ___________________________                            
                                                                                
     COMANDO PCL .... :  ____________________________________________________   
                                                                                
     TIMEOUT ........ :  ________                                               
                                                                                
  ------------------------------------------------------------------------------
                                                                                
                              TECLE PF3 PARA VOLTAR                             
                                                                                
                                                                                
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   EXIT                                            LOG          

Programa Natural
* ------------------------------------------------------------------- *
* FUNCAO: ALTERAR O TIMEOUT DAS IMPRESSORAS DO INFOPRINT              *
* AUTOR : CLAUDEMAR MARTINS DE SA                                     *
* ------------------------------------------------------------------- *
DEFINE DATA LOCAL                                                      
1 #CALLER   (A4) INIT <'NAT '>                                         
1 #JOBNUM   (A8)                                                       
1 REDEFINE #JOBNUM                                                     
  2 #JOBA   (A3)                                                       
  2 #JOBN   (N5)                                                       
1 #I        (P3)                                                       
1 #RC       (B4)                                                       
1 #TOT      (B2)                                                       
1 #ARQ      (A32)                                                      
1 #FORMS    (A08)                                                      
1 #DESC     (A27)                                                      
1 #PCL      (A52)                                                      
1 #TIMEOUT  (A08)                                                      
1 #IP       (A19)                                                      
1 #C01 (A80) INIT                                                      
  <'//AAFSNATB JOB (XXXX,OSB),XXXXXXX,CLASS=S,MSGCLASS=A,TYPRUN=HOLD'>
1 REDEFINE #C01                                                       
  2 FILLER  2X                                                        
  2 #JOBNAME (A8)                                                     
  2 #FIL1 (A06)                                                       
  2 #ACC  (A04)                                                       
  2 #FIL2 (A06)                                                       
  2 #USER (A07)                                                       
1 #C02 (A80) INIT <'//*UQ ALLOW'>                                     
1 #C03 (A80) INIT <'//* ----------------------------------------'>    
1 #C04 (A80) INIT <'//* ALTERAR O IP DA IMPRESSORA #PICS        '>    
1 #C05 (A80) INIT <'//* ----------------------------------------'>    
1 #C06 (A80) INIT <"//PIDU     EXEC PGM=AOPBATCH,PARM='pidu'">        
1 #C07 (A80) INIT <"//STDOUT   DD  SYSOUT=*">                         
1 #C08 (A80) INIT <"//STDERR   DD  SYSOUT=*">                         
1 #C09 (A80) INIT <"//STDIN    DD  *">                                
1 #C10 (A80)                                                          
1 #C11 (A80)                                                          
1 #C12 (A80)                                                          
1 #C13 (A80)                                                          
**                                                                      
1 #C14 (A80) INIT <'//IFABEND  IF RC EQ 0 THEN'>                        
1 #C15 (A80) INIT                                                       
  <'//* GRAVANDO O LOG NO BANCO ADABAS'>                                
1 #C16 (A80) INIT                                                       
  <'//* -----------------------------------------------------'>         
1 #C17 (A80) INIT                                                       
  <'//STEP01   EXEC NATURAL,PARM1="SYS=P,MT=0,STACK=(LOG INFOPRIN)"'>   
1 #C18 (A80) INIT <'//CMWKF01  DD SYSOUT=Z'>                            
1 #C19 (A80) INIT <'//CMWKF02  DD SYSOUT=Z'>                            
1 #C20 (A80) INIT <'//CMPRT01  DD SYSOUT=Z,HOLD=YES'>                   
1 #C21 (A80) INIT <'//CMPRINT  DD SYSOUT=Z'>                            
1 #C22 (A80) INIT <'//SYSIN    DD *'>                                   
1 #C23 (A80)                                                            
1 #C24 (A80) INIT <'//FIMABEND ENDIF'>                                  
1 #Y2K (A1)  INIT <'N'>                                                 
END-DEFINE                                                              
* ==================================================================== *
OPTIONS TQMARK=OFF                                                      
* ==================================================================== *
FORMAT KD=ON                                                            
SET KEY                                                                 
PF3  = PGM  NAMED 'EXIT'                                                
* ==================================================================== *
MOVE *INIT-USER TO #USER                                                
REPEAT                                                                  
  RESET #ARQ                                                            
  RESET INITIAL #Y2K                                                    
  INPUT (IP=OFF SG=OFF AD=MIL'_')                                       
    02T '-' (78)                                                        
    /       02T *USER                                                   
    20T 'SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS' (I)                  
    72T  *PROGRAM                                                       
    /       02T  *TIME(AL=8)                                            
    11T '-' (60)                                                        
    72T  *DATE                                                          
    /    28T 'CRIAR FORM NO INFOPRINT'(I) 72T *LIBRARY-ID /             
    /                                                                   
    02T '-' (78)                                                        
    //                                                                  
    03T '  NOME DO FORM ... : ' #FORMS                                  
    //                                                                  
    03T '  DESCRICAO ...... : ' #DESC                                   
    //                                                                  
    03T '  COMANDO PCL .... : ' #PCL                                    
    //                                                                  
    03T '  TIMEOUT ........ : ' #TIMEOUT                                
    //                                                                  
    02T '-' (78)                                                        
    //30T'TECLE PF3 PARA VOLTAR'(I)                                     
* ==================================================================== *
  IF *PF-KEY EQ 'PF3'                                                   
    FETCH 'INFO0113'                                                    
  END-IF                                                                
* ==================================================================== *
  IF #FORMS   = ' '                                                     
    REINPUT 'FORMS ESTA EM BRANCO' MARK *#FORMS   ALARM                 
  END-IF                                                                
* ==================================================================== *
  IF #DESC    = ' '                                                     
    REINPUT 'DESCRICAO ESTA EM BRANCO' MARK *#DESC    ALARM             
  END-IF                                                                
* ==================================================================== *
  IF #PCL     = ' '                                                     
    REINPUT 'PCL ESTA EM BRANCO' MARK *#PCL     ALARM                   
  END-IF                                                                
* ==================================================================== *
  IF #TIMEOUT = ' '                                                     
    REINPUT 'TIMEOUT ESTA EM BRANCO' MARK *#TIMEOUT ALARM               
  END-IF                                                                
* ==================================================================== *
  EXAMINE #FORMS  TRANSLATE INTO UPPER CASE                             
  EXAMINE #DESC   TRANSLATE INTO UPPER CASE                             
* ==================================================================== *
COMPRESS 'create printway-options ' #FORMS                              
    ';' INTO #C10                                                       
COMPRESS '   description = "' #DESC                                     
    '";' INTO #C11                                                      
COMPRESS '   document-header = "' #PCL                                  
    '";' INTO #C12                                                      
COMPRESS '   response-timeout = ' #TIMEOUT                              
    ';' INTO #C13                                                       
* ==================================================================== *
  COMPRESS 'INFO9033 ' *INIT-USER  *PROGRAM #TIMEOUT INTO #C23          
* ==================================================================== *
  COMPUTE #TOT = 25 * 80                                                
  CALL 'RJE' #RC #C01 #TOT                                              
  CALL 'GETJOB' #JOBNUM #CALLER                                         
* ==================================================================== *
  FORMAT KD=OFF                                                         
  DEFINE WINDOW NUMJOB                                                  
    SIZE 08 * 50    BASE 07/17   TITLE ' NUMERO DO JOB '                
    FRAMED ON                                                           
  INPUT WINDOW = 'NUMJOB'                                               
    01/01 'FOI SUBMETIDO O JOB:  ' #JOBNAME  (AD=IO)                    
    02/01 'COM O NUMERO ......:'  #JOBN     (AD=IO)                     
    03/01 '                       '                                     
    04/11 'TECLE ENTER PARA VOLTAR'(I)                                  
* ==================================================================== *
  FETCH 'INFO0113'                                                      
END-REPEAT  
END         

Alterar o timeout do FORM

Essa opção é bem interessante, quando a impressão é feita, o Infoprint tem um tempo para tentar imprimir, esse tempo não pode ser muito alto e nem muito baixo, um tempo que o suporte colocou foi 30 segundos
                                                                                
  ------------------------------------------------------------------------------
  DBAP055           SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS           INFO0112
  10:56:34 ------------------------------------------------------------ 12/08/26
                            ALTERAR TIMEOUT DAS PICS                    INFOPRIN
                                                                                
           ------------------------------------------------------------         
                                                                                
                 TIMEOUT SEGUNDOS .... :  ________                              
                                                                                
           ------------------------------------------------------------         
                                                                                
                              TECLE PF3 PARA VOLTAR                             
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   EXIT                                            LOG          

Programa Natural
* ------------------------------------------------------------------- *
* FUNCAO: ALTERAR O TIMEOUT DAS IMPRESSORAS DO INFOPRINT              *
* AUTOR : CLAUDEMAR MARTINS DE SA                                     *
* ------------------------------------------------------------------- *
DEFINE DATA LOCAL                                                      
1 #CALLER   (A4) INIT <'NAT '>                                         
1 #JOBNUM   (A8)                                                       
1 REDEFINE #JOBNUM                                                     
  2 #JOBA   (A3)                                                       
  2 #JOBN   (N5)                                                       
1 #I        (P3)                                                       
1 #RC       (B4)                                                       
1 #TOT      (B2)                                                       
1 #ARQ      (A32)                                                      
1 #TIMEOUT  (A08)                                                      
1 #IP       (A19)                                                      
1 #C01 (A80) INIT                                                      
  <'//AAFSNATB JOB (XXXX,OSB),XXXXXXX,CLASS=S,MSGCLASS=A,TYPRUN=HOLD'> 
1 REDEFINE #C01                                                        
  2 FILLER  2X                                                         
  2 #JOBNAME (A8)                                                 
  2 #FIL1 (A06)                                                   
  2 #ACC  (A04)                                                   
  2 #FIL2 (A06)                                                   
  2 #USER (A07)                                                   
1 #C02 (A80) INIT <'//*UQ ALLOW'>                                 
1 #C03 (A80) INIT <'//* ----------------------------------------'>
1 #C04 (A80) INIT <'//* ALTERAR O IP DA IMPRESSORA #PICS        '>
1 #C05 (A80) INIT <'//* ----------------------------------------'>
1 #C06 (A80) INIT <"//PIDU     EXEC PGM=AOPBATCH,PARM='pidu'">    
1 #C07 (A80) INIT <"//STDOUT   DD  SYSOUT=*">                     
1 #C08 (A80) INIT <"//STDERR   DD  SYSOUT=*">                     
1 #C09 (A80) INIT <"//STDIN    DD  *">                            
1 #C10 (A80)                                                      
1 #C11 (A80)                                                      
1 #C12 (A80)                                                      
1 #C13 (A80)                                                      
1 #C14 (A80)                                                      
1 #C15 (A80)                                                      
1 #C16 (A80)                                                      
1 #C17 (A80)                                                         
1 #C18 (A80)                                                         
1 #C19 (A80)                                                         
1 #C20 (A80)                                                         
1 #C21 (A80)                                                         
1 #C22 (A80)                                                         
1 #C23 (A80)                                                         
1 #C24 (A80)                                                         
1 #C25 (A80)                                                         
**                                                                   
1 #C26 (A80) INIT <'//IFABEND  IF RC EQ 0 THEN'>                     
1 #C27 (A80) INIT                                                    
  <'//* GRAVANDO O LOG NO BANCO ADABAS'>                             
1 #C28 (A80) INIT                                                    
  <'//* -----------------------------------------------------'>      
1 #C29 (A80) INIT                                                    
  <'//STEP01   EXEC NATURAL,PARM1="SYS=P,MT=0,STACK=(LOG INFOPRIN)"'>
1 #C30 (A80) INIT <'//CMWKF01  DD SYSOUT=Z'>                         
1 #C31 (A80) INIT <'//CMWKF02  DD SYSOUT=Z'>                         
1 #C32 (A80) INIT <'//CMPRT01  DD SYSOUT=Z,HOLD=YES'>                
1 #C33 (A80) INIT <'//CMPRINT  DD SYSOUT=Z'>                            
1 #C34 (A80) INIT <'//SYSIN    DD *'>                                   
1 #C35 (A80)                                                            
1 #C36 (A80) INIT <'//FIMABEND ENDIF'>                                  
**                                                                      
1 #Y2K (A1)  INIT <'N'>                                                 
END-DEFINE                                                              
* ==================================================================== *
FORMAT KD=ON                                                            
SET KEY                                                                 
PF3  = PGM  NAMED 'EXIT'                                                
* ==================================================================== *
MOVE *INIT-USER TO #USER                                                
REPEAT                                                                  
  RESET #ARQ                                                            
  RESET INITIAL #Y2K                                                    
  INPUT (IP=OFF SG=OFF AD=MIL'_')                                       
    02T '-' (78)                                                        
    /       02T *USER                                                   
    20T 'SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS' (I)                  
    72T  *PROGRAM                                                       
    /       02T  *TIME(AL=8)                                            
    11T '-' (60)                                                        
    72T  *DATE                                                          
    /    28T 'ALTERAR TIMEOUT DAS PICS'(I) 72T *LIBRARY-ID /            
    /                                                                   
    11T '-' (60)                                                        
    //                                                                  
    15T '  TIMEOUT SEGUNDOS .... : ' #TIMEOUT                           
    //                                                                  
    11T '-' (60)                                                        
    //30T'TECLE PF3 PARA VOLTAR'(I)                                     
* ==================================================================== *
  IF *PF-KEY EQ 'PF3'                                                   
    FETCH 'INFO0113'                                                    
  END-IF                                                                
* ==================================================================== *
  IF #TIMEOUT = ' '                                                     
    REINPUT 'TIMEOUT ESTA EM BRANCO' MARK *#TIMEOUT ALARM               
  END-IF                                                                
* ==================================================================== *
* EXAMINE #PICS   TRANSLATE INTO UPPER CASE                             
* ==================================================================== *
COMPRESS 'modify printway-options FORM0001 response-timeout = ' #TIMEOUT
    ';' INTO #C10                                                       
COMPRESS 'modify printway-options FORM0004 response-timeout = ' #TIMEOUT
    ';' INTO #C11                                                       
COMPRESS 'modify printway-options FORM0005 response-timeout = ' #TIMEOUT
    ';' INTO #C12                                                       
COMPRESS 'modify printway-options FORM0007 response-timeout = ' #TIMEOUT
    ';' INTO #C13                                                       
COMPRESS 'modify printway-options FORM0008 response-timeout = ' #TIMEOUT
    ';' INTO #C14                                                       
COMPRESS 'modify printway-options FORM0009 response-timeout = ' #TIMEOUT
    ';' INTO #C15                                                       
COMPRESS 'modify printway-options FORM0010 response-timeout = ' #TIMEOUT
    ';' INTO #C16                                                       
COMPRESS 'modify printway-options FORM0012 response-timeout = ' #TIMEOUT
    ';' INTO #C17                                                       
COMPRESS 'display printway-options FORM0001 ;' INTO #C18                
COMPRESS 'display printway-options FORM0004 ;' INTO #C19                
COMPRESS 'display printway-options FORM0005 ;' INTO #C20                
COMPRESS 'display printway-options FORM0007 ;' INTO #C21                
COMPRESS 'display printway-options FORM0008 ;' INTO #C22                
COMPRESS 'display printway-options FORM0009 ;' INTO #C23                
COMPRESS 'display printway-options FORM0010 ;' INTO #C24                
COMPRESS 'display printway-options FORM0012 ;' INTO #C25                
* ==================================================================== *
  COMPRESS 'INFO9033 ' *INIT-USER  *PROGRAM #TIMEOUT INTO #C35          
* ==================================================================== *
  COMPUTE #TOT = 25 * 80                                                
  CALL 'RJE' #RC #C01 #TOT                                              
  CALL 'GETJOB' #JOBNUM #CALLER                                         
* ==================================================================== *
  FORMAT KD=OFF                                                         
  DEFINE WINDOW NUMJOB                                                  
    SIZE 08 * 50    BASE 07/17   TITLE ' NUMERO DO JOB '                
    FRAMED ON                                                           
  INPUT WINDOW = 'NUMJOB'                                               
    01/01 'FOI SUBMETIDO O JOB:  ' #JOBNAME  (AD=IO)                    
    02/01 'COM O NUMERO ......:'  #JOBN     (AD=IO)                     
    03/01 '                       '                                     
    04/11 'TECLE ENTER PARA VOLTAR'(I)                                  
* ==================================================================== *
  FETCH 'INFO0113'                                                      
END-REPEAT                                                              
END                                                                     

Display dos Forms

Essa tela mostra os forms criados e qual é o formato que imprimi - essa opção como não criamos forms coloquei o formularios que temos, a idéia no futuro é criar um programa natural que consulta os forms no banco de dados
                                                                                
  ------------------------------------------------------------------------------
  DBAP055           SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS           INFO0111
  11:02:12 ------------------------------------------------------------ 12/08/26
                                     FORMS                              INFOPRIN
                                                                                
           ------------------------------------------------------------         
                        RETRATO               PAISAGEM                          
           ------------------------------------------------------------         
                        FORM0004              FORM0001                          
                        FORM0005              FORM0012                          
                        FORM0007                                                
                        FORM0008                                                
                        FORM0009                                                
                        FORM0010                                                
           ------------------------------------------------------------         
                                                                                
                              TECLE ENTER PARA SAIR                             
                                                                                
                                                                                
                                                                                
                                                                                
 Enter-PF1---PF2---PF3---PF4---PF5---PF6---PF7---PF8---PF9---PF10--PF11--PF12---
                   EXIT                                            LOG   QUIT   

Programa Natural
* ==================================================================== *
* FUNCAO: MENU DE PESQUISA DE IMPRESSORA                               *
*  AUTOR: CLAUDEMAR MARTINS DE SA                                      *
*  DATA : 15/12/2024                                                   *
* ==================================================================== *
DEFINE DATA LOCAL                                                       
1 #ARQ1 (N3)                                                            
END-DEFINE                                                              
* ==================================================================== *
FORMAT KD=ON                                                            
SET KEY                                                                 
  TREQ        NAMED ' '   /* NOVAS PFS /*                               
PF3  = PGM NAMED 'EXIT'                                                 
PF11 = 'INFO0107' NAMED 'LOG'                                           
PF12 = PGM  NAMED 'QUIT'                                                
* ==================================================================== *
REPEAT                                                                  
  INPUT (IP=OFF SG=OFF AD=MIL'_')                                       
    02T '-' (78)                                                        
    /02T *USER                                                          
    20T 'SUPERINTENDENCIA DE SISTEMAS CORPORATIVOS' (I)                  
    72T *PROGRAM                                                        
    /02T *TIME(AL=8) 11T '-' (60) 72T  *DATE                            
    /37T 'FORMS'(I) 72T *LIBRARY-ID /                                   
    /11T '-' (60)                                                       
    /24T 'RETRATO               PAISAGEM' (I)                           
    /11T'-' (60)                                                        
    /24T 'FORM0004              FORM0001' (I)                           
    /24T 'FORM0005              FORM0012' (I)                           
    /24T 'FORM0007                      ' (I)                           
    /24T 'FORM0008                      ' (I)                           
    /24T 'FORM0009                      ' (I)                           
    /24T 'FORM0010                      ' (I)                           
    /11T'-' (60)                                                        
* ==================================================================== *
    // 30T'TECLE ENTER PARA SAIR'(I)                                    
* ==================================================================== *
  IF *PF-KEY EQ 'PF3' OR = 'PF12' FETCH 'INFOMENU'                      
  IF *PF-KEY EQ 'PF11' FETCH 'INFO0107'                                 
* ==================================================================== *
FETCH 'INFO0113'                                                        
* ==================================================================== *
END                                                                     


Leia Mais