Cobol, rotinas diversas
Estrutura Programa
Programa Exemplo 1
Definicao Label
Diferenca De Dias
Ultimo Dia Mes
Total Dias
Proximo Vencimento
Calculo de Tempo
Raiz Quadrada
Numeros
Alterando espaços por zeros
Estrutura Programa: identification division. program-id. xxxxxxxx. author. nononono. date-written. 44/44/4444. environment division. configuration section. input-output section. file-control. data division. file section. working-storage section. screen section. procedure division.
Definicao Label: 03 label-fax1 pic x(12) value spaces. 03 label-fax1-r redefines label-fax1. 05 label-fax1-nome pic x(05). 05 label-fax1-usr pic 9(03). 05 label-fax1-pt pic x(01). 05 label-fax1-exte pic x(03). 03 label-fprn pic x(12) value spaces. 03 label-fprn-r redefines label-fprn. 05 label-fprn-nome pic x(08). 05 label-fprn-pt pic x(01). 05 label-fprn-exte pic 9(03). 03 label-fsrt pic x(12) value spaces. 03 label-fsrt-r redefines label-fsrt. 05 label-fsrt-nome pic x(08). 05 label-fsrt-pt pic x(01). 05 label-fsrt-exte pic 9(03). move 'axxx01' to label-fax1-nome. move ws-usr-cod to label-fax1-usr. move '.' to label-fax1-pt. move 'DAT' to label-fax1-exte. move 'lstxxx01' to label-fprn-nome. move '.' to label-fprn-pt. move ws-usr-cod to label-fprn-exte. move 'srtxxx01' to label-fsrt-nome. move '.' to label-fsrt-pt. move ws-usr-cod to label-fsrt-exte.
Diferenca De Dias: COMPUTE WS-DIAS-1 = (WS-ANO * 365 ) + (WS-MES * 30,417 ) + (WS-DIA ). COMPUTE WS-DIAS-2 = (CTA-LIMITE-VALIDADE-ANO * 365 ) + (CTA-LIMITE-VALIDADE-MES * 30,417 ) + (CTA-LIMITE-VALIDADE-DIA ). COMPUTE WS-DIAS-3 = WS-DIAS-2 - WS-DIAS-1.
Ultimo Dia Mes: 01 ws-resto pic 9v99 value zeroes. 01 ws-tabdia. 03 f pic x(24) value '310031303130313130313031". 01 ws-tabdia-r redefines ws-tabdia. 03 ws-ultdia pic 9(02) occurs 12. if ws-mes = 2 move zeroes to ws-resto compute ws-resto = ws-ano / 4 if ws-resto = 0 move 29 to ws-ultdia(2) else move 28 to ws-ultdia(2).
Total dias: 01 ws-tdias pic x(36) value '000031059090120151181212243273304334". 01 ws-tdias-r redefines ws-tdias. 03 ws-dias pic 9(03) occurs 12. compute ws-diasp = ws-ano * 365,25 + ws-dias(ws-mes) + ws-dia.
Proximo Vencimento: 01 ws-tabdia. 03 f pic x(24) value '310031303130313130313031". 01 ws-tabdia-r redefines ws-tabdia. 03 ws-ultdia pic 9(02) occurs 12. 01 ws-aux-ano pic 9(04)v99. 01 ws-aux-ano-r redefines ws-aux-ano. 03 ws-aux-ano1 pic 9(04). 03 ws-aux-ano2 pic 9(02). ... (no inicio do programa) move ws-ven-dia to ws-aux-dia. move ws-ven-mes to ws-aux-mes. move ws-ven-ano to ws-aux-ano. . . . move ws-ven-dia to ws-aux-dia. add 1 to ws-aux-mes. if ws-aux-mes > 12 add 1 to ws-aux-ano move 1 to ws-aux-mes. if ws-aux-dia = 30 or ws-aux-dia = 31 move ws-tab-dia(ws-ultdia) to ws-aux-dia. if ws-aux-mes = 02 if ws-aux-dia = 28 or ws-aux-dia = 29 compute ws-aux-ano = ws-aux-ano / 4 if ws-aux-ano2 not = zeroes move 28 to ws-aux-dia.
Calculo de Tempo: 01 ws-fields. 03 ws-tempo-inicial pic 9(10) value zeroes. 03 ws-tempo-final pic 9(10) value zeroes. 03 ws-tempo-real pic 9(10) value zeroes. 03 ws-hora-inicio. 03 wk-inic-hora pic 9(04) value zeroes. 03 wk-inic-minuto pic 9(02) value zeroes. 03 wk-inic-segundo pic 9(02) value zeroes. 03 ws-hora-final. 03 wk-fim-hora pic 9(04) value zeroes. 03 wk-fim-minuto pic 9(02) value zeroes. 03 wk-fim-segundo pic 9(02) value zeroes. 03 ws-hora-real. 03 wk-real-hora pic 9(04) value zeroes. 03 wk-real-minuto pic 9(02) value zeroes. 03 wk-real-segundo pic 9(02) value zeroes. compute ws-tempo-inicial = (ws-inic-hora * 3600) + (ws-inic-minuto * 60) + ws-inic-segundo. compute ws-tempo-final = (ws-fim-hora * 3600) + (ws-fim-minuto * 60) + ws-fim-segundo. compute ws-tempo-real = ws-tempo-final - ws-tempo-inicial. move zeroes to ws-hora-real. if ws-tempo-real > 3600 compute ws-real-hora = ws-tempo-real / 3600 compute ws-tempo-real = ws-tempo-real - (ws-real-hora * 3600). if ws-tempo-real > 60 compute ws-real-minuto = ws-tempo-real / 60 compute ws-tempo-real = ws-tempo-real - (ws-real-minuto * 60). move ws-tempo-real to ws-real-segundo.
Raiz Quadrada: 01 ws-fields. 03 ws-raiz-con pic 9(03) value zeroes. 03 ws-raiz-res pic 9(13)v9(05) value zeroes. 03 ws-raiz-ind pic 9(13)v9(05) value zeroes. 03 ws-valor pic 9(09)v9(02) value zeroes. ********** ws-raiz-con ==> contador para prever erro loop ********** ws-raiz-res ==> resultado da raiz ********** ws-raiz-ind ==> indice para raiz ********** ws-valor ==> raiz que se procura r00-set-raiz. move zeroes to ws-raiz-con. move zeroes to ws-raiz-res. move 2 to ws-raiz-ind. r00-raiz. add 1 to ws-raiz-con. compute ws-raiz-res = ((ws-valor / ws-raiz-ind) + ws-raiz-ind) / 2. if ws-raiz-con < 50 and ws-raiz-ind not = ws-raiz-res move ws-raiz-res to ws-raiz-ind go to r00-raiz.
Numeros: 01 ZERO. 02 F PIC X(03) VALUE ' * '. 02 F PIC X(03) VALUE '* *'. 02 F PIC X(03) VALUE '* *'. 02 F PIC X(03) VALUE '* *'. 02 F PIC X(03) VALUE ' * '. 01 UM. 02 F PIC X(03) VALUE '** '. 02 F PIC X(03) VALUE ' * '. 02 F PIC X(03) VALUE ' * '. 02 F PIC X(03) VALUE ' * '. 02 F PIC X(03) VALUE '***'. 01 DOIS. 02 F PIC X(03) VALUE '***'. 02 F PIC X(03) VALUE ' *'. 02 F PIC X(03) VALUE '***'. 02 F PIC X(03) VALUE '* '. 02 F PIC X(03) VALUE '***'. 01 TRES. 02 F PIC X(03) VALUE '***'. 02 F PIC X(03) VALUE ' *'. 02 F PIC X(03) VALUE ' **'. 02 F PIC X(03) VALUE ' *'. 02 F PIC X(03) VALUE '***'. 01 QUATRO. 02 F PIC X(03) VALUE '* *'. 02 F PIC X(03) VALUE '* *'. 02 F PIC X(03) VALUE '***'. 02 F PIC X(03) VALUE ' *'. 02 F PIC X(03) VALUE ' *'. 01 CINCO. 02 F PIC X(03) VALUE '***'. 02 F PIC X(03) VALUE '* '. 02 F PIC X(03) VALUE '***'. 02 F PIC X(03) VALUE ' *'. 02 F PIC X(03) VALUE '***'. 01 SEIS. 02 F PIC X(03) VALUE '***'. 02 F PIC X(03) VALUE '* '. 02 F PIC X(03) VALUE '***'. 02 F PIC X(03) VALUE '* *'. 02 F PIC X(03) VALUE '***'. 01 SETE. 02 F PIC X(03) VALUE '***'. 02 F PIC X(03) VALUE ' *'. 02 F PIC X(03) VALUE ' *'. 02 F PIC X(03) VALUE ' *'. 02 F PIC X(03) VALUE ' *'. 01 OITO. 02 F PIC X(03) VALUE '***'. 02 F PIC X(03) VALUE '* *'. 02 F PIC X(03) VALUE '***'. 02 F PIC X(03) VALUE '* *'. 02 F PIC X(03) VALUE '***'. 01 NOVE. 02 F PIC X(03) VALUE '***'. 02 F PIC X(03) VALUE '* *'. 02 F PIC X(03) VALUE '***'. 02 F PIC X(03) VALUE ' *'. 02 F PIC X(03) VALUE ' *'.
Alterando espacos por zeros: accept ws-parametros from command-line inspect xxxxx replacing all " " by "0" PERFORM VERIFICA-ESTADO VARYING WS-IND FROM 1 BY 1 UNTIL WS-IND = 28.