ABMRDNY1.m

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