IBCEMSR1 ;WOIFO/AAT - MRA STATISTICS REPORT CONT. ;09/03/04
;;2.0;INTEGRATED BILLING;**155,348,349**;21-MAR-94;Build 46
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
; Report header
HDR N IBI
S IBPAGE=IBPAGE+1
W @IOF,"MRA Statistics Report for period covering "_$$DAT(IBBDT)_" thru "_$$DAT(IBEDT)," ",?100,$$DAT(DT)," Page ",IBPAGE
W ! F IBI=1:1:$S($G(IOM):IOM,1:130) W "-"
Q
;
REPORT N IBDVN,IBCLERK,IBPAGE,IBTU,IBTH
S IBPAGE=0
D HDR
I '$D(@REF) W !,"No data meet the criteria." Q
I 'IBSUM S IBDVN="" F S IBDVN=$O(@REF@(IBDVN)) Q:IBDVN="" D Q:IBQ
. D CHKP Q:IBQ W !,"DIVISION: ",IBDVN
. S IBCLERK="A" F S IBCLERK=$O(@REF@(IBDVN,IBCLERK)) Q:IBCLERK="" D Q:IBQ
. . D DETAILS
Q:IBQ
; Summary section
D:'IBSUM HDR W !,"SUMMARY"
S IBDVN="" F S IBDVN=$O(@REF@(IBDVN)) Q:IBDVN="" D Q:IBQ
. D CHKP Q:IBQ W !,"DIVISION: ",IBDVN
. D SUMMARY
Q
;
DETAILS ; Print Details
N REFU,REFU,IBTXT,IBNU,IBNH,IBTU,IBTH
;
S REFU=$NA(@REF@(IBDVN,IBCLERK,3))
S REFH=$NA(@REF@(IBDVN,IBCLERK,2))
;
D CHKP Q:IBQ W !,"CLERK: ",IBCLERK
D CHKP Q:IBQ W !?7,"Primary UB-04 MRA Requests",?67,"Primary CMS-1500 MRA Requests"
D CHKP Q:IBQ W !?7,"--------------------------",?67,"-----------------------------"
S IBTXT="Total number of MRA Requests:"
D CHKP Q:IBQ W !?7,IBTXT,?50,$J(+$G(@REFU@("ALL")),5),?67,IBTXT,?110,$J(+$G(@REFH@("ALL")),5)
S IBTXT="Number of unique MRA Requests:",IBTU=+$G(@REFU@("TOT")),IBTH=+$G(@REFH@("TOT"))
D CHKP Q:IBQ W !?7,IBTXT,?50,$J(IBTU,5),?67,IBTXT,?110,$J(IBTH,5)
S IBTXT="Requests with no response:",IBNU=+$G(@REFU@("NON")),IBNH=+$G(@REFH@("NON"))
D CHKP Q:IBQ W !?7,IBTXT,?50,$J(IBNU,5),?67,IBTXT,?110,$J(IBNH,5)
S IBTXT="Requests with final rejection:",IBNU=+$G(@REFU@("REJF")),IBNH=+$G(@REFH@("REJF"))
D CHKP Q:IBQ W !?7,IBTXT,?50,$J(IBNU,5),?67,IBTXT,?110,$J(IBNH,5)
;
S IBTXT="Requests with returned MRA:",IBNU=+$G(@REFU@("MRA")),IBNH=+$G(@REFH@("MRA"))
D CHKP Q:IBQ W !?7,IBTXT,?50,$J(IBNU,5),?67,IBTXT,?110,$J(IBNH,5)
S IBTXT="Processed MRA:"
D CHKP Q:IBQ W !?14,IBTXT,?35,$J($G(@REFU@("MRA"))-$G(@REFU@("MRAD")),5),?74,IBTXT,?90,$J($G(@REFH@("MRA"))-$G(@REFH@("MRAD")),5)
S IBTXT="Denied MRA:"
D CHKP Q:IBQ W !?14,IBTXT,?35,$J(+$G(@REFU@("MRAD")),5),?74,IBTXT,?90,$J(+$G(@REFH@("MRAD")),5)
D CHKP Q:IBQ W !
;
D SECONDRY Q:IBQ
D CHKP Q:IBQ W !
Q
;
SUMMARY ;Print summary
N REFU,REFH,IBTXT,IBNU,IBNH,IBTU,IBTH
;
S REFU=$NA(@REF@(IBDVN,0,3))
S REFH=$NA(@REF@(IBDVN,0,2))
;
D CHKP Q:IBQ W !?7,"Primary UB-04 MRA Requests",?67,"Primary CMS-1500 MRA Requests"
D CHKP Q:IBQ W !?7,"--------------------------",?67,"-----------------------------"
S IBTXT="Total number of MRA Requests:",IBTU=+$G(@REFU@("ALL")),IBTH=+$G(@REFH@("ALL"))
D CHKP Q:IBQ W !?7,IBTXT,?50,$J(IBTU,5),?67,IBTXT,?110,$J(IBTH,5)
S IBTXT="Percent Resubmitted:",IBNU=+$G(@REFU@("ALLR")),IBNH=+$G(@REFH@("ALLR"))
D CHKP Q:IBQ W !?14,IBTXT,?50,$$%(IBNU,IBTU),?74,IBTXT,?110,$$%(IBNH,IBTH)
S IBTXT="Percent Cancelled/Copied:",IBNU=+$G(@REFU@("ALLC")),IBNH=+$G(@REFH@("ALLC"))
D CHKP Q:IBQ W !?14,IBTXT,?50,$$%(IBNU,IBTU),?74,IBTXT,?110,$$%(IBNH,IBTH)
S IBTXT="Number of unique MRA Requests:",IBTU=+$G(@REFU@("TOT")),IBTH=+$G(@REFH@("TOT"))
D CHKP Q:IBQ W !?7,IBTXT,?50,$J(IBTU,5),?67,IBTXT,?110,$J(IBTH,5)
S IBTXT="Requests with no response:",IBNU=+$G(@REFU@("NON")),IBNH=+$G(@REFH@("NON"))
D CHKP Q:IBQ W !?7,IBTXT,?50,$J(IBNU,5),?67,IBTXT,?110,$J(IBNH,5)
S IBTXT="Requests with final rejection:",IBNU=+$G(@REFU@("REJF")),IBNH=+$G(@REFH@("REJF"))
D CHKP Q:IBQ W !?7,IBTXT,?50,$J(IBNU,5),?67,IBTXT,?110,$J(IBNH,5)
S IBTXT="Percent with final rejection:"
D CHKP Q:IBQ W !?14,IBTXT,?50,$$%(IBNU,IBTU),?74,IBTXT,?110,$$%(IBNH,IBTH)
S IBTXT="Requests with returned MRA:",IBTU=+$G(@REFU@("MRA")),IBTH=+$G(@REFH@("MRA"))
D CHKP Q:IBQ W !?7,IBTXT,?50,$J(IBTU,5),?67,IBTXT,?110,$J(IBTH,5)
S IBTXT="Processed MRA:",IBNU=IBTU-$G(@REFU@("MRAD")),IBNH=IBTH-$G(@REFH@("MRAD"))
D CHKP Q:IBQ W !?7,IBTXT,?50,$J(IBNU,5),?67,IBTXT,?110,$J(IBNH,5)
S IBTXT="Denied MRA:"
D CHKP Q:IBQ W !?7,IBTXT,?50,$J(+$G(@REFU@("MRAD")),5),?67,IBTXT,?110,$J(+$G(@REFH@("MRAD")),5)
S IBTXT="Percent Processed MRA:"
D CHKP Q:IBQ W !?14,IBTXT,?50,$$%(IBNU,IBTU),?74,IBTXT,?110,$$%(IBNH,IBTH)
D CHKP Q:IBQ W !
;
D SECONDRY Q:IBQ
S IBTXT="Percent Unique Req to Secondary:"
D CHKP Q:IBQ W !?7,IBTXT,?50,$J($$%(+$G(@REFU@("SEC")),+$G(@REFU@("TOT"))),5),?67,IBTXT,?110,$J($$%(+$G(@REFH@("SEC")),+$G(@REFH@("TOT"))),5)
S IBTXT="Percent Auto-Generated:"
D CHKP Q:IBQ W !?14,IBTXT,?50,$J($$%($G(@REFU@("AT"))+$G(@REFU@("AP")),+$G(@REFU@("TOT"))),5),?67,IBTXT,?110,$J($$%($G(@REFH@("AT"))+$G(@REFH@("AP")),+$G(@REFH@("TOT"))),5)
S IBTXT="Percent Manually-Processed:"
D CHKP Q:IBQ W !?14,IBTXT,?50,$J($$%($G(@REFU@("MT"))+$G(@REFU@("MP")),+$G(@REFU@("TOT"))),5),?67,IBTXT,?110,$J($$%($G(@REFH@("MT"))+$G(@REFH@("MP")),+$G(@REFH@("TOT"))),5)
;
D CHKP Q:IBQ W !
Q
;
SECONDRY ; Print 2ndary claims info
D CHKP Q:IBQ W !?7,"Secondary UB-04 claims",?67,"Secondary CMS-1500 claims"
D CHKP Q:IBQ W !?7,"----------------------",?67,"-------------------------"
S IBTXT="Authorized (not yet printed):"
D CHKP Q:IBQ W !?7,IBTXT,?50,$J(+$G(@REFU@("AUT")),5),?67,IBTXT,?110,$J(+$G(@REFH@("AUT")),5)
;
S IBTXT="Auto-generated to print:"
D CHKP Q:IBQ W !?7,IBTXT,?50,$J(+$G(@REFU@("AP")),5),?67,IBTXT,?110,$J(+$G(@REFH@("AP")),5)
S IBTXT="Total Primary Charges:"
D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("AP1")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("AP1")),10,2)
S IBTXT="Unreimb'd Medicare Exp:"
D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("AP2")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("AP2")),10,2)
S IBTXT="Total Secondary Charges:"
D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("AP3")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("AP3")),10,2)
;
S IBTXT="Auto-generated to transmit:"
D CHKP Q:IBQ W !?7,IBTXT,?50,$J(+$G(@REFU@("AT")),5),?67,IBTXT,?110,$J(+$G(@REFH@("AT")),5)
S IBTXT="Total Primary Charges:"
D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("AT1")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("AT1")),10,2)
S IBTXT="Unreimb'd Medicare Exp:"
D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("AT2")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("AT2")),10,2)
S IBTXT="Total Secondary Charges:"
D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("AT3")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("AT3")),10,2)
;
S IBTXT="Manually processed to print:"
D CHKP Q:IBQ W !?7,IBTXT,?50,$J(+$G(@REFU@("MP")),5),?67,IBTXT,?110,$J(+$G(@REFH@("MP")),5)
S IBTXT="Total Primary Charges:"
D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("MP1")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("MP1")),10,2)
S IBTXT="Unreimb'd Medicare Exp:"
D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("MP2")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("MP2")),10,2)
S IBTXT="Total Secondary Charges:"
D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("MP3")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("MP3")),10,2)
;
S IBTXT="Manually processed to transmit:"
D CHKP Q:IBQ W !?7,IBTXT,?50,$J(+$G(@REFU@("MT")),5),?67,IBTXT,?110,$J(+$G(@REFH@("MT")),5)
S IBTXT="Total Primary Charges:"
D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("MT1")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("MT1")),10,2)
S IBTXT="Unreimb'd Medicare Exp:"
D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("MT2")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("MT2")),10,2)
S IBTXT="Total Secondary Charges:"
D CHKP Q:IBQ W !?14,IBTXT,?45,$J(+$G(@REFU@("MT3")),10,2),?74,IBTXT,?105,$J(+$G(@REFH@("MT3")),10,2)
Q
;
;
%(VALUE,TOTAL) ;Percentage
I 'TOTAL Q $J("0%",6)
Q $J($J(VALUE*100/TOTAL,3,0)_"%",6)
;
CHKP ;Check for EOP
I $Y>(IOSL-4) D:IBSCR PAUSE Q:IBQ D HDR
Q
;
PAUSE ;
N X U IO(0) W !!,"Press RETURN to continue, '^' to exit:" R X:DTIME S:'$T X="^" S:X["^" IBQ=2
U IO
Q
;
PAUSE2 ;
N X U IO(0) W !!,"Press RETURN to continue:" R X:DTIME S:'$T X="^" S:X["^" IBQ=2
U IO
Q
;
DAT(X) ;Convert FM date to displayable (mm/dd/yy) format.
N DATE,YR
I $G(X) S YR=$E(X,2,3)
I $G(X) S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_YR,1:"")
Q $G(DATE)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEMSR1 8206 printed Dec 13, 2024@02:11:04 Page 2
IBCEMSR1 ;WOIFO/AAT - MRA STATISTICS REPORT CONT. ;09/03/04
+1 ;;2.0;INTEGRATED BILLING;**155,348,349**;21-MAR-94;Build 46
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ; Report header
HDR NEW IBI
+1 SET IBPAGE=IBPAGE+1
+2 WRITE @IOF,"MRA Statistics Report for period covering "_$$DAT(IBBDT)_" thru "_$$DAT(IBEDT)," ",?100,$$DAT(DT)," Page ",IBPAGE
+3 WRITE !
FOR IBI=1:1:$SELECT($GET(IOM):IOM,1:130)
WRITE "-"
+4 QUIT
+5 ;
REPORT NEW IBDVN,IBCLERK,IBPAGE,IBTU,IBTH
+1 SET IBPAGE=0
+2 DO HDR
+3 IF '$DATA(@REF)
WRITE !,"No data meet the criteria."
QUIT
+4 IF 'IBSUM
SET IBDVN=""
FOR
SET IBDVN=$ORDER(@REF@(IBDVN))
if IBDVN=""
QUIT
Begin DoDot:1
+5 DO CHKP
if IBQ
QUIT
WRITE !,"DIVISION: ",IBDVN
+6 SET IBCLERK="A"
FOR
SET IBCLERK=$ORDER(@REF@(IBDVN,IBCLERK))
if IBCLERK=""
QUIT
Begin DoDot:2
+7 DO DETAILS
End DoDot:2
if IBQ
QUIT
End DoDot:1
if IBQ
QUIT
+8 if IBQ
QUIT
+9 ; Summary section
+10 if 'IBSUM
DO HDR
WRITE !,"SUMMARY"
+11 SET IBDVN=""
FOR
SET IBDVN=$ORDER(@REF@(IBDVN))
if IBDVN=""
QUIT
Begin DoDot:1
+12 DO CHKP
if IBQ
QUIT
WRITE !,"DIVISION: ",IBDVN
+13 DO SUMMARY
End DoDot:1
if IBQ
QUIT
+14 QUIT
+15 ;
DETAILS ; Print Details
+1 NEW REFU,REFU,IBTXT,IBNU,IBNH,IBTU,IBTH
+2 ;
+3 SET REFU=$NAME(@REF@(IBDVN,IBCLERK,3))
+4 SET REFH=$NAME(@REF@(IBDVN,IBCLERK,2))
+5 ;
+6 DO CHKP
if IBQ
QUIT
WRITE !,"CLERK: ",IBCLERK
+7 DO CHKP
if IBQ
QUIT
WRITE !?7,"Primary UB-04 MRA Requests",?67,"Primary CMS-1500 MRA Requests"
+8 DO CHKP
if IBQ
QUIT
WRITE !?7,"--------------------------",?67,"-----------------------------"
+9 SET IBTXT="Total number of MRA Requests:"
+10 DO CHKP
if IBQ
QUIT
WRITE !?7,IBTXT,?50,$JUSTIFY(+$GET(@REFU@("ALL")),5),?67,IBTXT,?110,$JUSTIFY(+$GET(@REFH@("ALL")),5)
+11 SET IBTXT="Number of unique MRA Requests:"
SET IBTU=+$GET(@REFU@("TOT"))
SET IBTH=+$GET(@REFH@("TOT"))
+12 DO CHKP
if IBQ
QUIT
WRITE !?7,IBTXT,?50,$JUSTIFY(IBTU,5),?67,IBTXT,?110,$JUSTIFY(IBTH,5)
+13 SET IBTXT="Requests with no response:"
SET IBNU=+$GET(@REFU@("NON"))
SET IBNH=+$GET(@REFH@("NON"))
+14 DO CHKP
if IBQ
QUIT
WRITE !?7,IBTXT,?50,$JUSTIFY(IBNU,5),?67,IBTXT,?110,$JUSTIFY(IBNH,5)
+15 SET IBTXT="Requests with final rejection:"
SET IBNU=+$GET(@REFU@("REJF"))
SET IBNH=+$GET(@REFH@("REJF"))
+16 DO CHKP
if IBQ
QUIT
WRITE !?7,IBTXT,?50,$JUSTIFY(IBNU,5),?67,IBTXT,?110,$JUSTIFY(IBNH,5)
+17 ;
+18 SET IBTXT="Requests with returned MRA:"
SET IBNU=+$GET(@REFU@("MRA"))
SET IBNH=+$GET(@REFH@("MRA"))
+19 DO CHKP
if IBQ
QUIT
WRITE !?7,IBTXT,?50,$JUSTIFY(IBNU,5),?67,IBTXT,?110,$JUSTIFY(IBNH,5)
+20 SET IBTXT="Processed MRA:"
+21 DO CHKP
if IBQ
QUIT
WRITE !?14,IBTXT,?35,$JUSTIFY($GET(@REFU@("MRA"))-$GET(@REFU@("MRAD")),5),?74,IBTXT,?90,$JUSTIFY($GET(@REFH@("MRA"))-$GET(@REFH@("MRAD")),5)
+22 SET IBTXT="Denied MRA:"
+23 DO CHKP
if IBQ
QUIT
WRITE !?14,IBTXT,?35,$JUSTIFY(+$GET(@REFU@("MRAD")),5),?74,IBTXT,?90,$JUSTIFY(+$GET(@REFH@("MRAD")),5)
+24 DO CHKP
if IBQ
QUIT
WRITE !
+25 ;
+26 DO SECONDRY
if IBQ
QUIT
+27 DO CHKP
if IBQ
QUIT
WRITE !
+28 QUIT
+29 ;
SUMMARY ;Print summary
+1 NEW REFU,REFH,IBTXT,IBNU,IBNH,IBTU,IBTH
+2 ;
+3 SET REFU=$NAME(@REF@(IBDVN,0,3))
+4 SET REFH=$NAME(@REF@(IBDVN,0,2))
+5 ;
+6 DO CHKP
if IBQ
QUIT
WRITE !?7,"Primary UB-04 MRA Requests",?67,"Primary CMS-1500 MRA Requests"
+7 DO CHKP
if IBQ
QUIT
WRITE !?7,"--------------------------",?67,"-----------------------------"
+8 SET IBTXT="Total number of MRA Requests:"
SET IBTU=+$GET(@REFU@("ALL"))
SET IBTH=+$GET(@REFH@("ALL"))
+9 DO CHKP
if IBQ
QUIT
WRITE !?7,IBTXT,?50,$JUSTIFY(IBTU,5),?67,IBTXT,?110,$JUSTIFY(IBTH,5)
+10 SET IBTXT="Percent Resubmitted:"
SET IBNU=+$GET(@REFU@("ALLR"))
SET IBNH=+$GET(@REFH@("ALLR"))
+11 DO CHKP
if IBQ
QUIT
WRITE !?14,IBTXT,?50,$$%(IBNU,IBTU),?74,IBTXT,?110,$$%(IBNH,IBTH)
+12 SET IBTXT="Percent Cancelled/Copied:"
SET IBNU=+$GET(@REFU@("ALLC"))
SET IBNH=+$GET(@REFH@("ALLC"))
+13 DO CHKP
if IBQ
QUIT
WRITE !?14,IBTXT,?50,$$%(IBNU,IBTU),?74,IBTXT,?110,$$%(IBNH,IBTH)
+14 SET IBTXT="Number of unique MRA Requests:"
SET IBTU=+$GET(@REFU@("TOT"))
SET IBTH=+$GET(@REFH@("TOT"))
+15 DO CHKP
if IBQ
QUIT
WRITE !?7,IBTXT,?50,$JUSTIFY(IBTU,5),?67,IBTXT,?110,$JUSTIFY(IBTH,5)
+16 SET IBTXT="Requests with no response:"
SET IBNU=+$GET(@REFU@("NON"))
SET IBNH=+$GET(@REFH@("NON"))
+17 DO CHKP
if IBQ
QUIT
WRITE !?7,IBTXT,?50,$JUSTIFY(IBNU,5),?67,IBTXT,?110,$JUSTIFY(IBNH,5)
+18 SET IBTXT="Requests with final rejection:"
SET IBNU=+$GET(@REFU@("REJF"))
SET IBNH=+$GET(@REFH@("REJF"))
+19 DO CHKP
if IBQ
QUIT
WRITE !?7,IBTXT,?50,$JUSTIFY(IBNU,5),?67,IBTXT,?110,$JUSTIFY(IBNH,5)
+20 SET IBTXT="Percent with final rejection:"
+21 DO CHKP
if IBQ
QUIT
WRITE !?14,IBTXT,?50,$$%(IBNU,IBTU),?74,IBTXT,?110,$$%(IBNH,IBTH)
+22 SET IBTXT="Requests with returned MRA:"
SET IBTU=+$GET(@REFU@("MRA"))
SET IBTH=+$GET(@REFH@("MRA"))
+23 DO CHKP
if IBQ
QUIT
WRITE !?7,IBTXT,?50,$JUSTIFY(IBTU,5),?67,IBTXT,?110,$JUSTIFY(IBTH,5)
+24 SET IBTXT="Processed MRA:"
SET IBNU=IBTU-$GET(@REFU@("MRAD"))
SET IBNH=IBTH-$GET(@REFH@("MRAD"))
+25 DO CHKP
if IBQ
QUIT
WRITE !?7,IBTXT,?50,$JUSTIFY(IBNU,5),?67,IBTXT,?110,$JUSTIFY(IBNH,5)
+26 SET IBTXT="Denied MRA:"
+27 DO CHKP
if IBQ
QUIT
WRITE !?7,IBTXT,?50,$JUSTIFY(+$GET(@REFU@("MRAD")),5),?67,IBTXT,?110,$JUSTIFY(+$GET(@REFH@("MRAD")),5)
+28 SET IBTXT="Percent Processed MRA:"
+29 DO CHKP
if IBQ
QUIT
WRITE !?14,IBTXT,?50,$$%(IBNU,IBTU),?74,IBTXT,?110,$$%(IBNH,IBTH)
+30 DO CHKP
if IBQ
QUIT
WRITE !
+31 ;
+32 DO SECONDRY
if IBQ
QUIT
+33 SET IBTXT="Percent Unique Req to Secondary:"
+34 DO CHKP
if IBQ
QUIT
WRITE !?7,IBTXT,?50,$JUSTIFY($$%(+$GET(@REFU@("SEC")),+$GET(@REFU@("TOT"))),5),?67,IBTXT,?110,$JUSTIFY($$%(+$GET(@REFH@("SEC")),+$GET(@REFH@("TOT"))),5)
+35 SET IBTXT="Percent Auto-Generated:"
+36 DO CHKP
if IBQ
QUIT
WRITE !?14,IBTXT,?50,$JUSTIFY($$%($GET(@REFU@("AT"))+$GET(@REFU@("AP")),+$GET(@REFU@("TOT"))),5),?67,IBTXT,?110,$JUSTIFY($$%($GET(@REFH@("AT"))+$GET(@REFH@("AP")),+$GET(@REFH@("TOT"))),5)
+37 SET IBTXT="Percent Manually-Processed:"
+38 DO CHKP
if IBQ
QUIT
WRITE !?14,IBTXT,?50,$JUSTIFY($$%($GET(@REFU@("MT"))+$GET(@REFU@("MP")),+$GET(@REFU@("TOT"))),5),?67,IBTXT,?110,$JUSTIFY($$%($GET(@REFH@("MT"))+$GET(@REFH@("MP")),+$GET(@REFH@("TOT"))),5)
+39 ;
+40 DO CHKP
if IBQ
QUIT
WRITE !
+41 QUIT
+42 ;
SECONDRY ; Print 2ndary claims info
+1 DO CHKP
if IBQ
QUIT
WRITE !?7,"Secondary UB-04 claims",?67,"Secondary CMS-1500 claims"
+2 DO CHKP
if IBQ
QUIT
WRITE !?7,"----------------------",?67,"-------------------------"
+3 SET IBTXT="Authorized (not yet printed):"
+4 DO CHKP
if IBQ
QUIT
WRITE !?7,IBTXT,?50,$JUSTIFY(+$GET(@REFU@("AUT")),5),?67,IBTXT,?110,$JUSTIFY(+$GET(@REFH@("AUT")),5)
+5 ;
+6 SET IBTXT="Auto-generated to print:"
+7 DO CHKP
if IBQ
QUIT
WRITE !?7,IBTXT,?50,$JUSTIFY(+$GET(@REFU@("AP")),5),?67,IBTXT,?110,$JUSTIFY(+$GET(@REFH@("AP")),5)
+8 SET IBTXT="Total Primary Charges:"
+9 DO CHKP
if IBQ
QUIT
WRITE !?14,IBTXT,?45,$JUSTIFY(+$GET(@REFU@("AP1")),10,2),?74,IBTXT,?105,$JUSTIFY(+$GET(@REFH@("AP1")),10,2)
+10 SET IBTXT="Unreimb'd Medicare Exp:"
+11 DO CHKP
if IBQ
QUIT
WRITE !?14,IBTXT,?45,$JUSTIFY(+$GET(@REFU@("AP2")),10,2),?74,IBTXT,?105,$JUSTIFY(+$GET(@REFH@("AP2")),10,2)
+12 SET IBTXT="Total Secondary Charges:"
+13 DO CHKP
if IBQ
QUIT
WRITE !?14,IBTXT,?45,$JUSTIFY(+$GET(@REFU@("AP3")),10,2),?74,IBTXT,?105,$JUSTIFY(+$GET(@REFH@("AP3")),10,2)
+14 ;
+15 SET IBTXT="Auto-generated to transmit:"
+16 DO CHKP
if IBQ
QUIT
WRITE !?7,IBTXT,?50,$JUSTIFY(+$GET(@REFU@("AT")),5),?67,IBTXT,?110,$JUSTIFY(+$GET(@REFH@("AT")),5)
+17 SET IBTXT="Total Primary Charges:"
+18 DO CHKP
if IBQ
QUIT
WRITE !?14,IBTXT,?45,$JUSTIFY(+$GET(@REFU@("AT1")),10,2),?74,IBTXT,?105,$JUSTIFY(+$GET(@REFH@("AT1")),10,2)
+19 SET IBTXT="Unreimb'd Medicare Exp:"
+20 DO CHKP
if IBQ
QUIT
WRITE !?14,IBTXT,?45,$JUSTIFY(+$GET(@REFU@("AT2")),10,2),?74,IBTXT,?105,$JUSTIFY(+$GET(@REFH@("AT2")),10,2)
+21 SET IBTXT="Total Secondary Charges:"
+22 DO CHKP
if IBQ
QUIT
WRITE !?14,IBTXT,?45,$JUSTIFY(+$GET(@REFU@("AT3")),10,2),?74,IBTXT,?105,$JUSTIFY(+$GET(@REFH@("AT3")),10,2)
+23 ;
+24 SET IBTXT="Manually processed to print:"
+25 DO CHKP
if IBQ
QUIT
WRITE !?7,IBTXT,?50,$JUSTIFY(+$GET(@REFU@("MP")),5),?67,IBTXT,?110,$JUSTIFY(+$GET(@REFH@("MP")),5)
+26 SET IBTXT="Total Primary Charges:"
+27 DO CHKP
if IBQ
QUIT
WRITE !?14,IBTXT,?45,$JUSTIFY(+$GET(@REFU@("MP1")),10,2),?74,IBTXT,?105,$JUSTIFY(+$GET(@REFH@("MP1")),10,2)
+28 SET IBTXT="Unreimb'd Medicare Exp:"
+29 DO CHKP
if IBQ
QUIT
WRITE !?14,IBTXT,?45,$JUSTIFY(+$GET(@REFU@("MP2")),10,2),?74,IBTXT,?105,$JUSTIFY(+$GET(@REFH@("MP2")),10,2)
+30 SET IBTXT="Total Secondary Charges:"
+31 DO CHKP
if IBQ
QUIT
WRITE !?14,IBTXT,?45,$JUSTIFY(+$GET(@REFU@("MP3")),10,2),?74,IBTXT,?105,$JUSTIFY(+$GET(@REFH@("MP3")),10,2)
+32 ;
+33 SET IBTXT="Manually processed to transmit:"
+34 DO CHKP
if IBQ
QUIT
WRITE !?7,IBTXT,?50,$JUSTIFY(+$GET(@REFU@("MT")),5),?67,IBTXT,?110,$JUSTIFY(+$GET(@REFH@("MT")),5)
+35 SET IBTXT="Total Primary Charges:"
+36 DO CHKP
if IBQ
QUIT
WRITE !?14,IBTXT,?45,$JUSTIFY(+$GET(@REFU@("MT1")),10,2),?74,IBTXT,?105,$JUSTIFY(+$GET(@REFH@("MT1")),10,2)
+37 SET IBTXT="Unreimb'd Medicare Exp:"
+38 DO CHKP
if IBQ
QUIT
WRITE !?14,IBTXT,?45,$JUSTIFY(+$GET(@REFU@("MT2")),10,2),?74,IBTXT,?105,$JUSTIFY(+$GET(@REFH@("MT2")),10,2)
+39 SET IBTXT="Total Secondary Charges:"
+40 DO CHKP
if IBQ
QUIT
WRITE !?14,IBTXT,?45,$JUSTIFY(+$GET(@REFU@("MT3")),10,2),?74,IBTXT,?105,$JUSTIFY(+$GET(@REFH@("MT3")),10,2)
+41 QUIT
+42 ;
+43 ;
%(VALUE,TOTAL) ;Percentage
+1 IF 'TOTAL
QUIT $JUSTIFY("0%",6)
+2 QUIT $JUSTIFY($JUSTIFY(VALUE*100/TOTAL,3,0)_"%",6)
+3 ;
CHKP ;Check for EOP
+1 IF $Y>(IOSL-4)
if IBSCR
DO PAUSE
if IBQ
QUIT
DO HDR
+2 QUIT
+3 ;
PAUSE ;
+1 NEW X
USE IO(0)
WRITE !!,"Press RETURN to continue, '^' to exit:"
READ X:DTIME
if '$TEST
SET X="^"
if X["^"
SET IBQ=2
+2 USE IO
+3 QUIT
+4 ;
PAUSE2 ;
+1 NEW X
USE IO(0)
WRITE !!,"Press RETURN to continue:"
READ X:DTIME
if '$TEST
SET X="^"
if X["^"
SET IBQ=2
+2 USE IO
+3 QUIT
+4 ;
DAT(X) ;Convert FM date to displayable (mm/dd/yy) format.
+1 NEW DATE,YR
+2 IF $GET(X)
SET YR=$EXTRACT(X,2,3)
+3 IF $GET(X)
SET DATE=$SELECT(X:$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_YR,1:"")
+4 QUIT $GET(DATE)
+5 ;
