AMHRLU1 ; IHS/CMI/LAB - GEN RET UTIL ;
;;4.0;IHS BEHAVIORAL HEALTH;**8**;JUN 02, 2010;Build 7
;
;
MCR ;display all current medicare data
NEW AMHMIFN
I '$D(^DPT(P,0)) G MCRX
I $P(^DPT(P,0),U,19) G MCRX
I '$D(^AUPNPAT(P,0)) G MCRX
I '$D(^AUPNMCR(P,11)) G MCRX
I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G MCRX
S AMHMIFN=0 F S AMHMIFN=$O(^AUPNMCR(P,11,AMHMIFN)) Q:AMHMIFN'=+AMHMIFN D
.Q:$P(^AUPNMCR(P,11,AMHMIFN,0),U)>D
.I $P(^AUPNMCR(P,11,AMHMIFN,0),U,2)]"",$P(^(0),U,2)<D Q
.S AMHPCNT=AMHPCNT+1,AMHPRNM(AMHPCNT)=$P(^AUPNMCR(DFN,0),U,3)_" ["_$S($P(^(0),U,4)]"":$P(^AUTTMCS($P(^(0),U,4),0),U),1:"-")_"]"
.S AMHPCNT=AMHPCNT+1,Y=$P(^AUPNMCR(DFN,11,AMHMIFN,0),U),Z=$P(^(0),U,2),AMHPRNM(AMHPCNT)=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_"-" I Z]"" S AMHPRNM(AMHPCNT)=AMHPRNM(AMHPCNT)_$E(Z,4,5)_"/"_$E(Z,6,7)_"/"_$E(Y,2,3)
.Q
MCRX ;
K Y,Z
Q
;
MCD ;
NEW AMHMIFN,AMHNIFN
I '$D(^DPT(P,0)) G MCDX
I $P(^DPT(P,0),U,19) G MCDX
I '$D(^AUPNPAT(P,0)) G MCDX
I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G MCDX
S AMHMIFN=0 F S AMHMIFN=$O(^AUPNMCD("B",P,AMHMIFN)) Q:AMHMIFN'=+AMHMIFN D
.Q:'$D(^AUPNMCD(AMHMIFN,11))
.S AMHNIFN=0 F S AMHNIFN=$O(^AUPNMCD(AMHMIFN,11,AMHNIFN)) Q:AMHNIFN'=+AMHNIFN D
..Q:AMHNIFN>D
..I $P(^AUPNMCD(AMHMIFN,11,AMHNIFN,0),U,2)]"",$P(^(0),U,2)<D Q
..S AMHPCNT=AMHPCNT+1,AMHPRNM(AMHPCNT)=$P(^AUPNMCD(AMHMIFN,0),U,3)_"/"_$S($P(^AUPNMCD(AMHMIFN,0),U,2)]"":$P(^AUTNINS($P(^AUPNMCD(AMHMIFN,0),U,2),0),U),1:"<>")
..S AMHPCNT=AMHPCNT+1,Y=$P(^AUPNMCD(AMHMIFN,11,AMHNIFN,0),U),Z=$P(^(0),U,2),AMHPRNM(AMHPCNT)=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_"-" I Z]"" S AMHPRNM(AMHPCNT)=AMHPRNM(AMHPCNT)_$E(Z,4,5)_"/"_$E(Z,6,7)_"/"_$E(Y,2,3)
..Q
.Q
;
MCDX ;
Q
;
PI ;
NEW AMHMIFN,AMHFLG
I '$D(^DPT(P,0)) G PIX
I $P(^DPT(P,0),U,19) G PIX
I '$D(^AUPNPAT(P,0)) G PIX
I '$D(^AUPNPRVT(P,11)) G PIX
I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G PIX
S AMHMIFN=0 F S AMHMIFN=$O(^AUPNPRVT(P,11,AMHMIFN)) Q:AMHMIFN'=+AMHMIFN D
.Q:$P(^AUPNPRVT(P,11,AMHMIFN,0),U)=""
.S AMHNAME=$P(^AUPNPRVT(DFN,11,AMHMIFN,0),U) Q:AMHNAME=""
.Q:$P(^AUTNINS(AMHNAME,0),U)["AHCCCS"
.Q:$P(^AUPNPRVT(P,11,AMHMIFN,0),U,6)>D
.I $P(^AUPNPRVT(P,11,AMHMIFN,0),U,7)]"",$P(^(0),U,7)<D Q
.S AMHPCNT=AMHPCNT+1,AMHPRNM(AMHPCNT)=$P(^AUTNINS($P(^AUPNPRVT(P,11,AMHMIFN,0),U),0),U)
.S AMHPCNT=AMHPCNT+1,Y=$P(^AUPNPRVT(DFN,11,AMHMIFN,0),U,6),Z=$P(^(0),U,7),AMHPRNM(AMHPCNT)=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_"-" I Z]"" S AMHPRNM(AMHPCNT)=AMHPRNM(AMHPCNT)_$E(Z,4,5)_"/"_$E(Z,6,7)_"/"_$E(Z,2,3)
.Q
PIX ;
Q
RACESCR ;
NEW Y,Z
K Z
D LIST^DIC(2.02,","_DFN_",","@;.01E","P",,,,,,,"Z")
S Y=0 F S Y=$O(Z("DILIST",Y)) Q:Y="" S X($P(Z("DILIST",Y,0),U,1))=""
Q
RACEPRT ;
NEW Z,Y
D LIST^DIC(2.02,","_DFN_",","@;.01E","P",,,,,,,"Z")
S Y=0 F S Y=$O(Z("DILIST",Y)) Q:Y="" D
.;S AMHPCNT=AMHPCNT+1
.S X($P(Z("DILIST",Y,0),U,1))=""
.S AMHPCNT=AMHPCNT+1,AMHPRNM(AMHPCNT)=$P(Z("DILIST",Y,0),U,2)
.S AMHPRNM(AMHPCNT,"I")=$P(Z("DILIST",Y,0),U,1)
.Q
Q
ETHN(P,F) ;EP
I '$G(P) Q ""
I $G(F)="" S F="E"
I '$D(^DPT(P,0)) Q ""
NEW Z,E,I
S (E,I)=""
S Z=0 F S Z=$O(^DPT(P,.06,Z)) Q:Z'=+Z!(E]"") D
.S I=$P($G(^DPT(P,.06,Z,0)),U,1)
.Q:I=""
.S E=$P($G(^DIC(10.2,I,0)),U,1)
.Q
I F="E" Q E
I F="I" Q I
Q ""
AMHRLU1 ; IHS/CMI/LAB - GEN RET UTIL ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**8**;JUN 02, 2010;Build 7
+2 ;
+3 ;
MCR ;display all current medicare data
+1 NEW AMHMIFN
+2 IF '$DATA(^DPT(P,0))
GOTO MCRX
+3 IF $PIECE(^DPT(P,0),U,19)
GOTO MCRX
+4 IF '$DATA(^AUPNPAT(P,0))
GOTO MCRX
+5 IF '$DATA(^AUPNMCR(P,11))
GOTO MCRX
+6 IF $DATA(^DPT(P,.35))
IF $PIECE(^(.35),U)]""
IF $PIECE(^(.35),U)<D
GOTO MCRX
+7 SET AMHMIFN=0
FOR
SET AMHMIFN=$ORDER(^AUPNMCR(P,11,AMHMIFN))
IF AMHMIFN'=+AMHMIFN
QUIT
Begin DoDot:1
+8 IF $PIECE(^AUPNMCR(P,11,AMHMIFN,0),U)>D
QUIT
+9 IF $PIECE(^AUPNMCR(P,11,AMHMIFN,0),U,2)]""
IF $PIECE(^(0),U,2)<D
QUIT
+10 SET AMHPCNT=AMHPCNT+1
SET AMHPRNM(AMHPCNT)=$PIECE(^AUPNMCR(DFN,0),U,3)_" ["_$SELECT($PIECE(^(0),U,4)]"":$PIECE(^AUTTMCS($PIECE(^(0),U,4),0),U),1:"-")_"]"
+11 SET AMHPCNT=AMHPCNT+1
SET Y=$PIECE(^AUPNMCR(DFN,11,AMHMIFN,0),U)
SET Z=$PIECE(^(0),U,2)
SET AMHPRNM(AMHPCNT)=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)_"-"
IF Z]""
SET AMHPRNM(AMHPCNT)=AMHPRNM(AMHPCNT)_$EXTRACT(Z,4,5)_"/"_$EXTRACT(Z,6,7)_"/"_$EXTRACT(Y,2,3)
+12 QUIT
End DoDot:1
MCRX ;
+1 KILL Y,Z
+2 QUIT
+3 ;
MCD ;
+1 NEW AMHMIFN,AMHNIFN
+2 IF '$DATA(^DPT(P,0))
GOTO MCDX
+3 IF $PIECE(^DPT(P,0),U,19)
GOTO MCDX
+4 IF '$DATA(^AUPNPAT(P,0))
GOTO MCDX
+5 IF $DATA(^DPT(P,.35))
IF $PIECE(^(.35),U)]""
IF $PIECE(^(.35),U)<D
GOTO MCDX
+6 SET AMHMIFN=0
FOR
SET AMHMIFN=$ORDER(^AUPNMCD("B",P,AMHMIFN))
IF AMHMIFN'=+AMHMIFN
QUIT
Begin DoDot:1
+7 IF '$DATA(^AUPNMCD(AMHMIFN,11))
QUIT
+8 SET AMHNIFN=0
FOR
SET AMHNIFN=$ORDER(^AUPNMCD(AMHMIFN,11,AMHNIFN))
IF AMHNIFN'=+AMHNIFN
QUIT
Begin DoDot:2
+9 IF AMHNIFN>D
QUIT
+10 IF $PIECE(^AUPNMCD(AMHMIFN,11,AMHNIFN,0),U,2)]""
IF $PIECE(^(0),U,2)<D
QUIT
+11 SET AMHPCNT=AMHPCNT+1
SET AMHPRNM(AMHPCNT)=$PIECE(^AUPNMCD(AMHMIFN,0),U,3)_"/"_$SELECT($PIECE(^AUPNMCD(AMHMIFN,0),U,2)]"":$PIECE(^AUTNINS($PIECE(^AUPNMCD(AMHMIFN,0),U,2),0),U),1:"<>")
+12 SET AMHPCNT=AMHPCNT+1
SET Y=$PIECE(^AUPNMCD(AMHMIFN,11,AMHNIFN,0),U)
SET Z=$PIECE(^(0),U,2)
SET AMHPRNM(AMHPCNT)=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)_"-"
IF Z]""
SET AMHPRNM(AMHPCNT)=AMHPRNM(AMHPCNT)_$EXTRACT(Z,4,5)_"/"_$EXTRACT(Z,6,7)_"/"_$EXTRACT(Y,2,3)
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 ;
MCDX ;
+1 QUIT
+2 ;
PI ;
+1 NEW AMHMIFN,AMHFLG
+2 IF '$DATA(^DPT(P,0))
GOTO PIX
+3 IF $PIECE(^DPT(P,0),U,19)
GOTO PIX
+4 IF '$DATA(^AUPNPAT(P,0))
GOTO PIX
+5 IF '$DATA(^AUPNPRVT(P,11))
GOTO PIX
+6 IF $DATA(^DPT(P,.35))
IF $PIECE(^(.35),U)]""
IF $PIECE(^(.35),U)<D
GOTO PIX
+7 SET AMHMIFN=0
FOR
SET AMHMIFN=$ORDER(^AUPNPRVT(P,11,AMHMIFN))
IF AMHMIFN'=+AMHMIFN
QUIT
Begin DoDot:1
+8 IF $PIECE(^AUPNPRVT(P,11,AMHMIFN,0),U)=""
QUIT
+9 SET AMHNAME=$PIECE(^AUPNPRVT(DFN,11,AMHMIFN,0),U)
IF AMHNAME=""
QUIT
+10 IF $PIECE(^AUTNINS(AMHNAME,0),U)["AHCCCS"
QUIT
+11 IF $PIECE(^AUPNPRVT(P,11,AMHMIFN,0),U,6)>D
QUIT
+12 IF $PIECE(^AUPNPRVT(P,11,AMHMIFN,0),U,7)]""
IF $PIECE(^(0),U,7)<D
QUIT
+13 SET AMHPCNT=AMHPCNT+1
SET AMHPRNM(AMHPCNT)=$PIECE(^AUTNINS($PIECE(^AUPNPRVT(P,11,AMHMIFN,0),U),0),U)
+14 SET AMHPCNT=AMHPCNT+1
SET Y=$PIECE(^AUPNPRVT(DFN,11,AMHMIFN,0),U,6)
SET Z=$PIECE(^(0),U,7)
SET AMHPRNM(AMHPCNT)=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)_"-"
IF Z]""
SET AMHPRNM(AMHPCNT)=AMHPRNM(AMHPCNT)_$EXTRACT(Z,4,5)_"/"_$EXTRACT(Z,6,7)_"/"_$EXTRACT(Z,2,3)
+15 QUIT
End DoDot:1
PIX ;
+1 QUIT
RACESCR ;
+1 NEW Y,Z
+2 KILL Z
+3 DO LIST^DIC(2.02,","_DFN_",","@;.01E","P",,,,,,,"Z")
+4 SET Y=0
FOR
SET Y=$ORDER(Z("DILIST",Y))
IF Y=""
QUIT
SET X($PIECE(Z("DILIST",Y,0),U,1))=""
+5 QUIT
RACEPRT ;
+1 NEW Z,Y
+2 DO LIST^DIC(2.02,","_DFN_",","@;.01E","P",,,,,,,"Z")
+3 SET Y=0
FOR
SET Y=$ORDER(Z("DILIST",Y))
IF Y=""
QUIT
Begin DoDot:1
+4 ;S AMHPCNT=AMHPCNT+1
+5 SET X($PIECE(Z("DILIST",Y,0),U,1))=""
+6 SET AMHPCNT=AMHPCNT+1
SET AMHPRNM(AMHPCNT)=$PIECE(Z("DILIST",Y,0),U,2)
+7 SET AMHPRNM(AMHPCNT,"I")=$PIECE(Z("DILIST",Y,0),U,1)
+8 QUIT
End DoDot:1
+9 QUIT
ETHN(P,F) ;EP
+1 IF '$GET(P)
QUIT ""
+2 IF $GET(F)=""
SET F="E"
+3 IF '$DATA(^DPT(P,0))
QUIT ""
+4 NEW Z,E,I
+5 SET (E,I)=""
+6 SET Z=0
FOR
SET Z=$ORDER(^DPT(P,.06,Z))
IF Z'=+Z!(E]"")
QUIT
Begin DoDot:1
+7 SET I=$PIECE($GET(^DPT(P,.06,Z,0)),U,1)
+8 IF I=""
QUIT
+9 SET E=$PIECE($GET(^DIC(10.2,I,0)),U,1)
+10 QUIT
End DoDot:1
+11 IF F="E"
QUIT E
+12 IF F="I"
QUIT I
+13 QUIT ""
