[SWEXA.WRK]SWEXA_FAX_ACCOUNTING_RPT.COB

*++
*
*  Program:
*       SWEXA_FAX_ACCOUNTING_RPT
*
*  Purpose:
*       Generate a report from the SysWorks FAX accounting file.
*
*  Copyright:
*       Copyright © 1995 - 1999 Corpita Pty Ltd
*       15 Bedford Street, Collingwood 3066, Australia
*
*  History:
*       16-Jan-1999 by SLJ
*           Add page of capability
*       09-Aug-1995 by SLJ
*           Add call to initialization routine
*       28-May-1995 by SLJ
*           Add DEXCfax accounting and outque data file handling
*       02-May-1995 by Simon L. Jackson
*           Initial version
*
*--


identification division.
program-id. swexa_fax_accounting_rpt.

environment division.
configuration section.
special-names.
symbolic characters
        char_null       1
        ld_ltc          237
        ld_hl           242
        ld_rtc          236
        ld_vl           249
        ld_rbc          235
        ld_lbc          238
        ld_lt           245
        ld_rt           246
        ld_tt           248
        ld_bt           247
        ld_x            239
        .

input-output section.
file-control.
        select swexa_dfx_acc_data_file
          assign to swexa_dfx_accounting_file
          organization is indexed
          record key is dfx_timestamp with duplicates
          alternate record key is dfx_server_id of swexa_dfx_accounting_rec with duplicates
          alternate record key is dfx_accounting_charge_code with duplicates
          alternate record key is dfx_username of swexa_dfx_accounting_rec with duplicates
          .

        select swexa_dfx_out_data_file
          assign to swexa_dfx_outque_file
          organization is indexed
          record key is dfx_out_message_id with duplicates
          alternate record key is dfx_out_status with duplicates
          .

        select swexa_fax_data_file
          assign to swexa_fax_accounting_file
          organization is indexed
          record key is fax_message_id of swexa_fax_accounting_rec
          .

        select swexa_fax_report_file
          assign to swexa_fax_accounting_file
          organization is sequential
          .

data division.
file section.
        fd swexa_dfx_acc_data_file
          record is varying in size
          value of id is ws_acc_data_file_name
          data record is swexa_dfx_accounting_rec
          access mode is sequential.

        copy "swexa_dfx_accounting_rec" from dictionary.

        fd swexa_dfx_out_data_file
          record is varying in size
          value of id is ws_out_data_file_name
          data record is swexa_dfx_outque_rec
          access mode is sequential.

        copy "swexa_dfx_outque_rec" from dictionary.

        fd swexa_fax_data_file
          record is varying in size
          value of id is ws_data_file_name
          data record is swexa_fax_accounting_rec
          access mode is dynamic.

        copy "swexa_fax_accounting_rec" from dictionary.

        fd swexa_fax_report_file
          value of id is ws_report_file_name
          report is fax_rpt.

