ABMDREL1.m

ABMDREL1 ; IHS/SD/SDR - PRINT MCR,MCD OR PI HOLDERS ; 

 ;;2.6;IHS Third Party Billing;**1,26**;NOV 12, 2009;Build 440

 ;Original;TMD;

 ;IHS/SD/SDR 2.6*1 HEAT5278 - Fix for policy number not displaying

 ;IHS/SD/SDR 2.6*26 CR9266 Changed to use MBI if available, default to HICN

 ;

START K ABMD("80D") S $P(ABMD("80D"),"-",80)=""

 S ABMD("ET")=$H

 S ABMD("PG")=0 D HEAD

 S ABMD("PN")=0 K ABMD("Q")

 F  S ABMD("PN")=$O(^TMP("ABMDBRH",ABMD("$J"),ABMD("PN"))) Q:ABMD("PN")=""!($D(ABMD("Q")))  D DFN

 G:$D(ABMD("Q")) DONE

 I $Y>(IOSL-6) D HEAD G:$D(ABMD("Q")) DONE

 W !!,?10,"TOTAL NUMBER OF ",ABMD("TITL"),":  ",ABMD("TOT"),!

DONE D DONE^ABMDREL0

 Q

DFN ;

 S ABMD("DFN")="" F  S ABMD("DFN")=$O(^TMP("ABMDBRH",ABMD("$J"),ABMD("PN"),ABMD("DFN"))) Q:ABMD("DFN")=""!($D(ABMD("Q")))  D @ABMD("PROC")

 Q

MCRA ;

 I $Y>(IOSL-6) D HEAD Q:$D(ABMD("Q"))

 S (ABMD("OB"),Y)=$P(^DPT(ABMD("DFN"),0),U,3) I ABMD("OB")]"" D DD^%DT S ABMD("OB")=Y

 S ABMD("HRN")=$P(^AUPNPAT(ABMD("DFN"),41,ABMD("SU"),0),U,2)

 S ABMD("MN")=$S($D(^AUPNMCR(ABMD("DFN"),21)):$P(^AUPNMCR(ABMD("DFN"),21),U,1),1:"")

 S ABMD("MDOB")=$S($D(^AUPNMCR(ABMD("DFN"),21)):$P(^AUPNMCR(ABMD("DFN"),21),U,2),1:"") I ABMD("MDOB")]"" S Y=ABMD("MDOB") D DD^%DT S ABMD("MDOB")=Y

 ;S ABMD("MEDN")=$P(^AUPNMCR(ABMD("DFN"),0),U,3)_$P(^(0),U,4)  ;abm*2.6*26 IHS/SD/SDR CR9266

 ;start new abm*2.6*26 IHS/SD/SDR CR9266

 K ABMMBI

 S ABMMBI=""

 S ABMD("MEDN")=""

 S ABMMBI=$$HISTMBI^AUPNMBI(ABMD("DFN"),.ABMMBI)

 S ABMMBI=+$O(ABMMBI(999999999),-1)

 S:(ABMMBI'=0) ABMD("MEDN")=$P(ABMMBI(ABMMBI),U)

 I $G(ABMD("MEDN"))="" S ABMD("MEDN")=$P(^AUPNMCR(ABMD("DFN"),0),U,3)_$S(+$P(^(0),U,4)'=0:$P($G(^AUTTMCS($P(^(0),U,4),0)),U),1:"")

 ;end new abm*2.6*26 IHS/SD/SDR CR9266

 W !,"(REG) ",ABMD("PN"),?36,$J(ABMD("HRN"),6),?49,ABMD("MEDN"),?64,ABMD("OB"),!,"(MCR) ",ABMD("MN"),?64,ABMD("MDOB")

 S ABMD("MDFN")=0 F  S ABMD("MDFN")=$O(^TMP("ABMDBRH",ABMD("$J"),ABMD("PN"),ABMD("DFN"),ABMD("MDFN"))) Q:'ABMD("MDFN")!($D(ABMD("Q")))  I $D(^AUPNMCR(ABMD("DFN"),11,ABMD("MDFN"),0)) S ABMD("R")=^(0) D MCRA2

 W !,ABMD("80D")

 Q

MCRA2 ;

 I $Y>(IOSL-5) D HEAD Q:$D(ABMD("Q"))

 W !,?19,$P(ABMD("R"),U,3) S Y=$P(ABMD("R"),U,1) D:Y]"" DD^%DT W ?32,Y S Y=$P(ABMD("R"),U,2) D:Y]"" DD^%DT W ?50,Y

 Q

