AGBIC2C.m

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