- 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 ""