PI ;

 I $Y>(IOSL-9) D HEAD Q:$D(ABMD("Q"))

 S (ABMD("OB"),Y)=$P(^DPT(ABMD("DFN"),0),U,3) I ABMD("OB")]"" D DD^%DT S ABMD("OB")=Y

 S ABMD("HRN")=$P(^AUPNPAT(ABMD("DFN"),41,ABMD("SU"),0),U,2)

 W !,ABMD("PN"),?40,ABMD("HRN"),?56,ABMD("OB")

 S ABMD("MDFN")=0 F  S ABMD("MDFN")=$O(^TMP("ABMDBRH",ABMD("$J"),ABMD("PN"),ABMD("DFN"),ABMD("MDFN"))) Q:'ABMD("MDFN")!($D(ABMD("Q")))  S ABMD("R")=^AUPNPRVT(ABMD("DFN"),11,ABMD("MDFN"),0) D PI2

 W !,ABMD("80D")

 Q

PI2 ;

 Q:$P($G(^AUPNPRVT(ABMD("DFN"),11,ABMD("MDFN"),0)),U)=""

 S ABMD("COVT")=$P($G(^AUTTPIC(+$P(ABMD("R"),U,3),0)),U)

 I $Y>(IOSL-7) D HEAD Q:$D(ABMD("Q"))

 W !,"   INSURER:  ",$P(^AUTNINS($P(ABMD("R"),U,1),0),U,1)

 ;W !,"   POLICY #: ",$P(ABMD("R"),U,2),?47,"COVERAGE TYPE: ",$E(ABMD("COVT"),1,16)  ;abm*2.6*1 HEAT5278

 W !,"   POLICY #: ",$S($P(ABMD("R"),U,8):$P($G(^AUPN3PPH($P(ABMD("R"),U,8),0)),U,4),1:""),?47,"COVERAGE TYPE: ",$E(ABMD("COVT"),1,16)  ;abm*2.6*1 HEAT5278

 W !,"   INSURED:  ",$P(ABMD("R"),U,4),?47,"REL:  ",$S($P(ABMD("R"),U,5)]"":$P(^AUTTRLSH($P(ABMD("R"),U,5),0),U),1:"")

 W !,"   ELIG BEG DATE:  " S Y=$P(ABMD("R"),U,6) D:Y]"" DD^%DT W Y,?47,"ELIG END DATE:  " S Y=$P(ABMD("R"),U,7) D:Y]"" DD^%DT W Y

 Q

MCD ;

 I $Y>(IOSL-8) D HEAD Q:$D(ABMD("Q"))

 S (ABMD("OB"),Y)=$P(^DPT(ABMD("DFN"),0),U,3) I Y]"" D DD^%DT S ABMD("OB")=Y

 S ABMD("HRN")=$P(^AUPNPAT(ABMD("DFN"),41,ABMD("SU"),0),U,2)

 W !,"(REG) ",ABMD("PN"),?46,ABMD("HRN"),?61,ABMD("OB")

 S ABMD("MDFN")=0 F  S ABMD("MDFN")=$O(^TMP("ABMDBRH",ABMD("$J"),ABMD("PN"),ABMD("DFN"),ABMD("MDFN"))) Q:'ABMD("MDFN")!($D(ABMD("Q")))  S ABMD("R")=^AUPNMCD(ABMD("MDFN"),0) D MCD2

 W !,ABMD("80D")

 Q