working-storage section.
        01  ws_acc_data_file_flag       pic x.
          88  ws_acc_data_file_eof      value "E".
          88  ws_acc_data_file_go       value "G".
        01  ws_acc_data_file_name       pic x(32) value "SWEXA_DAT_DIR:DFX$ACCOUNTING.DAT".
        01  ws_data_file_flag           pic x.
          88  ws_data_file_1            value "1".
          88  ws_data_file_2            value "2".
          88  ws_data_file_eof          value "E".
          88  ws_data_file_go           value "G".
        01  ws_data_file_name           pic x(38) value "SWEXA_DAT_DIR:SWEXA_FAX_ACCOUNTING.DAT".
        01  ws_date_binary              pic 9(18) comp.
        01  ws_date_display             pic x(11).
        01  ws_date_fixup               redefines ws_date_display.
          03  ws_date_day_0             pic x.
          03  filler                    pic xxx.
          03  ws_date_month_2_3         pic 9(4) comp.
        01  ws_dfx_out_status.
          03  ws_dfx_out_status_word    pic 9(9) comp.
          03  ws_dfx_out_status_char    redefines ws_dfx_out_status_word
                                        pic x.
        01  ws_fax_address              pic x(20).
        01  ws_fax_addressee            pic x(80).
        01  ws_fax_project_number       pic 9(4) comp.
        01  ws_fax_project_number_text  pic x(5).
        01  ws_fax_title                pic x(80).
        01  ws_junk                     pic x.
        01  ws_num_spaces               pic 9(9) comp.
        01  ws_out_data_file_flag       pic x.
          88  ws_out_data_file_eof      value "E".
          88  ws_out_data_file_go       value "G".
        01  ws_out_data_file_name       pic x(28) value "SWEXA_DAT_DIR:DFX$OUTQUE.DAT".
        01  ws_program_name             pic x(31) value "SWEXA_FAX_ACCOUNTING_RPT".
        01  ws_reference                pic 9(9) comp.
        01  ws_report_file_flag         pic x.
          88  ws_report_file_eof        value "E".
          88  ws_report_file_go         value "G".
        01  ws_report_file_name         pic x(38) value "SWEXA_RUN_DIR:SWEXA_FAX_ACCOUNTING.LIS".
        01  ws_status                   pic 9(9) comp.

        01  rms$_eof                    pic 9(9) comp value external rms$_eof.
        01  rms$_fnf                    pic 9(9) comp value external rms$_fnf.
        01  swrk__traceproc             pic 9(9) comp value external swrk__traceproc.
        01  tidy$m_remove_nulls         pic 9(9) comp value external tidy$m_remove_nulls.
        01  tidy$m_trim                 pic 9(9) comp value external tidy$m_trim.

        copy "swrk_cdd_dir:swrk_trace_data_rec" from dictionary replacing
          ==swrk_trace_data_rec== by ==swrk_trace_data_rec external==.

