- 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