MCD2 ;

 I $Y>(IOSL-5) D HEAD Q:$D(ABMD("Q"))

 S ABMD("MN")=$S($D(^AUPNMCD(ABMD("MDFN"),21)):$P(^AUPNMCD(ABMD("MDFN"),21),U,1),1:"")

 S ABMD("MDOB")=$S($D(^AUPNMCD(ABMD("MDFN"),21)):$P(^AUPNMCD(ABMD("MDFN"),21),U,2),1:"")

 W !,"(MCD) ",ABMD("MN"),?61,ABMD("MDOB")

 W !,"   MEDICAID #: ",$P(ABMD("R"),U,3),?50,"STATE: ",$S($P(ABMD("R"),U,4)]"":$P(^DIC(5,$P(ABMD("R"),U,4),0),U),1:"")

 W !,"   NAME/INSURED: ",$P(ABMD("R"),U,5),?50,"SEX OF INSURED: ",$P(ABMD("R"),U,7)

 S ABMD("NDFN")=0 F  S ABMD("NDFN")=$O(^TMP("ABMDBRH",ABMD("$J"),ABMD("PN"),ABMD("DFN"),ABMD("MDFN"),ABMD("NDFN"))) Q:'ABMD("NDFN")!($D(ABMD("Q")))  S ABMD("NREC")=^AUPNMCD(ABMD("MDFN"),11,ABMD("NDFN"),0) D MCD3

 Q

MCD3 ;

 W !,"   ELIG BEG DATE: " S Y=$P(ABMD("NREC"),U,1) D:Y]"" DD^%DT W ?20,Y,?35,"COVERAGE: ",$P(ABMD("NREC"),U,3),?50,"ELIG END DATE: " S Y=$P(ABMD("NREC"),U,2) D:Y]"" DD^%DT W Y

 Q

HEAD I 'ABMD("PG") G HEAD1

 I $E(IOST)="C",'$D(IO("S")) W ! S DIR(0)="EO" D ^DIR K DIR I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) S ABMD("Q")="" Q

HEAD1 ;

 W $$EN^ABMVDF("IOF") S ABMD("PG")=ABMD("PG")+1

 W ?(80-$L($P(^DIC(4,ABMD("SU"),0),U))/2),$P(^DIC(4,ABMD("SU"),0),U),?72,"Page ",ABMD("PG"),!

 S ABMD("LENG")=22+$L(ABMD("TITL"))

 W ?((80-ABMD("LENG"))/2),"REGISTERED PATIENTS -  ",ABMD("TITL"),!

 W ?23,"Actively enrolled as of ",ABMD("ACEY"),!

 W !

 D @(ABMD("PROC")_"H")

 W ABMD("80D")

 Q

MCRAH ;

 W !,"         NAME",?36,"CHART #",?49,"MEDICARE #",!,"(TYPE)",?14,"COVERAGE",?32,"ELIG BEG DATE",?49,"ELIG END DATE",?64,"DATE OF BIRTH",!

 Q

PIH W !,"PATIENT NAME",?40,"CHART #",?55,"DATE OF BIRTH",!

 Q

MCDH ;

 W !,"PATIENT NAME",?40,"CHART #",?55,"DATE OF BIRTH",!

 Q

ABMDREL1  ; IHS/SD/SDR - PRINT MCR,MCD OR PI HOLDERS ; 

 +1       ;;2.6;IHS Third Party Billing;**1,26**;NOV 12, 2009;Build 440

 +2       ;Original;TMD;

 +3       ;IHS/SD/SDR 2.6*1 HEAT5278 - Fix for policy number not displaying

 +4       ;IHS/SD/SDR 2.6*26 CR9266 Changed to use MBI if available, default to HICN

 +5       ;

START      KILL ABMD("80D")

           SET $PIECE(ABMD("80D"),"-",80)=""

 +1        SET ABMD("ET")=$HOROLOG

 +2        SET ABMD("PG")=0

           DO HEAD

 +3        SET ABMD("PN")=0

           KILL ABMD("Q")

 +4        FOR 

               SET ABMD("PN")=$ORDER(^TMP("ABMDBRH",ABMD("$J"),ABMD("PN")))

               IF ABMD("PN")=""!($DATA(ABMD("Q")))

                   QUIT 

               DO DFN

 +5        IF $DATA(ABMD("Q"))

               GOTO DONE

 +6        IF $Y>(IOSL-6)

               DO HEAD

               IF $DATA(ABMD("Q"))

                   GOTO DONE

 +7        WRITE !!,?10,"TOTAL NUMBER OF ",ABMD("TITL"),":  ",ABMD("TOT"),!

