- 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