report section.
        rd fax_rpt
          page limits are 66 lines
            heading 2
            first detail 7
            last detail 63.

        01  fax_rpt_report_heading type report heading next group next page.
          02  line 20.
            03  column 01               pic x(20)   value ")0~".
          02  line plus 1.
            03  column 21               pic x       value ld_ltc.
            03  column 22               pic x(38)   value all ld_hl.
            03  column 60               pic x       value ld_rtc.
          02  line plus 1.
            03  column 21               pic x       value ld_vl.
            03  column 60               pic x       value ld_vl.
          02  line plus 1.
            03  column 21               pic x       value ld_vl.
            03  column 30               pic x(21)   value "FAX Accounting Report".
            03  column 60               pic x       value ld_vl.
          02  line plus 1.
            03  column 21               pic x       value ld_vl.
            03  column 60               pic x       value ld_vl.
          02  line plus 1.
            03  column 21               pic x       value ld_vl.
            03  column 60               pic x       value ld_vl.
          02  line plus 1.
            03  column 21               pic x       value ld_lbc.
            03  column 22               pic x(38)   value all ld_hl.
            03  column 60               pic x       value ld_rbc.

        01  fax_rpt_page_heading type page heading.
          02  line 02.
            03  column 01               pic x       value ld_ltc.
            03  column 02               pic x(78)   value all ld_hl.
            03  column 80               pic x       value ld_rtc.
          02  line plus 1.
            03  column 01               pic x       value ld_vl.
            03  column 03               pic x(11)   source ws_date_display.
            03  column 30               pic x(21)   value "FAX Accounting Report".
            03  column 64               pic x(5)    value "Page".
            03  column 69               pic 999     source page-counter.
            03  column 73               pic xx      value "of".
            03  column 76               pic 999     value 999.
            03  column 80               pic x       value ld_vl.
          02  line plus 1.
            03  column 01               pic x       value ld_lt.
            03  column 02               pic x(13)   value all ld_hl.
            03  column 15               pic x       value ld_tt.
            03  column 16               pic x(22)   value all ld_hl.
            03  column 38               pic x       value ld_tt.
            03  column 39               pic x(5)    value all ld_hl.
            03  column 44               pic x       value ld_tt.
            03  column 45               pic x(7)    value all ld_hl.
            03  column 52               pic x       value ld_tt.
            03  column 53               pic x(27)   value all ld_hl.
            03  column 80               pic x       value ld_rt.
          02  line plus 1.
            03  column 01               pic x       value ld_vl.
            03  column 03               pic x(11)   value "  FAX  ID  ".
            03  column 15               pic x       value ld_vl.
            03  column 17               pic x(20)   value "Number".
            03  column 38               pic x       value ld_vl.
            03  column 40               pic x(3)    value "Job".
            03  column 44               pic x       value ld_vl.
            03  column 46               pic x(5)    value " Time".
            03  column 52               pic x       value ld_vl.
            03  column 54               pic x(25)   value "Title".
            03  column 80               pic x       value ld_vl.
          02  line plus 1.
            03  column 01               pic x       value ld_lt.
            03  column 02               pic x(13)   value all ld_hl.
            03  column 15               pic x       value ld_x.
            03  column 16               pic x(22)   value all ld_hl.
            03  column 38               pic x       value ld_x.
            03  column 39               pic x(5)    value all ld_hl.
            03  column 44               pic x       value ld_x.
            03  column 45               pic x(7)    value all ld_hl.
            03  column 52               pic x       value ld_x.
            03  column 53               pic x(27)   value all ld_hl.
            03  column 80               pic x       value ld_rt.

        01  fax_rpt_detail type detail line plus 1.
            03  column 01               pic x       value ld_vl.
            03  column 03               pic x(11)   source fax_message_id of swexa_fax_accounting_rec.
            03  column 15               pic x       value ld_vl.
            03  column 17               pic x(20)   source fax_address of swexa_fax_accounting_rec.
            03  column 38               pic x       value ld_vl.
            03  column 40               pic zz9     source fax_project_number.
            03  column 44               pic x       value ld_vl.
            03  column 46               pic zzzz9   source fax_duration_interval of swexa_fax_accounting_rec.
            03  column 52               pic x       value ld_vl.
            03  column 54               pic x(25)   source fax_title.
            03  column 80               pic x       value ld_vl.

        01  fax_rpt_report_footing type detail line plus 1.
            03  column 01               pic x       value ld_lbc.
            03  column 02               pic x(13)   value all ld_hl.
            03  column 15               pic x       value ld_bt.
            03  column 16               pic x(22)   value all ld_hl.
            03  column 38               pic x       value ld_bt.
            03  column 39               pic x(5)    value all ld_hl.
            03  column 44               pic x       value ld_bt.
            03  column 45               pic x(7)    value all ld_hl.
            03  column 52               pic x       value ld_bt.
            03  column 53               pic x(27)   value all ld_hl.
            03  column 80               pic x       value ld_rbc.

        01  fax_rpt_page_footing type page footing.
          02  line 64.
            03  column 01               pic x       value ld_lbc.
            03  column 02               pic x(13)   value all ld_hl.
            03  column 15               pic x       value ld_bt.
            03  column 16               pic x(22)   value all ld_hl.
            03  column 38               pic x       value ld_bt.
            03  column 39               pic x(5)    value all ld_hl.
            03  column 44               pic x       value ld_bt.
            03  column 45               pic x(7)    value all ld_hl.
            03  column 52               pic x       value ld_bt.
            03  column 53               pic x(27)   value all ld_hl.
            03  column 80               pic x       value ld_rbc.

procedure division.
declaratives.

fax_rpt_page_footing_sect section.
        use before reporting fax_rpt_page_footing.
fax_rpt_page_footing_para.
        if not ws_report_file_go then
          suppress printing
        end-if
        .

swexa_dfx_acc_data_file_sect section.
        use after standard error procedure on swexa_dfx_acc_data_file.
swexa_dfx_acc_data_file_para.
        move rms-sts of swexa_dfx_acc_data_file to ws_status
        if ws_status is failure then
          call "swrk_log_status"
            using
              by value 0
              by descriptor ws_program_name
              by value ws_reference
              by value ws_status
        end-if
        .

swexa_dfx_out_data_file_sect section.
        use after standard error procedure on swexa_dfx_out_data_file.
swexa_dfx_out_data_file_para.
        move rms-sts of swexa_dfx_out_data_file to ws_status
        if ws_status is failure then
          call "swrk_log_status"
            using
              by value 0
              by descriptor ws_program_name
              by value ws_reference
              by value ws_status
        end-if
        .