DONE       DO DONE^ABMDREL0

 +1        QUIT 

DFN       ;

 +1        SET ABMD("DFN")=""

           FOR 

               SET ABMD("DFN")=$ORDER(^TMP("ABMDBRH",ABMD("$J"),ABMD("PN"),ABMD("DFN")))

               IF ABMD("DFN")=""!($DATA(ABMD("Q")))

                   QUIT 

               DO @ABMD("PROC")

 +2        QUIT 

MCRA      ;

 +1        IF $Y>(IOSL-6)

               DO HEAD

               IF $DATA(ABMD("Q"))

                   QUIT 

 +2        SET (ABMD("OB"),Y)=$PIECE(^DPT(ABMD("DFN"),0),U,3)

           IF ABMD("OB")]""

               DO DD^%DT

               SET ABMD("OB")=Y

 +3        SET ABMD("HRN")=$PIECE(^AUPNPAT(ABMD("DFN"),41,ABMD("SU"),0),U,2)

 +4        SET ABMD("MN")=$SELECT($DATA(^AUPNMCR(ABMD("DFN"),21)):$PIECE(^AUPNMCR(ABMD("DFN"),21),U,1),1:"")

 +5        SET ABMD("MDOB")=$SELECT($DATA(^AUPNMCR(ABMD("DFN"),21)):$PIECE(^AUPNMCR(ABMD("DFN"),21),U,2),1:"")

           IF ABMD("MDOB")]""

               SET Y=ABMD("MDOB")

               DO DD^%DT

               SET ABMD("MDOB")=Y

 +6       ;S ABMD("MEDN")=$P(^AUPNMCR(ABMD("DFN"),0),U,3)_$P(^(0),U,4)  ;abm*2.6*26 IHS/SD/SDR CR9266

 +7       ;start new abm*2.6*26 IHS/SD/SDR CR9266

 +8        KILL ABMMBI

 +9        SET ABMMBI=""

 +10       SET ABMD("MEDN")=""

 +11       SET ABMMBI=$$HISTMBI^AUPNMBI(ABMD("DFN"),.ABMMBI)

 +12       SET ABMMBI=+$ORDER(ABMMBI(999999999),-1)

 +13       IF (ABMMBI'=0)

               SET ABMD("MEDN")=$PIECE(ABMMBI(ABMMBI),U)

 +14       IF $GET(ABMD("MEDN"))=""

               SET ABMD("MEDN")=$PIECE(^AUPNMCR(ABMD("DFN"),0),U,3)_$SELECT(+$PIECE(^(0),U,4)'=0:$PIECE($GET(^AUTTMCS($PIECE(^(0),U,4),0)),U),1:"")

 +15      ;end new abm*2.6*26 IHS/SD/SDR CR9266

 +16       WRITE !,"(REG) ",ABMD("PN"),?36,$JUSTIFY(ABMD("HRN"),6),?49,ABMD("MEDN"),?64,ABMD("OB"),!,"(MCR) ",ABMD("MN"),?64,ABMD("MDOB")

 +17       SET ABMD("MDFN")=0

           FOR 

               SET ABMD("MDFN")=$ORDER(^TMP("ABMDBRH",ABMD("$J"),ABMD("PN"),ABMD("DFN"),ABMD("MDFN")))

               IF 'ABMD("MDFN")!($DATA(ABMD("Q")))

                   QUIT 

               IF $DATA(^AUPNMCR(ABMD("DFN"),11,ABMD("MDFN"),0))

                   SET ABMD("R")=^(0)

                   DO MCRA2

 +18       WRITE !,ABMD("80D")

 +19       QUIT 

MCRA2     ;

 +1        IF $Y>(IOSL-5)

               DO HEAD

               IF $DATA(ABMD("Q"))

                   QUIT 

 +2        WRITE !,?19,$PIECE(ABMD("R"),U,3)

           SET Y=$PIECE(ABMD("R"),U,1)

           IF Y]""

               DO DD^%DT

           WRITE ?32,Y

           SET Y=$PIECE(ABMD("R"),U,2)

           IF Y]""

               DO DD^%DT

           WRITE ?50,Y

 +3        QUIT 

