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
