APCLBV11 ; IHS/CMI/LAB - continuation of APCLV1 ;
;;2.0;IHS PCC SUITE;**21**;MAY 14, 2009;Build 34
1 ;EP
I $Y>(IOSL-9) D HEAD^APCLBV1 Q:$D(APCLQUIT)
S APCLCHMP=$O(^AUTNINS("B","CHAMPUS",0))
I 'APCLCHMP S APCLCHMP=$O(^AUTNINS("B","TRICARE",0))
D HD^APCLBV1
Q:'$D(^AUPNPAT(DFN,11))
S X=$P(^AUPNPAT(DFN,11),U,11)
W !?8,APCLCOPN(X)
I ($P(^AUTTBEN(X,0),U,2)="04"!($P(^AUTTBEN(X,0),U,2)="31")),APCLCHMP]"" D PRVT1
D VISIT^APCLBV1
Q
PRVT1 ;
Q:APCLCHMP=""
S Y=$O(^AUPNPRVT("AB",APCLCHMP,DFN,0)) Q:Y=""
S APCLX=^AUPNPRVT(DFN,11,Y,0) W ?40,"Sponsor: ",$P(APCLX,U,4),?65,"SSN: " S X=$P(APCLX,U,2) W $E(X,1,3),"-",$E(X,4,5),"-",$E(X,6,9)
Q
2 ;EP
I $Y>(IOSL-9) D HEAD^APCLBV1 Q:$D(APCLQUIT)
D HD^APCLBV1
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
S APCLMEDN=$$GETMCR^AGUTL(DFN)_$S($P(^AUPNMCR(DFN,0),U,4)]"":$P(^AUTTMCS($P(^(0),U,4),0),U),1:"") ;IHS/CMI/LAB
S APCLVAL=$S(APCLRNUM=2:"A",1:"B")
W !?8,"Medicare Name: ",APCLMN,?56,"DOB: ",DOB
S APCLMDFN=0 F S APCLMDFN=$O(^AUPNMCR(DFN,11,APCLMDFN)) Q:APCLMDFN'=+APCLMDFN!($D(APCLQUIT)) I $D(^AUPNMCR(DFN,11,APCLMDFN,0)) S APCLREC=^(0) D 22
D VISIT^APCLBV1
Q
22 ;
Q:APCLVAL'[$P(^AUPNMCR(DFN,11,APCLMDFN,0),U,3)
Q:$P(^AUPNMCR(DFN,11,APCLMDFN,0),U)>APCLED
I $P(^AUPNMCR(DFN,11,APCLMDFN,0),U,2)]"",$P(^(0),U,2)<APCLSD Q
I $Y>(IOSL-5) D HEAD^APCLBV1 Q:$D(APCLQUIT)
W !?8,"Coverage:",?19,$P(APCLREC,U,3) S Y=$P(APCLREC,U) D:Y]"" DD^%DT W ?23,"Beg. Date: ",?34,Y S Y=$P(APCLREC,U,2) D:Y]"" DD^%DT W ?49,"End. Date: ",?61,Y,!?8,"Medicare #: ",APCLMEDN,!
Q
3 ;
D 2
Q
4 ;ENTRY POINT
I $Y>(IOSL-7) D HEAD^APCLBV1 Q:$D(APCLQUIT)
D HD^APCLBV1
S APCLMDFN=0 F S APCLMDFN=$O(^AUPNMCD("B",DFN,APCLMDFN)) Q:APCLMDFN'=+APCLMDFN!($D(APCLQUIT)) S APCLREC=^AUPNMCD(APCLMDFN,0) D 42
Q:$D(APCLQUIT)
W !
D VISIT^APCLBV1
Q
42 ;
Q:'$D(^AUPNMCD(APCLMDFN,11))
S (APCLNDFN,APCLGOT)=0 F S APCLNDFN=$O(^AUPNMCD(APCLMDFN,11,APCLNDFN)) Q:APCLNDFN'=+APCLNDFN!($D(APCLQUIT)) S APCLNREC=^AUPNMCD(APCLMDFN,11,APCLNDFN,0) D 43
Q
;
43 ;
Q:APCLNDFN>APCLED
I $P(APCLNREC,U,2)]"",$P(APCLNREC,U,2)<APCLSD Q
S APCLGOT=APCLGOT+1
G:APCLGOT>1 431
I $Y>(IOSL-9) D HEAD^APCLBV1 Q:$D(APCLQUIT)
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 !?8,"(MCD) ",APCLMN,?61,APCLMDOB
W !?8,"Medicaid #: ",$P(APCLREC,U,3),?50,"State: ",$S($P(APCLREC,U,4)="":"",1:$P(^DIC(5,$P(APCLREC,U,4),0),U))
W !?8,"Name/Insured: ",$P(APCLREC,U,5),?50,"Sex of Insured: ",$P(APCLREC,U,7)
431 I $Y>(IOSL-6) D HEAD^APCLBV1 Q:$D(APCLQUIT)
W !?8,"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
5 ;ENTRY POINT
I $Y>(IOSL-7) D HEAD^APCLBV1 Q:$D(APCLQUIT)
D HD^APCLBV1
S APCLMDFN=0 F S APCLMDFN=$O(^AUPNPRVT(DFN,11,APCLMDFN)) Q:APCLMDFN'=+APCLMDFN!($D(APCLQUIT)) I $D(^AUPNPRVT(DFN,11,APCLMDFN,0)) S APCLREC=^AUPNPRVT(DFN,11,APCLMDFN,0) D 52
Q:$D(APCLQUIT)
D VISIT^APCLBV1
Q
52 ;
Q:$P(APCLREC,U,6)=""
Q:$P(APCLREC,U,6)>APCLED
I $P(APCLREC,U,7)]"",$P(APCLREC,U,7)<APCLSD Q
53 ;
I $Y>(IOSL-9) D HEAD^APCLBV1 Q:$D(APCLQUIT)
W !?8,"INSURER: ",$P(^AUTNINS($P(APCLREC,U),0),U)
W !?8,"POLICY #: ",$S($P($G(^AUPNPRVT(DFN,11,APCLMDFN,2)),U,1)]"":$P(^AUPNPRVT(DFN,11,APCLMDFN,2),U,1),$P(APCLREC,U,8):$P(^AUPN3PPH($P(APCLREC,U,8),0),U,4),1:$P(APCLREC,U,2)),?47,"COVERAGE TYPE: ",$P(APCLREC,U,3)
W !?8,"INSURED: ",$P(APCLREC,U,4),?47,"REL: ",$S($P(APCLREC,U,5)]"":$P(^AUTTRLSH($P(APCLREC,U,5),0),U),1:"")
W !?8,"ELIG BEG DATE: " S Y=$P(APCLREC,U,6) D:Y]"" DD^%DT W Y,?47,"ELIG END DATE: " S Y=$P(APCLREC,U,7) D:Y]"" DD^%DT W Y
W !
Q
6 ;ENTRY POINT
I $Y>(IOSL-9) D HEAD^APCLBV1 Q:$D(APCLQUIT)
D HD^APCLBV1
Q:$D(APCLQUIT)
W !
D VISIT^APCLBV1
Q
APCLBV11 ; IHS/CMI/LAB - continuation of APCLV1 ;
+1 ;;2.0;IHS PCC SUITE;**21**;MAY 14, 2009;Build 34
1 ;EP
+1 IF $Y>(IOSL-9)
DO HEAD^APCLBV1
IF $DATA(APCLQUIT)
QUIT
+2 SET APCLCHMP=$ORDER(^AUTNINS("B","CHAMPUS",0))
+3 IF 'APCLCHMP
SET APCLCHMP=$ORDER(^AUTNINS("B","TRICARE",0))
+4 DO HD^APCLBV1
+5 IF '$DATA(^AUPNPAT(DFN,11))
QUIT
+6 SET X=$PIECE(^AUPNPAT(DFN,11),U,11)
+7 WRITE !?8,APCLCOPN(X)
+8 IF ($PIECE(^AUTTBEN(X,0),U,2)="04"!($PIECE(^AUTTBEN(X,0),U,2)="31"))
IF APCLCHMP]""
DO PRVT1
+9 DO VISIT^APCLBV1
+10 QUIT
PRVT1 ;
+1 IF APCLCHMP=""
QUIT
+2 SET Y=$ORDER(^AUPNPRVT("AB",APCLCHMP,DFN,0))
IF Y=""
QUIT
+3 SET APCLX=^AUPNPRVT(DFN,11,Y,0)
WRITE ?40,"Sponsor: ",$PIECE(APCLX,U,4),?65,"SSN: "
SET X=$PIECE(APCLX,U,2)
WRITE $EXTRACT(X,1,3),"-",$EXTRACT(X,4,5),"-",$EXTRACT(X,6,9)
+4 QUIT
2 ;EP
+1 IF $Y>(IOSL-9)
DO HEAD^APCLBV1
IF $DATA(APCLQUIT)
QUIT
+2 DO HD^APCLBV1
+3 SET APCLMN=$SELECT($DATA(^AUPNMCR(DFN,21)):$PIECE(^AUPNMCR(DFN,21),U),1:"")
+4 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
+5 ;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
+6 ;IHS/CMI/LAB
SET APCLMEDN=$$GETMCR^AGUTL(DFN)_$SELECT($PIECE(^AUPNMCR(DFN,0),U,4)]"":$PIECE(^AUTTMCS($PIECE(^(0),U,4),0),U),1:"")
+7 SET APCLVAL=$SELECT(APCLRNUM=2:"A",1:"B")
+8 WRITE !?8,"Medicare Name: ",APCLMN,?56,"DOB: ",DOB
+9 SET APCLMDFN=0
FOR
SET APCLMDFN=$ORDER(^AUPNMCR(DFN,11,APCLMDFN))
IF APCLMDFN'=+APCLMDFN!($DATA(APCLQUIT))
QUIT
IF $DATA(^AUPNMCR(DFN,11,APCLMDFN,0))
SET APCLREC=^(0)
DO 22
+10 DO VISIT^APCLBV1
+11 QUIT
22 ;
+1 IF APCLVAL'[$PIECE(^AUPNMCR(DFN,11,APCLMDFN,0),U,3)
QUIT
+2 IF $PIECE(^AUPNMCR(DFN,11,APCLMDFN,0),U)>APCLED
QUIT
+3 IF $PIECE(^AUPNMCR(DFN,11,APCLMDFN,0),U,2)]""
IF $PIECE(^(0),U,2)<APCLSD
QUIT
+4 IF $Y>(IOSL-5)
DO HEAD^APCLBV1
IF $DATA(APCLQUIT)
QUIT
+5 WRITE !?8,"Coverage:",?19,$PIECE(APCLREC,U,3)
SET Y=$PIECE(APCLREC,U)
IF Y]""
DO DD^%DT
WRITE ?23,"Beg. Date: ",?34,Y
SET Y=$PIECE(APCLREC,U,2)
IF Y]""
DO DD^%DT
WRITE ?49,"End. Date: ",?61,Y,!?8,"Medicare #: ",APCLMEDN,!
+6 QUIT
3 ;
+1 DO 2
+2 QUIT
4 ;ENTRY POINT
+1 IF $Y>(IOSL-7)
DO HEAD^APCLBV1
IF $DATA(APCLQUIT)
QUIT
+2 DO HD^APCLBV1
+3 SET APCLMDFN=0
FOR
SET APCLMDFN=$ORDER(^AUPNMCD("B",DFN,APCLMDFN))
IF APCLMDFN'=+APCLMDFN!($DATA(APCLQUIT))
QUIT
SET APCLREC=^AUPNMCD(APCLMDFN,0)
DO 42
+4 IF $DATA(APCLQUIT)
QUIT
+5 WRITE !
+6 DO VISIT^APCLBV1
+7 QUIT
42 ;
+1 IF '$DATA(^AUPNMCD(APCLMDFN,11))
QUIT
+2 SET (APCLNDFN,APCLGOT)=0
FOR
SET APCLNDFN=$ORDER(^AUPNMCD(APCLMDFN,11,APCLNDFN))
IF APCLNDFN'=+APCLNDFN!($DATA(APCLQUIT))
QUIT
SET APCLNREC=^AUPNMCD(APCLMDFN,11,APCLNDFN,0)
DO 43
+3 QUIT
+4 ;
43 ;
+1 IF APCLNDFN>APCLED
QUIT
+2 IF $PIECE(APCLNREC,U,2)]""
IF $PIECE(APCLNREC,U,2)<APCLSD
QUIT
+3 SET APCLGOT=APCLGOT+1
+4 IF APCLGOT>1
GOTO 431
+5 IF $Y>(IOSL-9)
DO HEAD^APCLBV1
IF $DATA(APCLQUIT)
QUIT
+6 SET APCLMN=$SELECT($DATA(^AUPNMCD(APCLMDFN,21)):$PIECE(^AUPNMCD(APCLMDFN,21),U),1:"")
+7 SET APCLMDOB=$SELECT($DATA(^AUPNMCD(APCLMDFN,21)):$PIECE(^AUPNMCD(APCLMDFN,21),U,2),1:"")
+8 WRITE !?8,"(MCD) ",APCLMN,?61,APCLMDOB
+9 WRITE !?8,"Medicaid #: ",$PIECE(APCLREC,U,3),?50,"State: ",$SELECT($PIECE(APCLREC,U,4)="":"",1:$PIECE(^DIC(5,$PIECE(APCLREC,U,4),0),U))
+10 WRITE !?8,"Name/Insured: ",$PIECE(APCLREC,U,5),?50,"Sex of Insured: ",$PIECE(APCLREC,U,7)
431 IF $Y>(IOSL-6)
DO HEAD^APCLBV1
IF $DATA(APCLQUIT)
QUIT
+1 WRITE !?8,"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
5 ;ENTRY POINT
+1 IF $Y>(IOSL-7)
DO HEAD^APCLBV1
IF $DATA(APCLQUIT)
QUIT
+2 DO HD^APCLBV1
+3 SET APCLMDFN=0
FOR
SET APCLMDFN=$ORDER(^AUPNPRVT(DFN,11,APCLMDFN))
IF APCLMDFN'=+APCLMDFN!($DATA(APCLQUIT))
QUIT
IF $DATA(^AUPNPRVT(DFN,11,APCLMDFN,0))
SET APCLREC=^AUPNPRVT(DFN,11,APCLMDFN,0)
DO 52
+4 IF $DATA(APCLQUIT)
QUIT
+5 DO VISIT^APCLBV1
+6 QUIT
52 ;
+1 IF $PIECE(APCLREC,U,6)=""
QUIT
+2 IF $PIECE(APCLREC,U,6)>APCLED
QUIT
+3 IF $PIECE(APCLREC,U,7)]""
IF $PIECE(APCLREC,U,7)<APCLSD
QUIT
53 ;
+1 IF $Y>(IOSL-9)
DO HEAD^APCLBV1
IF $DATA(APCLQUIT)
QUIT
+2 WRITE !?8,"INSURER: ",$PIECE(^AUTNINS($PIECE(APCLREC,U),0),U)
+3 WRITE !?8,"POLICY #: ",$SELECT($PIECE($GET(^AUPNPRVT(DFN,11,APCLMDFN,2)),U,1)]"":$PIECE(^AUPNPRVT(DFN,11,APCLMDFN,2),U,1),$PIECE(APCLREC,U,8):$PIECE(^AUPN3PPH($PIECE(APCLREC,U,8),0),U,4),1:$PIECE(APCLREC,U,2)),?47,"COVERAGE TYPE: ",$PIECE(APCLR
EC,U,3)
+4 WRITE !?8,"INSURED: ",$PIECE(APCLREC,U,4),?47,"REL: ",$SELECT($PIECE(APCLREC,U,5)]"":$PIECE(^AUTTRLSH($PIECE(APCLREC,U,5),0),U),1:"")
+5 WRITE !?8,"ELIG BEG DATE: "
SET Y=$PIECE(APCLREC,U,6)
IF Y]""
DO DD^%DT
WRITE Y,?47,"ELIG END DATE: "
SET Y=$PIECE(APCLREC,U,7)
IF Y]""
DO DD^%DT
WRITE Y
+6 WRITE !
+7 QUIT
6 ;ENTRY POINT
+1 IF $Y>(IOSL-9)
DO HEAD^APCLBV1
IF $DATA(APCLQUIT)
QUIT
+2 DO HD^APCLBV1
+3 IF $DATA(APCLQUIT)
QUIT
+4 WRITE !
+5 DO VISIT^APCLBV1
+6 QUIT