PI        ;

 +1        IF $Y>(IOSL-9)

               DO HEAD

               IF $DATA(ABMD("Q"))

                   QUIT 

 +2        SET (ABMD("OB"),Y)=$PIECE(^DPT(ABMD("DFN"),0),U,3)

           IF ABMD("OB")]""

               DO DD^%DT

               SET ABMD("OB")=Y

 +3        SET ABMD("HRN")=$PIECE(^AUPNPAT(ABMD("DFN"),41,ABMD("SU"),0),U,2)

 +4        WRITE !,ABMD("PN"),?40,ABMD("HRN"),?56,ABMD("OB")

 +5        SET ABMD("MDFN")=0

           FOR 

               SET ABMD("MDFN")=$ORDER(^TMP("ABMDBRH",ABMD("$J"),ABMD("PN"),ABMD("DFN"),ABMD("MDFN")))

               IF 'ABMD("MDFN")!($DATA(ABMD("Q")))

                   QUIT 

               SET ABMD("R")=^AUPNPRVT(ABMD("DFN"),11,ABMD("MDFN"),0)

               DO PI2

 +6        WRITE !,ABMD("80D")

 +7        QUIT 

PI2       ;

 +1        IF $PIECE($GET(^AUPNPRVT(ABMD("DFN"),11,ABMD("MDFN"),0)),U)=""

               QUIT 

 +2        SET ABMD("COVT")=$PIECE($GET(^AUTTPIC(+$PIECE(ABMD("R"),U,3),0)),U)

 +3        IF $Y>(IOSL-7)

               DO HEAD

               IF $DATA(ABMD("Q"))

                   QUIT 

 +4        WRITE !,"   INSURER:  ",$PIECE(^AUTNINS($PIECE(ABMD("R"),U,1),0),U,1)

 +5       ;W !,"   POLICY #: ",$P(ABMD("R"),U,2),?47,"COVERAGE TYPE: ",$E(ABMD("COVT"),1,16)  ;abm*2.6*1 HEAT5278

 +6       ;abm*2.6*1 HEAT5278

           WRITE !,"   POLICY #: ",$SELECT($PIECE(ABMD("R"),U,8):$PIECE($GET(^AUPN3PPH($PIECE(ABMD("R"),U,8),0)),U,4),1:""),?47,"COVERAGE TYPE: ",$EXTRACT(ABMD("COVT"),1,16)

 +7        WRITE !,"   INSURED:  ",$PIECE(ABMD("R"),U,4),?47,"REL:  ",$SELECT($PIECE(ABMD("R"),U,5)]"":$PIECE(^AUTTRLSH($PIECE(ABMD("R"),U,5),0),U),1:"")

 +8        WRITE !,"   ELIG BEG DATE:  "

           SET Y=$PIECE(ABMD("R"),U,6)

           IF Y]""

               DO DD^%DT

           WRITE Y,?47,"ELIG END DATE:  "

           SET Y=$PIECE(ABMD("R"),U,7)

           IF Y]""

               DO DD^%DT

           WRITE Y

 +9        QUIT 

MCD       ;

 +1        IF $Y>(IOSL-8)

               DO HEAD

               IF $DATA(ABMD("Q"))

                   QUIT 

 +2        SET (ABMD("OB"),Y)=$PIECE(^DPT(ABMD("DFN"),0),U,3)

           IF Y]""

               DO DD^%DT

               SET ABMD("OB")=Y

 +3        SET ABMD("HRN")=$PIECE(^AUPNPAT(ABMD("DFN"),41,ABMD("SU"),0),U,2)

 +4        WRITE !,"(REG) ",ABMD("PN"),?46,ABMD("HRN"),?61,ABMD("OB")

 +5        SET ABMD("MDFN")=0

           FOR 

               SET ABMD("MDFN")=$ORDER(^TMP("ABMDBRH",ABMD("$J"),ABMD("PN"),ABMD("DFN"),ABMD("MDFN")))

               IF 'ABMD("MDFN")!($DATA(ABMD("Q")))

                   QUIT 

               SET ABMD("R")=^AUPNMCD(ABMD("MDFN"),0)

               DO MCD2

 +6        WRITE !,ABMD("80D")

 +7        QUIT 