swexa_fax_data_file_sect section.
        use after standard error procedure on swexa_fax_data_file.
swexa_fax_data_file_para.
        if ws_data_file_1 and rms-sts of swexa_fax_data_file = rms$_fnf then
          call "swrk_create_file_fdl"
            using
              by descriptor ws_data_file_name
              by descriptor "SWEXA_SFT_DIR:SWEXA_FAX_ACCOUNTING.FDL"
            giving ws_status
          if ws_status is success then
            set ws_data_file_2 to true
            open i-o swexa_fax_data_file
          end-if
        end-if
        move rms-sts of swexa_fax_data_file to ws_status
        if ws_status is failure then
          call "swrk_log_status"
            using
              by value 0
              by descriptor ws_program_name
              by value ws_reference
              by value ws_status
        end-if
        .

end declaratives.

1000_main section.
1000_main_paragraph.
        move 1001 to ws_reference
        call "swrk_initialize_image"
          using by value 0
          giving ws_status
        perform 9100_check_status

        move 1002 to ws_reference
        if trace_procedure then
          call "swrk_log_status"
            using
              by value trace_l_log_flags
              by descriptor ws_program_name
              by value ws_reference
              by value swrk__traceproc
              by descriptor ws_program_name
        end-if

        move 1003 to ws_reference
        if trace_debug then
          call "swrk_log_fao"
            using
              by value trace_l_log_flags
              by descriptor ws_program_name
              by value ws_reference
              by descriptor "Tracing debug from Cobol"
        end-if

        move 1004 to ws_reference
        if trace_general then
          call "swrk_log_fao"
            using
              by value trace_l_log_flags
              by descriptor ws_program_name
              by value ws_reference
              by descriptor "Tracing general from Cobol"
        end-if

        move 1005 to ws_reference
        call "swrk_get_date"
          using by reference ws_date_binary
          giving ws_status
        perform 9100_check_status
        move 1006 to ws_reference
        call "sys$asctim"
          using
            omitted
            by descriptor ws_date_display
            by reference ws_date_binary
            omitted
          giving ws_status
        perform 9100_check_status
        if ws_date_day_0 = space then
          move "0" to ws_date_day_0
        end-if
        add 8224 to ws_date_month_2_3

        move 1007 to ws_reference
        set ws_data_file_1 to true
        set ws_status to success
        open i-o swexa_fax_data_file
        set ws_data_file_go to true

        perform 2200_handle_dfx_outque_file
        perform 2100_handle_dfx_accounting_file
        perform 2000_generate_report

        move 1008 to ws_reference
        close swexa_fax_data_file

        perform 9900_exit_program
        .

2000_generate_report.
        move 2001 to ws_reference
        open output swexa_fax_report_file

        move 2002 to ws_reference
        initiate fax_rpt
        set ws_report_file_go to true

        move 2003 to ws_reference
        move spaces to fax_message_id of swexa_fax_accounting_rec
        start swexa_fax_data_file
          key is greater than or equal to fax_message_id of swexa_fax_accounting_rec

        perform with test after until ws_data_file_eof
          move spaces to fax_title
          move 2004 to ws_reference
          read swexa_fax_data_file next record
            at end
              set ws_data_file_eof to true
            not at end
              move 2005 to ws_reference
              generate fax_rpt_detail
          end-read
        end-perform

        move 2006 to ws_reference
        set ws_report_file_eof to true
        generate fax_rpt_report_footing

        move 2007 to ws_reference
        terminate fax_rpt

        call "swexa_add_number_of_pages"
          using by value page_counter of fax_rpt

        move 2008 to ws_reference
        close swexa_fax_report_file
        .

