APCLBRH1 ; IHS/CMI/LAB - PRINT MCR,MCD OR PI HOLDERS ;
;;2.0;IHS PCC SUITE;**21**;MAY 14, 2009;Build 34
START ;
S APCL80D="-------------------------------------------------------------------------------"
S APCLPG=0 D HEAD
S APCLPN=0 K APCLQ
F S APCLPN=$O(^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN)) Q:APCLPN=""!($D(APCLQ)) D DFN
G:$D(APCLQ) DONE
I $Y>(IOSL-6) D HEAD G:$D(APCLQ) DONE
W !!?10,"TOTAL NUMBER OF ",APCLTITL,": ",APCLTOT,!
DONE D DONE^APCLOSUT
K ^XTMP("APCLBRH",APCLJOB,APCLBT)
Q
DFN ;
S DFN="" F S DFN=$O(^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN,DFN)) Q:DFN=""!($D(APCLQ)) D @APCLPROC
Q
MCRA ;
I $Y>(IOSL-6) D HEAD Q:$D(APCLQ)
S (DOB,Y)=$P(^DPT(DFN,0),U,3) I DOB]"" D DD^%DT S DOB=Y
S APCLHRN=$P(^AUPNPAT(DFN,41,APCLSU,0),U,2)
S APCLMN=$S($D(^AUPNMCR(DFN,21)):$P(^AUPNMCR(DFN,21),U),1:"")
S APCLMDOB=$S($D(^AUPNMCR(DFN,21)):$P(^AUPNMCR(DFN,21),U,2),1:"") I APCLMDOB]"" S Y=APCLMDOB D DD^%DT S APCLMDOB=Y
;S APCLMEDN=$P(^AUPNMCR(DFN,0),U,3)_$S($P(^(0),U,4)]"":$P(^AUTTMCS($P(^(0),U,4),0),U),1:"") ;IHS/CMI/LAB PATCH 21 NMCI
S APCLMEDN=$$GETMCR^AGUTL(DFN) ;IHS/CMI/LAB PATCH 21 NMCI
W !,"(REG) ",APCLPN,?36,$J(APCLHRN,6),?49,APCLMEDN,?64,DOB
W !,"(MCR) ",APCLMN,?64,APCLMDOB
S APCLMDFN=0 F S APCLMDFN=$O(^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN,DFN,APCLMDFN)) Q:APCLMDFN'=+APCLMDFN!($D(APCLQ)) I $D(^AUPNMCR(DFN,11,APCLMDFN,0)) S APCLR=^(0) D MCRA2
W !,APCL80D
Q
MCRA2 ;
I $Y>(IOSL-5) D HEAD Q:$D(APCLQ)
W !?19,$P(APCLR,U,3) S Y=$P(APCLR,U) D:Y]"" DD^%DT W ?32,Y S Y=$P(APCLR,U,2) D:Y]"" DD^%DT W ?50,Y
Q
PI ;
I $Y>(IOSL-9) D HEAD Q:$D(APCLQ)
S (DOB,Y)=$P(^DPT(DFN,0),U,3) I DOB]"" D DD^%DT S DOB=Y
S APCLHRN=$P(^AUPNPAT(DFN,41,APCLSU,0),U,2)
W !,APCLPN,?40,APCLHRN,?56,DOB
S APCLMDFN=0 F S APCLMDFN=$O(^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN,DFN,APCLMDFN)) Q:APCLMDFN'=+APCLMDFN!($D(APCLQ)) S APCLR=^AUPNPRVT(DFN,11,APCLMDFN,0) D PI2
W !,APCL80D
Q
PI2 ;
I $Y>(IOSL-7) D HEAD Q:$D(APCLQ)
W !," INSURER: ",$P(^AUTNINS($P(APCLR,U),0),U)
W !," POLICY #: ",$S($P($G(^AUPNPRVT(DFN,11,APCLMDFN,2)),U,1)]"":$P(^AUPNPRVT(DFN,11,APCLMDFN,2),U,1),$P(APCLR,U,8):$P(^AUPN3PPH($P(APCLR,U,8),0),U,4),1:$P(APCLR,U,2)),?47,"COVERAGE TYPE: ",$P(APCLR,U,3)
W !," INSURED: ",$P(APCLR,U,4),?47,"REL: ",$S($P(APCLR,U,5)]"":$P(^AUTTRLSH($P(APCLR,U,5),0),U),1:"")
W !," ELIG BEG DATE: " S Y=$P(APCLR,U,6) D:Y]"" DD^%DT W Y,?47,"ELIG END DATE: " S Y=$P(APCLR,U,7) D:Y]"" DD^%DT W Y
Q
MCD ;
I $Y>(IOSL-8) D HEAD Q:$D(APCLQ)
S (DOB,Y)=$P(^DPT(DFN,0),U,3) I Y]"" D DD^%DT S DOB=Y
S APCLHRN=$P(^AUPNPAT(DFN,41,APCLSU,0),U,2)
W !,"(REG) ",APCLPN,?46,APCLHRN,?61,DOB
S APCLMDFN=0 F S APCLMDFN=$O(^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN,DFN,APCLMDFN)) Q:APCLMDFN'=+APCLMDFN!($D(APCLQ)) S APCLR=^AUPNMCD(APCLMDFN,0) D MCD2
W !,APCL80D
Q
MCD2 ;
I $Y>(IOSL-5) D HEAD Q:$D(APCLQ)
S APCLMN=$S($D(^AUPNMCD(APCLMDFN,21)):$P(^AUPNMCD(APCLMDFN,21),U),1:"")
S APCLMDOB=$S($D(^AUPNMCD(APCLMDFN,21)):$P(^AUPNMCD(APCLMDFN,21),U,2),1:"")
W !,"(MCD) ",APCLMN,?61,APCLMDOB
W !," MEDICAID #: ",$P(APCLR,U,3),?50,"STATE: ",$S($P(APCLR,U,4)]"":$P(^DIC(5,$P(APCLR,U,4),0),U),1:"")
W !," NAME/INSURED: ",$P(APCLR,U,5),?50,"SEX OF INSURED: ",$P(APCLR,U,7)
S APCLNDFN=0 F S APCLNDFN=$O(^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN,DFN,APCLMDFN,APCLNDFN)) Q:APCLNDFN'=+APCLNDFN!($D(APCLQ)) S APCLNREC=^AUPNMCD(APCLMDFN,11,APCLNDFN,0) D MCD3
Q
MCD3 ;
W !," ELIG BEG DATE: " S Y=$P(APCLNREC,U) D:Y]"" DD^%DT W ?20,Y,?35,"COVERAGE: ",$P(APCLNREC,U,3),?50,"ELIG END DATE: " S Y=$P(APCLNREC,U,2) D:Y]"" DD^%DT W Y
Q
HEAD I 'APCLPG G HEAD1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQ="" Q
HEAD1 ;
W:$D(IOF) @IOF S APCLPG=APCLPG+1
W ?(80-$L($P(^DIC(4,APCLSU,0),U))/2),$P(^DIC(4,APCLSU,0),U),?72,"Page ",APCLPG,!
S APCLLENG=22+$L(APCLTITL)
W ?((80-APCLLENG)/2),"REGISTERED PATIENTS - ",APCLTITL,!
W ?23,"Actively enrolled as of ",APCLACEY,!
W !
D @(APCLPROC_"H")
W APCL80D
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
APCLBRH1 ; IHS/CMI/LAB - PRINT MCR,MCD OR PI HOLDERS ;
+1 ;;2.0;IHS PCC SUITE;**21**;MAY 14, 2009;Build 34
START ;
+1 SET APCL80D="-------------------------------------------------------------------------------"
+2 SET APCLPG=0
DO HEAD
+3 SET APCLPN=0
KILL APCLQ
+4 FOR
SET APCLPN=$ORDER(^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN))
IF APCLPN=""!($DATA(APCLQ))
QUIT
DO DFN
+5 IF $DATA(APCLQ)
GOTO DONE
+6 IF $Y>(IOSL-6)
DO HEAD
IF $DATA(APCLQ)
GOTO DONE
+7 WRITE !!?10,"TOTAL NUMBER OF ",APCLTITL,": ",APCLTOT,!
DONE DO DONE^APCLOSUT
+1 KILL ^XTMP("APCLBRH",APCLJOB,APCLBT)
+2 QUIT
DFN ;
+1 SET DFN=""
FOR
SET DFN=$ORDER(^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN,DFN))
IF DFN=""!($DATA(APCLQ))
QUIT
DO @APCLPROC
+2 QUIT
MCRA ;
+1 IF $Y>(IOSL-6)
DO HEAD
IF $DATA(APCLQ)
QUIT
+2 SET (DOB,Y)=$PIECE(^DPT(DFN,0),U,3)
IF DOB]""
DO DD^%DT
SET DOB=Y
+3 SET APCLHRN=$PIECE(^AUPNPAT(DFN,41,APCLSU,0),U,2)
+4 SET APCLMN=$SELECT($DATA(^AUPNMCR(DFN,21)):$PIECE(^AUPNMCR(DFN,21),U),1:"")
+5 SET APCLMDOB=$SELECT($DATA(^AUPNMCR(DFN,21)):$PIECE(^AUPNMCR(DFN,21),U,2),1:"")
IF APCLMDOB]""
SET Y=APCLMDOB
DO DD^%DT
SET APCLMDOB=Y
+6 ;S APCLMEDN=$P(^AUPNMCR(DFN,0),U,3)_$S($P(^(0),U,4)]"":$P(^AUTTMCS($P(^(0),U,4),0),U),1:"") ;IHS/CMI/LAB PATCH 21 NMCI
+7 ;IHS/CMI/LAB PATCH 21 NMCI
SET APCLMEDN=$$GETMCR^AGUTL(DFN)
+8 WRITE !,"(REG) ",APCLPN,?36,$JUSTIFY(APCLHRN,6),?49,APCLMEDN,?64,DOB
+9 WRITE !,"(MCR) ",APCLMN,?64,APCLMDOB
+10 SET APCLMDFN=0
FOR
SET APCLMDFN=$ORDER(^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN,DFN,APCLMDFN))
IF APCLMDFN'=+APCLMDFN!($DATA(APCLQ))
QUIT
IF $DATA(^AUPNMCR(DFN,11,APCLMDFN,0))
SET APCLR=^(0)
DO MCRA2
+11 WRITE !,APCL80D
+12 QUIT
MCRA2 ;
+1 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQ)
QUIT
+2 WRITE !?19,$PIECE(APCLR,U,3)
SET Y=$PIECE(APCLR,U)
IF Y]""
DO DD^%DT
WRITE ?32,Y
SET Y=$PIECE(APCLR,U,2)
IF Y]""
DO DD^%DT
WRITE ?50,Y
+3 QUIT
PI ;
+1 IF $Y>(IOSL-9)
DO HEAD
IF $DATA(APCLQ)
QUIT
+2 SET (DOB,Y)=$PIECE(^DPT(DFN,0),U,3)
IF DOB]""
DO DD^%DT
SET DOB=Y
+3 SET APCLHRN=$PIECE(^AUPNPAT(DFN,41,APCLSU,0),U,2)
+4 WRITE !,APCLPN,?40,APCLHRN,?56,DOB
+5 SET APCLMDFN=0
FOR
SET APCLMDFN=$ORDER(^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN,DFN,APCLMDFN))
IF APCLMDFN'=+APCLMDFN!($DATA(APCLQ))
QUIT
SET APCLR=^AUPNPRVT(DFN,11,APCLMDFN,0)
DO PI2
+6 WRITE !,APCL80D
+7 QUIT
PI2 ;
+1 IF $Y>(IOSL-7)
DO HEAD
IF $DATA(APCLQ)
QUIT
+2 WRITE !," INSURER: ",$PIECE(^AUTNINS($PIECE(APCLR,U),0),U)
+3 WRITE !," POLICY #: ",$SELECT($PIECE($GET(^AUPNPRVT(DFN,11,APCLMDFN,2)),U,1)]"":$PIECE(^AUPNPRVT(DFN,11,APCLMDFN,2),U,1),$PIECE(APCLR,U,8):$PIECE(^AUPN3PPH($PIECE(APCLR,U,8),0),U,4),1:$PIECE(APCLR,U,2)),?47,"COVERAGE TYPE: ",$PIECE(APCLR,U,3)
+4 WRITE !," INSURED: ",$PIECE(APCLR,U,4),?47,"REL: ",$SELECT($PIECE(APCLR,U,5)]"":$PIECE(^AUTTRLSH($PIECE(APCLR,U,5),0),U),1:"")
+5 WRITE !," ELIG BEG DATE: "
SET Y=$PIECE(APCLR,U,6)
IF Y]""
DO DD^%DT
WRITE Y,?47,"ELIG END DATE: "
SET Y=$PIECE(APCLR,U,7)
IF Y]""
DO DD^%DT
WRITE Y
+6 QUIT
MCD ;
+1 IF $Y>(IOSL-8)
DO HEAD
IF $DATA(APCLQ)
QUIT
+2 SET (DOB,Y)=$PIECE(^DPT(DFN,0),U,3)
IF Y]""
DO DD^%DT
SET DOB=Y
+3 SET APCLHRN=$PIECE(^AUPNPAT(DFN,41,APCLSU,0),U,2)
+4 WRITE !,"(REG) ",APCLPN,?46,APCLHRN,?61,DOB
+5 SET APCLMDFN=0
FOR
SET APCLMDFN=$ORDER(^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN,DFN,APCLMDFN))
IF APCLMDFN'=+APCLMDFN!($DATA(APCLQ))
QUIT
SET APCLR=^AUPNMCD(APCLMDFN,0)
DO MCD2
+6 WRITE !,APCL80D
+7 QUIT
MCD2 ;
+1 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQ)
QUIT
+2 SET APCLMN=$SELECT($DATA(^AUPNMCD(APCLMDFN,21)):$PIECE(^AUPNMCD(APCLMDFN,21),U),1:"")
+3 SET APCLMDOB=$SELECT($DATA(^AUPNMCD(APCLMDFN,21)):$PIECE(^AUPNMCD(APCLMDFN,21),U,2),1:"")
+4 WRITE !,"(MCD) ",APCLMN,?61,APCLMDOB
+5 WRITE !," MEDICAID #: ",$PIECE(APCLR,U,3),?50,"STATE: ",$SELECT($PIECE(APCLR,U,4)]"":$PIECE(^DIC(5,$PIECE(APCLR,U,4),0),U),1:"")
+6 WRITE !," NAME/INSURED: ",$PIECE(APCLR,U,5),?50,"SEX OF INSURED: ",$PIECE(APCLR,U,7)
+7 SET APCLNDFN=0
FOR
SET APCLNDFN=$ORDER(^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN,DFN,APCLMDFN,APCLNDFN))
IF APCLNDFN'=+APCLNDFN!($DATA(APCLQ))
QUIT
SET APCLNREC=^AUPNMCD(APCLMDFN,11,APCLNDFN,0)
DO MCD3
+8 QUIT
MCD3 ;
+1 WRITE !," ELIG BEG DATE: "
SET Y=$PIECE(APCLNREC,U)
IF Y]""
DO DD^%DT
WRITE ?20,Y,?35,"COVERAGE: ",$PIECE(APCLNREC,U,3),?50,"ELIG END DATE: "
SET Y=$PIECE(APCLNREC,U,2)
IF Y]""
DO DD^%DT
WRITE Y
+2 QUIT
HEAD IF 'APCLPG
GOTO HEAD1
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCLQ=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET APCLPG=APCLPG+1
+2 WRITE ?(80-$LENGTH($PIECE(^DIC(4,APCLSU,0),U))/2),$PIECE(^DIC(4,APCLSU,0),U),?72,"Page ",APCLPG,!
+3 SET APCLLENG=22+$LENGTH(APCLTITL)
+4 WRITE ?((80-APCLLENG)/2),"REGISTERED PATIENTS - ",APCLTITL,!
+5 WRITE ?23,"Actively enrolled as of ",APCLACEY,!
+6 WRITE !
+7 DO @(APCLPROC_"H")
+8 WRITE APCL80D
+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