MCD2      ;

 +1        IF $Y>(IOSL-5)

               DO HEAD

               IF $DATA(ABMD("Q"))

                   QUIT 

 +2        SET ABMD("MN")=$SELECT($DATA(^AUPNMCD(ABMD("MDFN"),21)):$PIECE(^AUPNMCD(ABMD("MDFN"),21),U,1),1:"")

 +3        SET ABMD("MDOB")=$SELECT($DATA(^AUPNMCD(ABMD("MDFN"),21)):$PIECE(^AUPNMCD(ABMD("MDFN"),21),U,2),1:"")

 +4        WRITE !,"(MCD) ",ABMD("MN"),?61,ABMD("MDOB")

 +5        WRITE !,"   MEDICAID #: ",$PIECE(ABMD("R"),U,3),?50,"STATE: ",$SELECT($PIECE(ABMD("R"),U,4)]"":$PIECE(^DIC(5,$PIECE(ABMD("R"),U,4),0),U),1:"")

 +6        WRITE !,"   NAME/INSURED: ",$PIECE(ABMD("R"),U,5),?50,"SEX OF INSURED: ",$PIECE(ABMD("R"),U,7)

 +7        SET ABMD("NDFN")=0

           FOR 

               SET ABMD("NDFN")=$ORDER(^TMP("ABMDBRH",ABMD("$J"),ABMD("PN"),ABMD("DFN"),ABMD("MDFN"),ABMD("NDFN")))

               IF 'ABMD("NDFN")!($DATA(ABMD("Q")))

                   QUIT 

               SET ABMD("NREC")=^AUPNMCD(ABMD("MDFN"),11,ABMD("NDFN"),0)

               DO MCD3

 +8        QUIT 

MCD3      ;

 +1        WRITE !,"   ELIG BEG DATE: "

           SET Y=$PIECE(ABMD("NREC"),U,1)

           IF Y]""

               DO DD^%DT

           WRITE ?20,Y,?35,"COVERAGE: ",$PIECE(ABMD("NREC"),U,3),?50,"ELIG END DATE: "

           SET Y=$PIECE(ABMD("NREC"),U,2)

           IF Y]""

               DO DD^%DT

           WRITE Y

 +2        QUIT 

HEAD       IF 'ABMD("PG")

               GOTO HEAD1

 +1        IF $EXTRACT(IOST)="C"

               IF '$DATA(IO("S"))

                   WRITE !

                   SET DIR(0)="EO"

                   DO ^DIR

                   KILL DIR

                   IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))

                       SET ABMD("Q")=""

                       QUIT 

HEAD1     ;

 +1        WRITE $$EN^ABMVDF("IOF")

           SET ABMD("PG")=ABMD("PG")+1

 +2        WRITE ?(80-$LENGTH($PIECE(^DIC(4,ABMD("SU"),0),U))/2),$PIECE(^DIC(4,ABMD("SU"),0),U),?72,"Page ",ABMD("PG"),!

 +3        SET ABMD("LENG")=22+$LENGTH(ABMD("TITL"))

 +4        WRITE ?((80-ABMD("LENG"))/2),"REGISTERED PATIENTS -  ",ABMD("TITL"),!

 +5        WRITE ?23,"Actively enrolled as of ",ABMD("ACEY"),!

 +6        WRITE !

 +7        DO @(ABMD("PROC")_"H")

 +8        WRITE ABMD("80D")

 +9        QUIT 

MCRAH     ;

 +1        WRITE !,"         NAME",?36,"CHART #",?49,"MEDICARE #",!,"(TYPE)",?14,"COVERAGE",?32,"ELIG BEG DATE",?49,"ELIG END DATE",?64,"DATE OF BIRTH",!

 +2        QUIT 

PIH        WRITE !,"PATIENT NAME",?40,"CHART #",?55,"DATE OF BIRTH",!

 +1        QUIT 

MCDH      ;

 +1        WRITE !,"PATIENT NAME",?40,"CHART #",?55,"DATE OF BIRTH",!

 +2        QUIT