2100_handle_dfx_accounting_file.
        move 2101 to ws_reference
        open input swexa_dfx_acc_data_file allowing all
        set ws_acc_data_file_go to true

        perform with test after until ws_acc_data_file_eof
          move 2102 to ws_reference
          read swexa_dfx_acc_data_file next record
            at end
              set ws_acc_data_file_eof to true
            not at end
              if dfx_acc_status = 1 then
                move fax_message_id of swexa_dfx_accounting_rec to
                  fax_message_id of swexa_fax_accounting_rec
                move 2103 to ws_reference
                read swexa_fax_data_file record
                  key is fax_message_id of swexa_fax_accounting_rec
                    invalid key
                      initialize swexa_fax_accounting_rec
                      move corresponding swexa_dfx_accounting_rec
                        to swexa_fax_accounting_rec
                      perform 3000_write_fax_accounting_rec
                    not invalid key
                      if fax_duration_interval of swexa_fax_accounting_rec = zero then
                        move fax_duration_interval of swexa_dfx_accounting_rec
                          to fax_duration_interval of swexa_fax_accounting_rec
                        move 2104 to ws_reference
                        rewrite swexa_fax_accounting_rec
                      end-if
                end-read
              end-if
          end-read
        end-perform

        move 2105 to ws_reference
        close swexa_dfx_acc_data_file
        .

2200_handle_dfx_outque_file.
        move 2201 to ws_reference
        open input swexa_dfx_out_data_file allowing all
        set ws_out_data_file_go to true

        perform with test after until ws_out_data_file_eof
          move 2202 to ws_reference
          read swexa_dfx_out_data_file next record
            at end
              set ws_out_data_file_eof to true
            not at end
              move dfx_out_status to ws_dfx_out_status_char
              if ws_dfx_out_status_word = 12 then
                move dfx_out_message_id of swexa_dfx_outque_rec (1:7)
                  to fax_message_id of swexa_fax_accounting_rec (1:7)
                move dfx_out_message_id of swexa_dfx_outque_rec (9:4)
                  to fax_message_id of swexa_fax_accounting_rec (8:4)
                move 2203 to ws_reference
                read swexa_fax_data_file record
                  key is fax_message_id of swexa_fax_accounting_rec
                    invalid key
                      initialize swexa_fax_accounting_rec
                      perform 2210_create_from_out_file
                      perform 3000_write_fax_accounting_rec
                    not invalid key
                      continue
                end-read
              end-if
          end-read
        end-perform

        move 2204 to ws_reference
        close swexa_dfx_out_data_file
        .

2210_create_from_out_file.
        move dfx_out_message_id of swexa_dfx_outque_rec (1:7)
          to fax_message_id of swexa_fax_accounting_rec (1:7)
        move dfx_out_message_id of swexa_dfx_outque_rec (9:4)
          to fax_message_id of swexa_fax_accounting_rec (8:4)
        unstring dfx_outque_data delimited by char_null
          into
            ws_fax_address,
            ws_fax_addressee,
            ws_fax_title
        end-unstring
        move ws_fax_address to fax_address of swexa_fax_accounting_rec
        if ws_fax_title (1:1) = "[" then
          unstring ws_fax_title delimited by "[" or "]"
            into
              ws_junk,
              ws_fax_project_number_text,
              ws_fax_title
          end-unstring
          move zero to ws_fax_project_number
          move 2211 to ws_reference
          call "ots$cvt_tu_l"
            using
              by descriptor ws_fax_project_number_text
              by reference ws_fax_project_number
              by value 2
              by value 5
            giving ws_status
          perform 9100_check_status
          move ws_fax_project_number to fax_project_number of swexa_fax_accounting_rec
        end-if
        move 2212 to ws_reference
        call "swrk_fixup_string"
          using
            by descriptor ws_fax_title
            by descriptor ws_fax_title
            by value tidy$m_trim
          giving ws_status
        perform 9100_check_status
        move ws_fax_title to fax_title of swexa_fax_accounting_rec
        .

3000_write_fax_accounting_rec.
        move 3001 to ws_reference
        call "swrk_fixup_string"
          using
            omitted
            by descriptor fax_address of swexa_fax_accounting_rec
            by value tidy$m_remove_nulls
          giving ws_status
        perform 9100_check_status

        move 3002 to ws_reference
        write swexa_fax_accounting_rec
        .

9100_check_status.
        if ws_status is failure then
          call "swrk_log_status"
            using
              by value 0
              by descriptor ws_program_name
              by value ws_reference
              by value ws_status
          perform 9900_exit_program
        end-if
        .

9900_exit_program.
        exit program
        stop run
        .

end program swexa_fax_accounting_rpt.