ABMRDNY1 ; IHS/SD/SDR - Printer - Fixed Length Record (Paper printing) ;
;;2.6;IHS Third Party Billing;**21**;NOV 12, 2009;Build 379
;IHS/SD/SDR - 2.6*21 - HEAT241429 - New Report
;
PRINT ;EP for printing data
S ABM("TXT")=""
D HDB
S (ABM("CNT"),ABM("SUBCNT"))=0
S ABM("PRV")=""
S ABM("A")="TMP(""ABM-RDNY"","_$J
S ABM="^"_ABM("A")_")"
I '$D(@ABM) Q
F S ABM=$Q(@ABM) Q:ABM'[ABM("A") D Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.S ABM("T")=$P(ABM,"ABM-RDNY",2)
.S ABM("TXT")=+$P(ABM("T"),",",5) ;BDFN
.I $Y>(IOSL-5) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) D PRV W " (cont)"
.S ABM("C")=$G(^ABMDBILL(DUZ(2),ABM("TXT"),0)) Q:ABM("C")=""
.Q:'ABM("C")!'$P(ABM("C"),U,7)!'$P(ABM("C"),U,8)
.I ABM("PRV")'=$TR($P(ABM("T"),",",3,4),"""") S ABM("PRV")="" D SUB,PRV
.S ABM("PRV")=$TR($P(ABM("T"),",",3,4),"""") ;provider name
.W !,$E($P(ABM("C"),U),1,10) ;bill number
.W ?12,$$SDT^ABMDUTL($P($G(^ABMDBILL(DUZ(2),ABM("TXT"),7)),U)) ;DOS
.;
.S ABMP("INS")=$P(ABM("C"),U,8)
.S ABMP("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")
.S ABMP("VTYP")=$P(ABM("C"),U,7)
.S ABMP("CLN")=$P(ABM("C"),U,10)
.S ABMP("CLIN")=$$GET1^DIQ(40.7,$P(ABM("C"),U,10),"1","E")
.S ABMP("BDFN")=ABM("TXT")
.S ABMP("VDT")=$P($G(^ABMDBILL(DUZ(2),ABM("TXT"),7)),U)
.S ABMP("BTYP")=$P(ABM("C"),U,2)
.S ABMP("LDFN")=$P(ABM("C"),U,3)
.S ABMP("EXP")=$P(ABM("C"),U,6)
.D CPTS ;gather CPTs on claim
.D PSTING ;gather posting info
.;
.W ?24,$E($P($G(ABMT(1)),U,2),1,7) ;first CPT
.W ?32,$E($P($G(^AUTNINS($P(ABM("C"),U,8),0)),U),1,12) ;active insurer
.W ?46,$J($FN(+$P($G(ABMT(1)),U,6),",",2),9) ;billed
.W ?57,$J($FN(+$G(ABMD("P")),",",2),9) ;paid
.W ?67,$J($FN(+$G(ABMD(1)),",",2),9) ;denial
.S ABMD("DTOT")=+$G(ABMD("DTOT"))+$G(ABMD(1))
.W ?77,$P($G(ABMD(1)),U,2) ;SAR
.S ABM("CNT")=ABM("CNT")+1,ABM("SUBCNT")=ABM("SUBCNT")+1
.;
.I $O(ABMT(9999999),-1)>1!($O(ABMD(9999),-1)>1) D
..F ABMI=2:1 D Q:'$D(ABMT(ABMI))&('$D(ABMD(ABMI)))
...Q:'$D(ABMT(ABMI))&('$D(ABMD(ABMI))) ;quit if no further entries for either
...W !
...I $P($G(ABMT(ABMI)),U,2)'="" D Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ;if there's a CPT on the line
....W ?24,$E($P(ABMT(ABMI),U,2),1,7) ;CPT
....W ?46,$J($FN(+$P($G(ABMT(ABMI)),U,6),",",2),9) ;billed
...I +$P($G(ABMD(ABMI)),U)'=0 W ?67,$J($FN(+$P($G(ABMD(ABMI)),U),",",2),9) S ABMD("DTOT")=+$G(ABMD("DTOT"))+$P($G(ABMD(ABMI)),U) ;denied
...I $P($G(ABMD(ABMI)),U,2)'="" W ?77,$P($G(ABMD(ABMI)),U,2) ;SAR
...I $Y>(IOSL-5) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) D PRV W " (cont)"
.;
.W !,?46,"---------",?57,"---------",?67,"---------"
.S ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_",",ABMP("TOT")=0,ABMP("NC")=0
.D ^ABMDESM1
.W !?20,"Total for Bill: ",$E($P(ABM("C"),U),1,10),?46,$J($FN(+$G(ABMS("TOT")),",",2),9),?57,$J($FN(+$G(ABMD("P")),",",2),9),?67,$J($FN(+$G(ABMD("DTOT")),",",2),9),!
Q:$D(DIROUT)!($D(DUOUT))!($D(DTOUT))
D SUB
W !?52,"======"
W !?46,"Total:",?52,$FN(ABM("CNT"),",",0)
Q
;
HD D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
HDB ;
S ABM("PG")=ABM("PG")+1
D WHD^ABMDRHD
W !,"Bill#",?12,"DOS",?24,"CPT",?30,"Active Insurer",?47,"Billed",?57,"Paid",?67,"Denied",?77,"SAR"
S $P(ABM("LINE"),"-",80)="" W !,ABM("LINE") K ABM("LINE")
Q
;
PRV ;
W !!?3,"Provider: ",$TR($P(ABM("T"),",",3,4),"""")
Q
;
SUB ;
Q
Q:'ABM("SUBCNT")
W !?27,"------"
W !?3,"#Claims for provider:",?27,$FN(ABM("SUBCNT"),",",0)
S ABM("SUBCNT")=0
Q
CPTS ;EP
N ABM
K ABMRV,ABMT,ABMD
S ABMTCNT=1
D ^ABMEHGRV
S ABMI=0
F S ABMI=$O(ABMRV(ABMI)) Q:'ABMI D
.S ABMJ=0
.F S ABMJ=$O(ABMRV(ABMI,ABMJ)) Q:'ABMJ D
..S ABMK=0
..F S ABMK=$O(ABMRV(ABMI,ABMJ,ABMK)) Q:(ABMK="") D
...S ABMT(ABMTCNT)=$G(ABMRV(ABMI,ABMJ,ABMK))
...S ABMTCNT=+$G(ABMTCNT)+1
Q
PSTING ;EP
S ABMB=0
S ABMTCNT=1
F S ABMB=$O(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB)) Q:'ABMB D
.S ABMD("P")=+$G(ABMD("P"))+$P($G(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,10)
.F ABMA=3,4,6,7,9,12,13 D
..I +$P($G(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,ABMA)'=0 D
...S ABMD(ABMTCNT)=+$P($G(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,ABMA)
...I +$P($G(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,17)'=0 S ABMD(ABMTCNT)=ABMD(ABMTCNT)_U_$$GET1^DIQ(90056.06,$P($G(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,17),".01","E")
...S ABMTCNT=+$G(ABMTCNT)+1
Q
ABMRDNY1 ; IHS/SD/SDR - Printer - Fixed Length Record (Paper printing) ;
+1 ;;2.6;IHS Third Party Billing;**21**;NOV 12, 2009;Build 379
+2 ;IHS/SD/SDR - 2.6*21 - HEAT241429 - New Report
+3 ;
PRINT ;EP for printing data
+1 SET ABM("TXT")=""
+2 DO HDB
+3 SET (ABM("CNT"),ABM("SUBCNT"))=0
+4 SET ABM("PRV")=""
+5 SET ABM("A")="TMP(""ABM-RDNY"","_$JOB
+6 SET ABM="^"_ABM("A")_")"
+7 IF '$DATA(@ABM)
QUIT
+8 FOR
SET ABM=$QUERY(@ABM)
IF ABM'[ABM("A")
QUIT
Begin DoDot:1
+9 SET ABM("T")=$PIECE(ABM,"ABM-RDNY",2)
+10 ;BDFN
SET ABM("TXT")=+$PIECE(ABM("T"),",",5)
+11 IF $Y>(IOSL-5)
DO HD
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
DO PRV
WRITE " (cont)"
+12 SET ABM("C")=$GET(^ABMDBILL(DUZ(2),ABM("TXT"),0))
IF ABM("C")=""
QUIT
+13 IF 'ABM("C")!'$PIECE(ABM("C"),U,7)!'$PIECE(ABM("C"),U,8)
QUIT
+14 IF ABM("PRV")'=$TRANSLATE($PIECE(ABM("T"),",",3,4),"""")
SET ABM("PRV")=""
DO SUB
DO PRV
+15 ;provider name
SET ABM("PRV")=$TRANSLATE($PIECE(ABM("T"),",",3,4),"""")
+16 ;bill number
WRITE !,$EXTRACT($PIECE(ABM("C"),U),1,10)
+17 ;DOS
WRITE ?12,$$SDT^ABMDUTL($PIECE($GET(^ABMDBILL(DUZ(2),ABM("TXT"),7)),U))
+18 ;
+19 SET ABMP("INS")=$PIECE(ABM("C"),U,8)
+20 SET ABMP("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")
+21 SET ABMP("VTYP")=$PIECE(ABM("C"),U,7)
+22 SET ABMP("CLN")=$PIECE(ABM("C"),U,10)
+23 SET ABMP("CLIN")=$$GET1^DIQ(40.7,$PIECE(ABM("C"),U,10),"1","E")
+24 SET ABMP("BDFN")=ABM("TXT")
+25 SET ABMP("VDT")=$PIECE($GET(^ABMDBILL(DUZ(2),ABM("TXT"),7)),U)
+26 SET ABMP("BTYP")=$PIECE(ABM("C"),U,2)
+27 SET ABMP("LDFN")=$PIECE(ABM("C"),U,3)
+28 SET ABMP("EXP")=$PIECE(ABM("C"),U,6)
+29 ;gather CPTs on claim
DO CPTS
+30 ;gather posting info
DO PSTING
+31 ;
+32 ;first CPT
WRITE ?24,$EXTRACT($PIECE($GET(ABMT(1)),U,2),1,7)
+33 ;active insurer
WRITE ?32,$EXTRACT($PIECE($GET(^AUTNINS($PIECE(ABM("C"),U,8),0)),U),1,12)
+34 ;billed
WRITE ?46,$JUSTIFY($FNUMBER(+$PIECE($GET(ABMT(1)),U,6),",",2),9)
+35 ;paid
WRITE ?57,$JUSTIFY($FNUMBER(+$GET(ABMD("P")),",",2),9)
+36 ;denial
WRITE ?67,$JUSTIFY($FNUMBER(+$GET(ABMD(1)),",",2),9)
+37 SET ABMD("DTOT")=+$GET(ABMD("DTOT"))+$GET(ABMD(1))
+38 ;SAR
WRITE ?77,$PIECE($GET(ABMD(1)),U,2)
+39 SET ABM("CNT")=ABM("CNT")+1
SET ABM("SUBCNT")=ABM("SUBCNT")+1
+40 ;
+41 IF $ORDER(ABMT(9999999),-1)>1!($ORDER(ABMD(9999),-1)>1)
Begin DoDot:2
+42 FOR ABMI=2:1
Begin DoDot:3
+43 ;quit if no further entries for either
IF '$DATA(ABMT(ABMI))&('$DATA(ABMD(ABMI)))
QUIT
+44 WRITE !
+45 ;if there's a CPT on the line
IF $PIECE($GET(ABMT(ABMI)),U,2)'=""
Begin DoDot:4
+46 ;CPT
WRITE ?24,$EXTRACT($PIECE(ABMT(ABMI),U,2),1,7)
+47 ;billed
WRITE ?46,$JUSTIFY($FNUMBER(+$PIECE($GET(ABMT(ABMI)),U,6),",",2),9)
End DoDot:4
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+48 ;denied
IF +$PIECE($GET(ABMD(ABMI)),U)'=0
WRITE ?67,$JUSTIFY($FNUMBER(+$PIECE($GET(ABMD(ABMI)),U),",",2),9)
SET ABMD("DTOT")=+$GET(ABMD("DTOT"))+$PIECE($GET(ABMD(ABMI)),U)
+49 ;SAR
IF $PIECE($GET(ABMD(ABMI)),U,2)'=""
WRITE ?77,$PIECE($GET(ABMD(ABMI)),U,2)
+50 IF $Y>(IOSL-5)
DO HD
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
DO PRV
WRITE " (cont)"
End DoDot:3
IF '$DATA(ABMT(ABMI))&('$DATA(ABMD(ABMI)))
QUIT
End DoDot:2
+51 ;
+52 WRITE !,?46,"---------",?57,"---------",?67,"---------"
+53 SET ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
SET ABMP("TOT")=0
SET ABMP("NC")=0
+54 DO ^ABMDESM1
+55 WRITE !?20,"Total for Bill: ",$EXTRACT($PIECE(ABM("C"),U),1,10),?46,$JUSTIFY($FNUMBER(+$GET(ABMS("TOT")),",",2),9),?57,$JUSTIFY($FNUMBER(+$GET(ABMD("P")),",",2),9),?67,$JUSTIFY($FNUMBER(+$GET(ABMD("DTOT")),",",2),9),!
End DoDot:1
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+56 IF $DATA(DIROUT)!($DATA(DUOUT))!($DATA(DTOUT))
QUIT
+57 DO SUB
+58 WRITE !?52,"======"
+59 WRITE !?46,"Total:",?52,$FNUMBER(ABM("CNT"),",",0)
+60 QUIT
+61 ;
HD DO PAZ^ABMDRUTL
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
HDB ;
+1 SET ABM("PG")=ABM("PG")+1
+2 DO WHD^ABMDRHD
+3 WRITE !,"Bill#",?12,"DOS",?24,"CPT",?30,"Active Insurer",?47,"Billed",?57,"Paid",?67,"Denied",?77,"SAR"
+4 SET $PIECE(ABM("LINE"),"-",80)=""
WRITE !,ABM("LINE")
KILL ABM("LINE")
+5 QUIT
+6 ;
PRV ;
+1 WRITE !!?3,"Provider: ",$TRANSLATE($PIECE(ABM("T"),",",3,4),"""")
+2 QUIT
+3 ;
SUB ;
+1 QUIT
+2 IF 'ABM("SUBCNT")
QUIT
+3 WRITE !?27,"------"
+4 WRITE !?3,"#Claims for provider:",?27,$FNUMBER(ABM("SUBCNT"),",",0)
+5 SET ABM("SUBCNT")=0
+6 QUIT
CPTS ;EP
+1 NEW ABM
+2 KILL ABMRV,ABMT,ABMD
+3 SET ABMTCNT=1
+4 DO ^ABMEHGRV
+5 SET ABMI=0
+6 FOR
SET ABMI=$ORDER(ABMRV(ABMI))
IF 'ABMI
QUIT
Begin DoDot:1
+7 SET ABMJ=0
+8 FOR
SET ABMJ=$ORDER(ABMRV(ABMI,ABMJ))
IF 'ABMJ
QUIT
Begin DoDot:2
+9 SET ABMK=0
+10 FOR
SET ABMK=$ORDER(ABMRV(ABMI,ABMJ,ABMK))
IF (ABMK="")
QUIT
Begin DoDot:3
+11 SET ABMT(ABMTCNT)=$GET(ABMRV(ABMI,ABMJ,ABMK))
+12 SET ABMTCNT=+$GET(ABMTCNT)+1
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
PSTING ;EP
+1 SET ABMB=0
+2 SET ABMTCNT=1
+3 FOR
SET ABMB=$ORDER(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB))
IF 'ABMB
QUIT
Begin DoDot:1
+4 SET ABMD("P")=+$GET(ABMD("P"))+$PIECE($GET(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,10)
+5 FOR ABMA=3,4,6,7,9,12,13
Begin DoDot:2
+6 IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,ABMA)'=0
Begin DoDot:3
+7 SET ABMD(ABMTCNT)=+$PIECE($GET(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,ABMA)
+8 IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,17)'=0
SET ABMD(ABMTCNT)=ABMD(ABMTCNT)_U_$$GET1^DIQ(90056.06,$PIECE($GET(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,17),".01","E")
+9 SET ABMTCNT=+$GET(ABMTCNT)+1
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
