Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMHRLU1

AMHRLU1.m

Go to the documentation of this file.
  1. AMHRLU1 ; IHS/CMI/LAB - GEN RET UTIL ;
  1. ;;4.0;IHS BEHAVIORAL HEALTH;**8**;JUN 02, 2010;Build 7
  1. ;
  1. ;
  1. MCR ;display all current medicare data
  1. NEW AMHMIFN
  1. I '$D(^DPT(P,0)) G MCRX
  1. I $P(^DPT(P,0),U,19) G MCRX
  1. I '$D(^AUPNPAT(P,0)) G MCRX
  1. I '$D(^AUPNMCR(P,11)) G MCRX
  1. I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G MCRX
  1. S AMHMIFN=0 F S AMHMIFN=$O(^AUPNMCR(P,11,AMHMIFN)) Q:AMHMIFN'=+AMHMIFN D
  1. .Q:$P(^AUPNMCR(P,11,AMHMIFN,0),U)>D
  1. .I $P(^AUPNMCR(P,11,AMHMIFN,0),U,2)]"",$P(^(0),U,2)<D Q
  1. .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:"-")_"]"
  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)
  1. .Q
  1. MCRX ;
  1. K Y,Z
  1. Q
  1. ;
  1. MCD ;
  1. NEW AMHMIFN,AMHNIFN
  1. I '$D(^DPT(P,0)) G MCDX
  1. I $P(^DPT(P,0),U,19) G MCDX
  1. I '$D(^AUPNPAT(P,0)) G MCDX
  1. I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G MCDX
  1. S AMHMIFN=0 F S AMHMIFN=$O(^AUPNMCD("B",P,AMHMIFN)) Q:AMHMIFN'=+AMHMIFN D
  1. .Q:'$D(^AUPNMCD(AMHMIFN,11))
  1. .S AMHNIFN=0 F S AMHNIFN=$O(^AUPNMCD(AMHMIFN,11,AMHNIFN)) Q:AMHNIFN'=+AMHNIFN D
  1. ..Q:AMHNIFN>D
  1. ..I $P(^AUPNMCD(AMHMIFN,11,AMHNIFN,0),U,2)]"",$P(^(0),U,2)<D Q
  1. ..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:"<>")
  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)
  1. ..Q
  1. .Q
  1. ;
  1. MCDX ;
  1. Q
  1. ;
  1. PI ;
  1. NEW AMHMIFN,AMHFLG
  1. I '$D(^DPT(P,0)) G PIX
  1. I $P(^DPT(P,0),U,19) G PIX
  1. I '$D(^AUPNPAT(P,0)) G PIX
  1. I '$D(^AUPNPRVT(P,11)) G PIX
  1. I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G PIX
  1. S AMHMIFN=0 F S AMHMIFN=$O(^AUPNPRVT(P,11,AMHMIFN)) Q:AMHMIFN'=+AMHMIFN D
  1. .Q:$P(^AUPNPRVT(P,11,AMHMIFN,0),U)=""
  1. .S AMHNAME=$P(^AUPNPRVT(DFN,11,AMHMIFN,0),U) Q:AMHNAME=""
  1. .Q:$P(^AUTNINS(AMHNAME,0),U)["AHCCCS"
  1. .Q:$P(^AUPNPRVT(P,11,AMHMIFN,0),U,6)>D
  1. .I $P(^AUPNPRVT(P,11,AMHMIFN,0),U,7)]"",$P(^(0),U,7)<D Q
  1. .S AMHPCNT=AMHPCNT+1,AMHPRNM(AMHPCNT)=$P(^AUTNINS($P(^AUPNPRVT(P,11,AMHMIFN,0),U),0),U)
  1. .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)
  1. .Q
  1. PIX ;
  1. Q
  1. RACESCR ;
  1. NEW Y,Z
  1. K Z
  1. D LIST^DIC(2.02,","_DFN_",","@;.01E","P",,,,,,,"Z")
  1. S Y=0 F S Y=$O(Z("DILIST",Y)) Q:Y="" S X($P(Z("DILIST",Y,0),U,1))=""
  1. Q
  1. RACEPRT ;
  1. NEW Z,Y
  1. D LIST^DIC(2.02,","_DFN_",","@;.01E","P",,,,,,,"Z")
  1. S Y=0 F S Y=$O(Z("DILIST",Y)) Q:Y="" D
  1. .;S AMHPCNT=AMHPCNT+1
  1. .S X($P(Z("DILIST",Y,0),U,1))=""
  1. .S AMHPCNT=AMHPCNT+1,AMHPRNM(AMHPCNT)=$P(Z("DILIST",Y,0),U,2)
  1. .S AMHPRNM(AMHPCNT,"I")=$P(Z("DILIST",Y,0),U,1)
  1. .Q
  1. Q
  1. ETHN(P,F) ;EP
  1. I '$G(P) Q ""
  1. I $G(F)="" S F="E"
  1. I '$D(^DPT(P,0)) Q ""
  1. NEW Z,E,I
  1. S (E,I)=""
  1. S Z=0 F S Z=$O(^DPT(P,.06,Z)) Q:Z'=+Z!(E]"") D
  1. .S I=$P($G(^DPT(P,.06,Z,0)),U,1)
  1. .Q:I=""
  1. .S E=$P($G(^DIC(10.2,I,0)),U,1)
  1. .Q
  1. I F="E" Q E
  1. I F="I" Q I
  1. Q ""