ABMRDNY2 ; IHS/SD/SDR - Comma-Delimited Record ;
;;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
D OPEN^%ZISH("ABMF",ABM("RPATH"),ABM("RFN"),"W")
Q:POP
U IO
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
.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)
.S ABM("PRV")=$TR($P(ABM("T"),",",3,4),"""") ;provider name
.;
.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
.S ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_",",ABMP("TOT")=0,ABMP("NC")=0
.D ^ABMDESM1
.;
.W !,$E($P(ABM("C"),U),1,10) ;bill number
.W U_$$SDT^ABMDUTL($P($G(^ABMDBILL(DUZ(2),ABM("TXT"),7)),U)) ;DOS
.W U_$G(ABMT(1)) ;CPT/AMOUNT
.W U_$P($G(^AUTNINS($P(ABM("C"),U,8),0)),U) ;active insurer
.W U_ABM("PRV") ;provider
.W U_$FN(+$G(ABMS("TOT")),",",2) ;billed
.W U_$FN(+$G(ABMD("P")),",",2) ;paid
.W U_$G(ABMD(1)) ;denial/SAR
.S ABMD("DTOT")=+$G(ABMD("DTOT"))+$G(ABMD(1))
.S ABM("CNT")=ABM("CNT")+1,ABM("SUBCNT")=ABM("SUBCNT")+1
;
D CLOSE^%ZISH("ABMF")
Q
;
HDB ;
S ABM("PG")=ABM("PG")+1
D WHD^ABMDRHD
W !,"Bill#^DOS^CPT/Amount^Active Insurer^Provider^Billed^Paid^Denied/SAR"
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
...I $G(ABMT(ABMTCNT))="" S ABMT(ABMTCNT)=$P($G(ABMRV(ABMI,ABMJ,ABMK)),U,2)_"/"_+$P($G(ABMRV(ABMI,ABMJ,ABMK)),U,6)
...E S ABMT(ABMTCNT)=ABMT(ABMTCNT)_";"_$P($G(ABMRV(ABMI,ABMJ,ABMK)),U,2)_"/"_+$P($G(ABMRV(ABMI,ABMJ,ABMK)),U,6)
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
...I $G(ABMD(ABMTCNT))="" S ABMD(ABMTCNT)=+$P($G(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,ABMA)_"/"
...E S ABMD(ABMTCNT)=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)_$$GET1^DIQ(90056.06,$P($G(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,17),".01","E")
Q
ABMRDNY2 ; IHS/SD/SDR - Comma-Delimited Record ;
+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 DO OPEN^%ZISH("ABMF",ABM("RPATH"),ABM("RFN"),"W")
+2 IF POP
QUIT
+3 USE IO
+4 SET ABM("TXT")=""
+5 DO HDB
+6 SET (ABM("CNT"),ABM("SUBCNT"))=0
+7 SET ABM("PRV")=""
+8 SET ABM("A")="TMP(""ABM-RDNY"","_$JOB
+9 SET ABM="^"_ABM("A")_")"
+10 IF '$DATA(@ABM)
QUIT
+11 FOR
SET ABM=$QUERY(@ABM)
IF ABM'[ABM("A")
QUIT
Begin DoDot:1
+12 SET ABM("T")=$PIECE(ABM,"ABM-RDNY",2)
+13 ;BDFN
SET ABM("TXT")=+$PIECE(ABM("T"),",",5)
+14 SET ABM("C")=$GET(^ABMDBILL(DUZ(2),ABM("TXT"),0))
IF ABM("C")=""
QUIT
+15 IF 'ABM("C")!'$PIECE(ABM("C"),U,7)!'$PIECE(ABM("C"),U,8)
QUIT
+16 ;provider name
SET ABM("PRV")=$TRANSLATE($PIECE(ABM("T"),",",3,4),"""")
+17 ;
+18 SET ABMP("INS")=$PIECE(ABM("C"),U,8)
+19 SET ABMP("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")
+20 SET ABMP("VTYP")=$PIECE(ABM("C"),U,7)
+21 SET ABMP("CLN")=$PIECE(ABM("C"),U,10)
+22 SET ABMP("CLIN")=$$GET1^DIQ(40.7,$PIECE(ABM("C"),U,10),"1","E")
+23 SET ABMP("BDFN")=ABM("TXT")
+24 SET ABMP("VDT")=$PIECE($GET(^ABMDBILL(DUZ(2),ABM("TXT"),7)),U)
+25 SET ABMP("BTYP")=$PIECE(ABM("C"),U,2)
+26 SET ABMP("LDFN")=$PIECE(ABM("C"),U,3)
+27 SET ABMP("EXP")=$PIECE(ABM("C"),U,6)
+28 ;gather CPTs on claim
DO CPTS
+29 ;gather posting info
DO PSTING
+30 SET ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
SET ABMP("TOT")=0
SET ABMP("NC")=0
+31 DO ^ABMDESM1
+32 ;
+33 ;bill number
WRITE !,$EXTRACT($PIECE(ABM("C"),U),1,10)
+34 ;DOS
WRITE U_$$SDT^ABMDUTL($PIECE($GET(^ABMDBILL(DUZ(2),ABM("TXT"),7)),U))
+35 ;CPT/AMOUNT
WRITE U_$GET(ABMT(1))
+36 ;active insurer
WRITE U_$PIECE($GET(^AUTNINS($PIECE(ABM("C"),U,8),0)),U)
+37 ;provider
WRITE U_ABM("PRV")
+38 ;billed
WRITE U_$FNUMBER(+$GET(ABMS("TOT")),",",2)
+39 ;paid
WRITE U_$FNUMBER(+$GET(ABMD("P")),",",2)
+40 ;denial/SAR
WRITE U_$GET(ABMD(1))
+41 SET ABMD("DTOT")=+$GET(ABMD("DTOT"))+$GET(ABMD(1))
+42 SET ABM("CNT")=ABM("CNT")+1
SET ABM("SUBCNT")=ABM("SUBCNT")+1
End DoDot:1
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+43 ;
+44 DO CLOSE^%ZISH("ABMF")
+45 QUIT
+46 ;
HDB ;
+1 SET ABM("PG")=ABM("PG")+1
+2 DO WHD^ABMDRHD
+3 WRITE !,"Bill#^DOS^CPT/Amount^Active Insurer^Provider^Billed^Paid^Denied/SAR"
+4 QUIT
+5 ;
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 IF $GET(ABMT(ABMTCNT))=""
SET ABMT(ABMTCNT)=$PIECE($GET(ABMRV(ABMI,ABMJ,ABMK)),U,2)_"/"_+$PIECE($GET(ABMRV(ABMI,ABMJ,ABMK)),U,6)
+12 IF '$TEST
SET ABMT(ABMTCNT)=ABMT(ABMTCNT)_";"_$PIECE($GET(ABMRV(ABMI,ABMJ,ABMK)),U,2)_"/"_+$PIECE($GET(ABMRV(ABMI,ABMJ,ABMK)),U,6)
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 IF $GET(ABMD(ABMTCNT))=""
SET ABMD(ABMTCNT)=+$PIECE($GET(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,ABMA)_"/"
+8 IF '$TEST
SET ABMD(ABMTCNT)=ABMD(ABMTCNT)_";"_+$PIECE($GET(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,ABMA)_"/"
+9 IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,17)'=0
SET ABMD(ABMTCNT)=ABMD(ABMTCNT)_$$GET1^DIQ(90056.06,$PIECE($GET(^ABMDBILL(DUZ(2),ABM("TXT"),3,ABMB,0)),U,17),".01","E")
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
