AGBIC2C ; IHS/ASDS/EFG - COMPUTE ELIGIBILITY STATUS ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
Q:'$D(^AUPNPAT(DFN,11))
S AG("OLDELIG")=" "
I $P(^AUPNPAT(DFN,11),U,24)]"" D
. S AG("OLDELIG")=$P(^AUTTBICE($P(^AUPNPAT(DFN,11),U,24),0),U,2)
S AG("Q")=$P(^AUPNPAT(DFN,11),U,10)
S AG("TRIBE")=$P(^AUPNPAT(DFN,11),U,8)
S AG("MINOR")=$P(^AUPNPAT(DFN,11),U,25)
S AG("TRBVER")=$P(^AUPNPAT(DFN,11),U,19)
S AG("BIC")=$P(^AUPNPAT(DFN,11),U,24)
S AG("RESVER")=$P(^AUPNPAT(DFN,11),U,21)
S AG("PRVRES")=$P(^AUPNPAT(DFN,11),U,22)
BLOOD ;
;Indian using Blood Quantum.
S AG("Q")=$S(AG("Q")="N":1,AG("Q")="NONE":2,AG("Q")="UNK":3,AG("Q")="UNKNOWN":4,AG("Q")="UNS":5,AG("Q")="UNSPECIFIED":6,1:9)
G:AG("Q")=9 TRIBE
S AG("ELIG")="E"
D SETELIG
G END
TRIBE ;
;Tribal Member.
I AG("TRIBE")="" I AG("MINOR")'="T"&(AG("MINOR")'="B") D Q
. S AG("ELIG")="F"
. D SETELIG
. D END
I AG("TRIBE")]"" S AG("CD")=$P(^AUTTTRI(AG("TRIBE"),0),U,2) I AG("CD")="000"!(AG("CD")>"979") I AG("MINOR")'="T"&(AG("MINOR")'="B") S AG("ELIG")="F" D SETELIG,END Q
I $P(^AUTTTRI(AG("TRIBE"),0),U,4)="Y" I AG("MINOR")'="T"&(AG("MINOR")'="B") D Q
. S AG("ELIG")="F"
. D SETELIG
. D END
TRBVER ;
I AG("TRBVER")'="Y"&(AG("MINOR")'="T")&(AG("MINOR")'="B") G TRBNOTVR
RES ;
;Resides in HSDA.
I '$D(^AUPNPAT(DFN,51)) G CKPREV
S AG("DT")=0
S AG("DT")=$O(^AUPNPAT(DFN,51,AG("DT")))
I $P(^AUPNPAT(DFN,51,AG("DT"),0),U,3)="" G CKPREV
I $P(^AUTTCTY($P(^AUTTCOM($P(^AUPNPAT(DFN,51,AG("DT"),0),U,3),0),U,2),0),U,5)'="Y" G CKPARENT
RESVER ;
;Residence Verified.
I AG("RESVER")="Y"!(AG("MINOR")="C")!(AG("MINOR")="B") D Q
. S AG("ELIG")="A"
. D SETELIG
. D END
RESNOTVR ;
S AG("ELIG")="G"
D SETELIG
D END
Q
CKPARENT ;
I AG("MINOR")="C"!(AG("MINOR")="B") D Q
. S AG("ELIG")="A"
. D SETELIG
. D END
CKPREV ;
I AG("MINOR")="C"!(AG("MINOR")="B") D Q
. S AG("ELIG")="A"
. D SETELIG
. D END
I AG("PRVRES")="Y" D Q
. S AG("ELIG")="B"
. D SETELIG
. D END
S AG("ELIG")="X"
D SETELIG
D END
Q
TRBNOTVR ;
G CKPREV1:'$D(^AUPNPAT(DFN,51))
G CKPREV1:$P(^AUPNPAT(DFN,51,0),U,3)=""
G CKPREV1:'$D(^AUPNPAT(DFN,51,$P(^AUPNPAT(DFN,51,0),U,3),0))
S AG("DT")=0
S AG("DT")=$O(^AUPNPAT(DFN,51,AG("DT")))
I $P(^AUPNPAT(DFN,51,AG("DT"),0),U,3)="" G CKPREV1
I $P(^AUTTCTY($P(^AUTTCOM($P(^AUPNPAT(DFN,51,AG("DT"),0),U,3),0),U,2),0),U,5)'="Y" G CKPRNT1
I AG("RESVER")="Y"!(AG("MINOR")="C")!(AG("MINOR")="B") S AG("ELIG")="Z" D SETELIG,END Q
S AG("ELIG")="K"
D SETELIG
D END
Q
CKPRNT1 ;
I AG("MINOR")="C"!(AG("MINOR")="B") D Q
. S AG("ELIG")="Z"
. D SETELIG
. D END
CKPREV1 ;
I AG("MINOR")="C"!(AG("MINOR")="B") D Q
. S AG("ELIG")="Z"
. D SETELIG
. D END
I AG("PRVRES")="Y" D Q
. S AG("ELIG")="J"
. D SETELIG
. D END
S AG("ELIG")="X"
D SETELIG
D END
Q
END ;
K AG("COMM"),AG("DT"),AG("ELIG"),AG("OLDELIG"),AG("Q"),AG("TRIBE")
K AG("MINOR"),AG("TRBVER"),AG("BIC"),AG("RESVER"),AG("PRVRES")
Q
ELIGDATE ;
S DA=DFN
S DR="1123///"_DT
S DIE="^AUPNPAT("
D ^DIE
Q
SETELIG ;
S DA=DFN
S DIE="^AUPNPAT("
S DR="1124///"_AG("ELIG")
D ^DIE
D ELIGDATE
I "AB"[AG("ELIG") I "AB"'[AG("OLDELIG") D ^AGBIC1
Q
AGBIC2C ; IHS/ASDS/EFG - COMPUTE ELIGIBILITY STATUS ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
+3 IF '$DATA(^AUPNPAT(DFN,11))
QUIT
+4 SET AG("OLDELIG")=" "
+5 IF $PIECE(^AUPNPAT(DFN,11),U,24)]""
Begin DoDot:1
+6 SET AG("OLDELIG")=$PIECE(^AUTTBICE($PIECE(^AUPNPAT(DFN,11),U,24),0),U,2)
End DoDot:1
+7 SET AG("Q")=$PIECE(^AUPNPAT(DFN,11),U,10)
+8 SET AG("TRIBE")=$PIECE(^AUPNPAT(DFN,11),U,8)
+9 SET AG("MINOR")=$PIECE(^AUPNPAT(DFN,11),U,25)
+10 SET AG("TRBVER")=$PIECE(^AUPNPAT(DFN,11),U,19)
+11 SET AG("BIC")=$PIECE(^AUPNPAT(DFN,11),U,24)
+12 SET AG("RESVER")=$PIECE(^AUPNPAT(DFN,11),U,21)
+13 SET AG("PRVRES")=$PIECE(^AUPNPAT(DFN,11),U,22)
BLOOD ;
+1 ;Indian using Blood Quantum.
+2 SET AG("Q")=$SELECT(AG("Q")="N":1,AG("Q")="NONE":2,AG("Q")="UNK":3,AG("Q")="UNKNOWN":4,AG("Q")="UNS":5,AG("Q")="UNSPECIFIED":6,1:9)
+3 IF AG("Q")=9
GOTO TRIBE
+4 SET AG("ELIG")="E"
+5 DO SETELIG
+6 GOTO END
TRIBE ;
+1 ;Tribal Member.
+2 IF AG("TRIBE")=""
IF AG("MINOR")'="T"&(AG("MINOR")'="B")
Begin DoDot:1
+3 SET AG("ELIG")="F"
+4 DO SETELIG
+5 DO END
End DoDot:1
QUIT
+6 IF AG("TRIBE")]""
SET AG("CD")=$PIECE(^AUTTTRI(AG("TRIBE"),0),U,2)
IF AG("CD")="000"!(AG("CD")>"979")
IF AG("MINOR")'="T"&(AG("MINOR")'="B")
SET AG("ELIG")="F"
DO SETELIG
DO END
QUIT
+7 IF $PIECE(^AUTTTRI(AG("TRIBE"),0),U,4)="Y"
IF AG("MINOR")'="T"&(AG("MINOR")'="B")
Begin DoDot:1
+8 SET AG("ELIG")="F"
+9 DO SETELIG
+10 DO END
End DoDot:1
QUIT
TRBVER ;
+1 IF AG("TRBVER")'="Y"&(AG("MINOR")'="T")&(AG("MINOR")'="B")
GOTO TRBNOTVR
RES ;
+1 ;Resides in HSDA.
+2 IF '$DATA(^AUPNPAT(DFN,51))
GOTO CKPREV
+3 SET AG("DT")=0
+4 SET AG("DT")=$ORDER(^AUPNPAT(DFN,51,AG("DT")))
+5 IF $PIECE(^AUPNPAT(DFN,51,AG("DT"),0),U,3)=""
GOTO CKPREV
+6 IF $PIECE(^AUTTCTY($PIECE(^AUTTCOM($PIECE(^AUPNPAT(DFN,51,AG("DT"),0),U,3),0),U,2),0),U,5)'="Y"
GOTO CKPARENT
RESVER ;
+1 ;Residence Verified.
+2 IF AG("RESVER")="Y"!(AG("MINOR")="C")!(AG("MINOR")="B")
Begin DoDot:1
+3 SET AG("ELIG")="A"
+4 DO SETELIG
+5 DO END
End DoDot:1
QUIT
RESNOTVR ;
+1 SET AG("ELIG")="G"
+2 DO SETELIG
+3 DO END
+4 QUIT
CKPARENT ;
+1 IF AG("MINOR")="C"!(AG("MINOR")="B")
Begin DoDot:1
+2 SET AG("ELIG")="A"
+3 DO SETELIG
+4 DO END
End DoDot:1
QUIT
CKPREV ;
+1 IF AG("MINOR")="C"!(AG("MINOR")="B")
Begin DoDot:1
+2 SET AG("ELIG")="A"
+3 DO SETELIG
+4 DO END
End DoDot:1
QUIT
+5 IF AG("PRVRES")="Y"
Begin DoDot:1
+6 SET AG("ELIG")="B"
+7 DO SETELIG
+8 DO END
End DoDot:1
QUIT
+9 SET AG("ELIG")="X"
+10 DO SETELIG
+11 DO END
+12 QUIT
TRBNOTVR ;
+1 IF '$DATA(^AUPNPAT(DFN,51))
GOTO CKPREV1
+2 IF $PIECE(^AUPNPAT(DFN,51,0),U,3)=""
GOTO CKPREV1
+3 IF '$DATA(^AUPNPAT(DFN,51,$PIECE(^AUPNPAT(DFN,51,0),U,3),0))
GOTO CKPREV1
+4 SET AG("DT")=0
+5 SET AG("DT")=$ORDER(^AUPNPAT(DFN,51,AG("DT")))
+6 IF $PIECE(^AUPNPAT(DFN,51,AG("DT"),0),U,3)=""
GOTO CKPREV1
+7 IF $PIECE(^AUTTCTY($PIECE(^AUTTCOM($PIECE(^AUPNPAT(DFN,51,AG("DT"),0),U,3),0),U,2),0),U,5)'="Y"
GOTO CKPRNT1
+8 IF AG("RESVER")="Y"!(AG("MINOR")="C")!(AG("MINOR")="B")
SET AG("ELIG")="Z"
DO SETELIG
DO END
QUIT
+9 SET AG("ELIG")="K"
+10 DO SETELIG
+11 DO END
+12 QUIT
CKPRNT1 ;
+1 IF AG("MINOR")="C"!(AG("MINOR")="B")
Begin DoDot:1
+2 SET AG("ELIG")="Z"
+3 DO SETELIG
+4 DO END
End DoDot:1
QUIT
CKPREV1 ;
+1 IF AG("MINOR")="C"!(AG("MINOR")="B")
Begin DoDot:1
+2 SET AG("ELIG")="Z"
+3 DO SETELIG
+4 DO END
End DoDot:1
QUIT
+5 IF AG("PRVRES")="Y"
Begin DoDot:1
+6 SET AG("ELIG")="J"
+7 DO SETELIG
+8 DO END
End DoDot:1
QUIT
+9 SET AG("ELIG")="X"
+10 DO SETELIG
+11 DO END
+12 QUIT
END ;
+1 KILL AG("COMM"),AG("DT"),AG("ELIG"),AG("OLDELIG"),AG("Q"),AG("TRIBE")
+2 KILL AG("MINOR"),AG("TRBVER"),AG("BIC"),AG("RESVER"),AG("PRVRES")
+3 QUIT
ELIGDATE ;
+1 SET DA=DFN
+2 SET DR="1123///"_DT
+3 SET DIE="^AUPNPAT("
+4 DO ^DIE
+5 QUIT
SETELIG ;
+1 SET DA=DFN
+2 SET DIE="^AUPNPAT("
+3 SET DR="1124///"_AG("ELIG")
+4 DO ^DIE
+5 DO ELIGDATE
+6 IF "AB"[AG("ELIG")
IF "AB"'[AG("OLDELIG")
DO ^AGBIC1
+7 QUIT
