- IBCERPN ;ALB/VD - RPN Resubmission/Printing Claims No Changes CSA Report ;1/16/2019
- ;;2.0;INTEGRATED BILLING;**641**;21-MAR-94;Build 61
- ;;Per VA Directive 6402, this routine should not be modified.
- ; This report is generated to provide a list of claims that have errors that
- ; prevent a claim from being RESUBMITTED BY PRINT, or RETRANSMITTED, or PRINTED.
- ; The user can use this report in tandem with the CLAIMS STATUS AWAITING RESOLUTION
- ; worklist.
- ; The user is prompted for the following dates:
- ; - Earliest Retransmitted/Printed Date
- ; - Latest Retransmitted/Printed Date
- ; This report has a format of 132 columns.
- ; This report will display the following data elements:
- ; - Bill #
- ; - Payer Name (Secondary sort)
- ; - Error Message (Tertiary sort based on the Error Code). If there is no Error
- ; message then Narrative, and if no Narrative then Category message.
- ; - Current Balance
- ; - User Name (Primary sort)
- ; - Date (Retransmitted/Resubmitted/Printed)
- ;
- ; Refer to US3380
- ; Called by EDI Return Message Management Menu (Path: Billing Clerk Menu>EDI>MM)
- ; Option: RPN
- ;
- ENT ; Menu Option Entry Point
- N BILLDT,BEGDT,BEGIN,BILLNO,CNT,CURBAL,DASH,DT,END,ENDDT,EORMSG,HDR1,HDR2,IBABEG
- N IBAEND,IBQUIT,LEGEND,LNCNT,MAX,NARATV,PAGES,PAYNAM,PGC,RNAME,USERNM,Y,LNTOT,POP
- S IBQUIT=0,RNAME="IBCERPN"
- D DATES Q:IBQUIT Q:'Y
- S LEGEND="Retransmitted/Printed Timeframe: "_BEGIN_" thru "_END
- D DEVICE Q:POP Q:IBQUIT
- QUE ; Queued Entry Point
- K ^TMP(RNAME,$J)
- D GATHER
- S BEGDT=$$FMTE^XLFDT(IBABEG,2),ENDDT=$$FMTE^XLFDT(IBAEND,2)
- S LEGEND="Retransmitted/Printed Timeframe: "_BEGDT_" thru "_ENDDT
- D HDRINIT
- D HEADER Q:IBQUIT
- D PRINT
- D EXIT
- Q
- ;
- DATES ; Enter the date range for this report
- N DIR
- W !
- S DIR(0)="DA^:DT:EX",DIR("A")="Enter Earliest Retransmitted/Printed Date: "
- S DIR("B")=$$HTE^XLFDT($H-30),DIR("?")="Enter the earliest retransmitted or printed date for this report."
- D ^DIR K DIR Q:'Y S IBABEG=+Y,BEGIN=Y(0)
- ;
- W !
- S DIR(0)="DA^"_+Y_":DT:EX",DIR("A")="Enter Latest Retransmitted/Printed Date: "
- S DIR("B")=$$FMTE^XLFDT(DT,1),DIR("?")="Enter the latest retransmitted or printed date for this report."
- D ^DIR K DIR Q:'Y S IBAEND=+Y,END=Y(0)
- Q
- ;
- DEVICE ; - Ask device
- N %ZIS,ZTDESC,ZTIO,ZTQUEUED,ZTRTN,ZTSAVE
- W !!!,"You will need a 132 column printer for this report",!
- S %ZIS="QM" D ^%ZIS S:POP IBQUIT=1 Q:POP
- I $D(IO("Q")) D S IBQUIT=1 Q
- . S ZTRTN="QUE^IBCERPN",ZTDESC="Resubmission/Printing claims No Changes CSA Report"
- . S (ZTSAVE("BEGIN"),ZTSAVE("END"),ZTSAVE("IBABEG"),ZTSAVE("IBAEND"))=""
- . S (ZTSAVE("BEGDT"),ZTSAVE("ENDDT"),ZTSAVE("RNAME"),ZTSAVE("IBQUIT"))=""
- . D ^%ZTLOAD
- . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
- . K ZTSK D HOME^%ZIS
- . W !!! I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR ;pause to see task no.
- U IO
- Q
- ;
- GATHER ;GATHER THE INFO BASED ON THE DATE RANGE ENTERED
- ; Uses the ^IBM(361,"ARPN",CURDAT,IBNO,USER,ACTION) cross-reference file to get
- ; data within date range. If data is within date range this sets up the ^TMP($J
- ; file with all data needed for the report.
- ;
- N ACTION,ARPNRC,CURDAT,IBCBAL,IBCLMNO,IBIFN,IBNO,IBOAM,IBPAY
- N LNCNT,SEQ,USER,USRNAM
- S $P(DASH,"_",132)=""
- S LNTOT=0,PGC=1,MAX=IOSL
- S CURDAT=IBABEG
- F S CURDAT=$O(^IBM(361,"ARPN",CURDAT)) Q:CURDAT="" Q:CURDAT>(IBAEND+1) D
- . S IBNO="" F S IBNO=$O(^IBM(361,"ARPN",CURDAT,IBNO)) Q:IBNO="" D
- .. S IBIFN=+$G(^IBM(361,IBNO,0))
- .. S IBCLMNO=$P($G(^DGCR(399,IBIFN,0)),U) ; External Claim No.
- .. S IBPAY=$P($G(^DIC(36,+$P($G(^DGCR(399,IBIFN,"MP")),U),0)),U)
- .. I IBPAY="" S IBPAY=$P($G(^DIC(36,+$$CURR^IBCEF2(IBIFN),0)),U)
- .. I IBPAY="" S IBPAY="UNKNOWN PAYER"
- .. S IBOAM=$G(^DGCR(399,IBIFN,"U1"))
- .. S IBCBAL=$P(IBOAM,U,1)-$P(IBOAM,U,2) ; current balance (total charges - offset)
- .. S IBEMSG=$$TXT^IBCECSA1(IBNO,60) ; error message (60 chars max).
- .. S:IBEMSG="" IBEMSG=" "
- .. S SEQ="" F S SEQ=$O(^IBM(361,"ARPN",CURDAT,IBNO,SEQ)) Q:SEQ="" D
- ... ;S ARPNRC=$G(^IBM(361,"ARPN",CURDAT,IBNO,SEQ))
- ... S ARPNRC=$G(^IBM(361,IBNO,3,SEQ,0))
- ... S USER=$P(ARPNRC,U,2),ACTION=$P(ARPNRC,U,3)
- ... S USRNAM=$P(^VA(200,USER,0),U) ; External User Name
- ... S ^TMP(RNAME,$J,USRNAM,IBPAY,$E(IBEMSG,1,50),CURDAT,IBCLMNO)=IBCBAL_U_ACTION_U_USER_U_IBIFN
- ... S LNTOT=LNTOT+1
- Q
- ;
- PRINT ; Print data
- ;
- ; PGC=page ct,LNTOT=no of lines to be printed,LNCNT=when to page break
- ; MAX=IOSL (device length)
- ;
- N CURDAT,EORMSG,IBCBAL,IBCLMNO,IBEMSG,IBPAY,LCTR,NONEMSG,USRNAM
- S EORMSG="*** END OF REPORT ***"
- S NONEMSG="* * * N O D A T A T O P R I N T * * *"
- S LCTR=0
- ;
- I '$D(^TMP(RNAME,$J)) W !!!,NONEMSG D END Q
- S USRNAM="" F S USRNAM=$O(^TMP(RNAME,$J,USRNAM)) Q:USRNAM="" D
- . S IBPAY="" F S IBPAY=$O(^TMP(RNAME,$J,USRNAM,IBPAY)) Q:IBPAY="" D
- .. S IBEMSG="" F S IBEMSG=$O(^TMP(RNAME,$J,USRNAM,IBPAY,IBEMSG)) Q:IBEMSG="" D
- ... S CURDAT="" F S CURDAT=$O(^TMP(RNAME,$J,USRNAM,IBPAY,IBEMSG,CURDAT)) Q:CURDAT="" Q:IBQUIT D
- .... S IBCLMNO="" F S IBCLMNO=$O(^TMP(RNAME,$J,USRNAM,IBPAY,IBEMSG,CURDAT,IBCLMNO)) Q:IBCLMNO="" Q:IBQUIT D
- ..... S IBCBAL=+$G(^TMP(RNAME,$J,USRNAM,IBPAY,IBEMSG,CURDAT,IBCLMNO))
- ..... I LNCNT>MAX D HEADER Q:IBQUIT
- ..... S LCTR=LCTR+1
- ..... ;W !,$J(LCTR,4),?10,$E(IBPAY,1,20),?38,$E(USRNAM,1,15),?55,$E(IBEMSG,1,50),?111,$P($$FMTE^XLFDT(CURDAT,2),"@"),?120, $J("$"_$FN(IBCBAL,"",2),12)
- ..... W !,$J(LCTR,3),?7,IBCLMNO,?16,$E(IBPAY,1,20),?38,$E(USRNAM,1,15),?59
- ..... W $E(IBEMSG,1,50),?111,$P($$FMTE^XLFDT(CURDAT,2),"@"),?120,$J("$"_$FN(IBCBAL,"",2),12)
- ..... S LNCNT=LNCNT+1
- I LNCNT>MAX D HEADER
- Q:IBQUIT
- ;
- END W !!!,?49,EORMSG,!!!
- I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR ;pause at end of report
- Q
- ;
- HDRINIT ; Initial setting
- S LNCNT=0
- I PGC=1,$E(IOST,1,2)["C-" W @IOF ; refresh terminal screen on 1st hdr
- I 'LNTOT S PAGES=1
- I LNTOT,PGC=1 D
- . S LNCNT=0
- . S PAGES=LNTOT/(MAX-10)
- . I PAGES<1 S PAGES=1
- . I PAGES["." S PAGES=$P(PAGES+1,".") ; if more than one page set whole number
- S HDR1="Resubmission/Printing claims No Changes CSA Report"
- S HDR2=$$FMTE^XLFDT($$NOW^XLFDT,1)
- Q
- ;
- N DIR,DUOUT
- S LNCNT=0
- I PGC'=1 D Q:IBQUIT
- . W !
- . I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR I $D(DUOUT) S IBQUIT=1 Q:IBQUIT
- . W @IOF ; refresh terminal screen on hdr
- W !,HDR1,?59,HDR2,?114," Page: "_PGC_" of "_PAGES
- W !,LEGEND
- W !!,?7,"Bill #",?17,"Payer Name",?38,"User Name",?59,"Error Message/Narrative/Category",?111,"Date",?124,"Curr Bal"
- W !,DASH
- S LNCNT=LNCNT+10,PGC=PGC+1
- Q
- EXIT() ;clean up and quit
- N ZTREQ
- ; Force a form feed at end of a printer report
- I $E(IOST,1,2)'["C-" W @IOF
- ; handle device closing before exiting
- I $D(ZTQUEUED) S ZTREQ="@"
- I '$D(ZTQUEUED) D ^%ZISC
- K ^TMP(RNAME,$J)
- K BEGIN,BEGDT,ENDDT,IBABEG,IBAEND,IBQUIT,IEN,LNCNT,Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCERPN 7010 printed Mar 13, 2025@21:17:11 Page 2
- IBCERPN ;ALB/VD - RPN Resubmission/Printing Claims No Changes CSA Report ;1/16/2019
- +1 ;;2.0;INTEGRATED BILLING;**641**;21-MAR-94;Build 61
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ; This report is generated to provide a list of claims that have errors that
- +4 ; prevent a claim from being RESUBMITTED BY PRINT, or RETRANSMITTED, or PRINTED.
- +5 ; The user can use this report in tandem with the CLAIMS STATUS AWAITING RESOLUTION
- +6 ; worklist.
- +7 ; The user is prompted for the following dates:
- +8 ; - Earliest Retransmitted/Printed Date
- +9 ; - Latest Retransmitted/Printed Date
- +10 ; This report has a format of 132 columns.
- +11 ; This report will display the following data elements:
- +12 ; - Bill #
- +13 ; - Payer Name (Secondary sort)
- +14 ; - Error Message (Tertiary sort based on the Error Code). If there is no Error
- +15 ; message then Narrative, and if no Narrative then Category message.
- +16 ; - Current Balance
- +17 ; - User Name (Primary sort)
- +18 ; - Date (Retransmitted/Resubmitted/Printed)
- +19 ;
- +20 ; Refer to US3380
- +21 ; Called by EDI Return Message Management Menu (Path: Billing Clerk Menu>EDI>MM)
- +22 ; Option: RPN
- +23 ;
- ENT ; Menu Option Entry Point
- +1 NEW BILLDT,BEGDT,BEGIN,BILLNO,CNT,CURBAL,DASH,DT,END,ENDDT,EORMSG,HDR1,HDR2,IBABEG
- +2 NEW IBAEND,IBQUIT,LEGEND,LNCNT,MAX,NARATV,PAGES,PAYNAM,PGC,RNAME,USERNM,Y,LNTOT,POP
- +3 SET IBQUIT=0
- SET RNAME="IBCERPN"
- +4 DO DATES
- if IBQUIT
- QUIT
- if 'Y
- QUIT
- +5 SET LEGEND="Retransmitted/Printed Timeframe: "_BEGIN_" thru "_END
- +6 DO DEVICE
- if POP
- QUIT
- if IBQUIT
- QUIT
- QUE ; Queued Entry Point
- +1 KILL ^TMP(RNAME,$JOB)
- +2 DO GATHER
- +3 SET BEGDT=$$FMTE^XLFDT(IBABEG,2)
- SET ENDDT=$$FMTE^XLFDT(IBAEND,2)
- +4 SET LEGEND="Retransmitted/Printed Timeframe: "_BEGDT_" thru "_ENDDT
- +5 DO HDRINIT
- +6 DO HEADER
- if IBQUIT
- QUIT
- +7 DO PRINT
- +8 DO EXIT
- +9 QUIT
- +10 ;
- DATES ; Enter the date range for this report
- +1 NEW DIR
- +2 WRITE !
- +3 SET DIR(0)="DA^:DT:EX"
- SET DIR("A")="Enter Earliest Retransmitted/Printed Date: "
- +4 SET DIR("B")=$$HTE^XLFDT($HOROLOG-30)
- SET DIR("?")="Enter the earliest retransmitted or printed date for this report."
- +5 DO ^DIR
- KILL DIR
- if 'Y
- QUIT
- SET IBABEG=+Y
- SET BEGIN=Y(0)
- +6 ;
- +7 WRITE !
- +8 SET DIR(0)="DA^"_+Y_":DT:EX"
- SET DIR("A")="Enter Latest Retransmitted/Printed Date: "
- +9 SET DIR("B")=$$FMTE^XLFDT(DT,1)
- SET DIR("?")="Enter the latest retransmitted or printed date for this report."
- +10 DO ^DIR
- KILL DIR
- if 'Y
- QUIT
- SET IBAEND=+Y
- SET END=Y(0)
- +11 QUIT
- +12 ;
- DEVICE ; - Ask device
- +1 NEW %ZIS,ZTDESC,ZTIO,ZTQUEUED,ZTRTN,ZTSAVE
- +2 WRITE !!!,"You will need a 132 column printer for this report",!
- +3 SET %ZIS="QM"
- DO ^%ZIS
- if POP
- SET IBQUIT=1
- if POP
- QUIT
- +4 IF $DATA(IO("Q"))
- Begin DoDot:1
- +5 SET ZTRTN="QUE^IBCERPN"
- SET ZTDESC="Resubmission/Printing claims No Changes CSA Report"
- +6 SET (ZTSAVE("BEGIN"),ZTSAVE("END"),ZTSAVE("IBABEG"),ZTSAVE("IBAEND"))=""
- +7 SET (ZTSAVE("BEGDT"),ZTSAVE("ENDDT"),ZTSAVE("RNAME"),ZTSAVE("IBQUIT"))=""
- +8 DO ^%ZTLOAD
- +9 WRITE !!,$SELECT($DATA(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
- +10 KILL ZTSK
- DO HOME^%ZIS
- +11 ;pause to see task no.
- WRITE !!!
- IF $EXTRACT(IOST,1,2)["C-"
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- End DoDot:1
- SET IBQUIT=1
- QUIT
- +12 USE IO
- +13 QUIT
- +14 ;
- GATHER ;GATHER THE INFO BASED ON THE DATE RANGE ENTERED
- +1 ; Uses the ^IBM(361,"ARPN",CURDAT,IBNO,USER,ACTION) cross-reference file to get
- +2 ; data within date range. If data is within date range this sets up the ^TMP($J
- +3 ; file with all data needed for the report.
- +4 ;
- +5 NEW ACTION,ARPNRC,CURDAT,IBCBAL,IBCLMNO,IBIFN,IBNO,IBOAM,IBPAY
- +6 NEW LNCNT,SEQ,USER,USRNAM
- +7 SET $PIECE(DASH,"_",132)=""
- +8 SET LNTOT=0
- SET PGC=1
- SET MAX=IOSL
- +9 SET CURDAT=IBABEG
- +10 FOR
- SET CURDAT=$ORDER(^IBM(361,"ARPN",CURDAT))
- if CURDAT=""
- QUIT
- if CURDAT>(IBAEND+1)
- QUIT
- Begin DoDot:1
- +11 SET IBNO=""
- FOR
- SET IBNO=$ORDER(^IBM(361,"ARPN",CURDAT,IBNO))
- if IBNO=""
- QUIT
- Begin DoDot:2
- +12 SET IBIFN=+$GET(^IBM(361,IBNO,0))
- +13 ; External Claim No.
- SET IBCLMNO=$PIECE($GET(^DGCR(399,IBIFN,0)),U)
- +14 SET IBPAY=$PIECE($GET(^DIC(36,+$PIECE($GET(^DGCR(399,IBIFN,"MP")),U),0)),U)
- +15 IF IBPAY=""
- SET IBPAY=$PIECE($GET(^DIC(36,+$$CURR^IBCEF2(IBIFN),0)),U)
- +16 IF IBPAY=""
- SET IBPAY="UNKNOWN PAYER"
- +17 SET IBOAM=$GET(^DGCR(399,IBIFN,"U1"))
- +18 ; current balance (total charges - offset)
- SET IBCBAL=$PIECE(IBOAM,U,1)-$PIECE(IBOAM,U,2)
- +19 ; error message (60 chars max).
- SET IBEMSG=$$TXT^IBCECSA1(IBNO,60)
- +20 if IBEMSG=""
- SET IBEMSG=" "
- +21 SET SEQ=""
- FOR
- SET SEQ=$ORDER(^IBM(361,"ARPN",CURDAT,IBNO,SEQ))
- if SEQ=""
- QUIT
- Begin DoDot:3
- +22 ;S ARPNRC=$G(^IBM(361,"ARPN",CURDAT,IBNO,SEQ))
- +23 SET ARPNRC=$GET(^IBM(361,IBNO,3,SEQ,0))
- +24 SET USER=$PIECE(ARPNRC,U,2)
- SET ACTION=$PIECE(ARPNRC,U,3)
- +25 ; External User Name
- SET USRNAM=$PIECE(^VA(200,USER,0),U)
- +26 SET ^TMP(RNAME,$JOB,USRNAM,IBPAY,$EXTRACT(IBEMSG,1,50),CURDAT,IBCLMNO)=IBCBAL_U_ACTION_U_USER_U_IBIFN
- +27 SET LNTOT=LNTOT+1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +28 QUIT
- +29 ;
- PRINT ; Print data
- +1 ;
- +2 ; PGC=page ct,LNTOT=no of lines to be printed,LNCNT=when to page break
- +3 ; MAX=IOSL (device length)
- +4 ;
- +5 NEW CURDAT,EORMSG,IBCBAL,IBCLMNO,IBEMSG,IBPAY,LCTR,NONEMSG,USRNAM
- +6 SET EORMSG="*** END OF REPORT ***"
- +7 SET NONEMSG="* * * N O D A T A T O P R I N T * * *"
- +8 SET LCTR=0
- +9 ;
- +10 IF '$DATA(^TMP(RNAME,$JOB))
- WRITE !!!,NONEMSG
- DO END
- QUIT
- +11 SET USRNAM=""
- FOR
- SET USRNAM=$ORDER(^TMP(RNAME,$JOB,USRNAM))
- if USRNAM=""
- QUIT
- Begin DoDot:1
- +12 SET IBPAY=""
- FOR
- SET IBPAY=$ORDER(^TMP(RNAME,$JOB,USRNAM,IBPAY))
- if IBPAY=""
- QUIT
- Begin DoDot:2
- +13 SET IBEMSG=""
- FOR
- SET IBEMSG=$ORDER(^TMP(RNAME,$JOB,USRNAM,IBPAY,IBEMSG))
- if IBEMSG=""
- QUIT
- Begin DoDot:3
- +14 SET CURDAT=""
- FOR
- SET CURDAT=$ORDER(^TMP(RNAME,$JOB,USRNAM,IBPAY,IBEMSG,CURDAT))
- if CURDAT=""
- QUIT
- if IBQUIT
- QUIT
- Begin DoDot:4
- +15 SET IBCLMNO=""
- FOR
- SET IBCLMNO=$ORDER(^TMP(RNAME,$JOB,USRNAM,IBPAY,IBEMSG,CURDAT,IBCLMNO))
- if IBCLMNO=""
- QUIT
- if IBQUIT
- QUIT
- Begin DoDot:5
- +16 SET IBCBAL=+$GET(^TMP(RNAME,$JOB,USRNAM,IBPAY,IBEMSG,CURDAT,IBCLMNO))
- +17 IF LNCNT>MAX
- DO HEADER
- if IBQUIT
- QUIT
- +18 SET LCTR=LCTR+1
- +19 ;W !,$J(LCTR,4),?10,$E(IBPAY,1,20),?38,$E(USRNAM,1,15),?55,$E(IBEMSG,1,50),?111,$P($$FMTE^XLFDT(CURDAT,2),"@"),?120, $J("$"_$FN(IBCBAL,"",2),12)
- +20 WRITE !,$JUSTIFY(LCTR,3),?7,IBCLMNO,?16,$EXTRACT(IBPAY,1,20),?38,$EXTRACT(USRNAM,1,15),?59
- +21 WRITE $EXTRACT(IBEMSG,1,50),?111,$PIECE($$FMTE^XLFDT(CURDAT,2),"@"),?120,$JUSTIFY("$"_$FNUMBER(IBCBAL,"",2),12)
- +22 SET LNCNT=LNCNT+1
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +23 IF LNCNT>MAX
- DO HEADER
- +24 if IBQUIT
- QUIT
- +25 ;
- END WRITE !!!,?49,EORMSG,!!!
- +1 ;pause at end of report
- IF $EXTRACT(IOST,1,2)["C-"
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +2 QUIT
- +3 ;
- HDRINIT ; Initial setting
- +1 SET LNCNT=0
- +2 ; refresh terminal screen on 1st hdr
- IF PGC=1
- IF $EXTRACT(IOST,1,2)["C-"
- WRITE @IOF
- +3 IF 'LNTOT
- SET PAGES=1
- +4 IF LNTOT
- IF PGC=1
- Begin DoDot:1
- +5 SET LNCNT=0
- +6 SET PAGES=LNTOT/(MAX-10)
- +7 IF PAGES<1
- SET PAGES=1
- +8 ; if more than one page set whole number
- IF PAGES["."
- SET PAGES=$PIECE(PAGES+1,".")
- End DoDot:1
- +9 SET HDR1="Resubmission/Printing claims No Changes CSA Report"
- +10 SET HDR2=$$FMTE^XLFDT($$NOW^XLFDT,1)
- +11 QUIT
- +12 ;
- +1 NEW DIR,DUOUT
- +2 SET LNCNT=0
- +3 IF PGC'=1
- Begin DoDot:1
- +4 WRITE !
- +5 IF $EXTRACT(IOST,1,2)["C-"
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET IBQUIT=1
- if IBQUIT
- QUIT
- +6 ; refresh terminal screen on hdr
- WRITE @IOF
- End DoDot:1
- if IBQUIT
- QUIT
- +7 WRITE !,HDR1,?59,HDR2,?114," Page: "_PGC_" of "_PAGES
- +8 WRITE !,LEGEND
- +9 WRITE !!,?7,"Bill #",?17,"Payer Name",?38,"User Name",?59,"Error Message/Narrative/Category",?111,"Date",?124,"Curr Bal"
- +10 WRITE !,DASH
- +11 SET LNCNT=LNCNT+10
- SET PGC=PGC+1
- +12 QUIT
- EXIT() ;clean up and quit
- +1 NEW ZTREQ
- +2 ; Force a form feed at end of a printer report
- +3 IF $EXTRACT(IOST,1,2)'["C-"
- WRITE @IOF
- +4 ; handle device closing before exiting
- +5 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +6 IF '$DATA(ZTQUEUED)
- DO ^%ZISC
- +7 KILL ^TMP(RNAME,$JOB)
- +8 KILL BEGIN,BEGDT,ENDDT,IBABEG,IBAEND,IBQUIT,IEN,LNCNT,Y
- +9 QUIT
