AUPNPAT1.m

AUPNPAT1 ; IHS/CMI/LAB - EXTRINSICS ; [ 08/09/01  9:08 AM ]

 ;;99.1;IHS DICTIONARIES (PATIENT);;MAR 09, 1999

 ;

 Q

 ;

 ; BEN:

 ;   Input - DFN

 ;   Output - 1 = Yes

 ;            0 = No

 ;           -1 = No/old tribe or unable.

 ;

BEN(DFN) ;PEP - Return BEN/Non-BEN Status.

 I '$G(DFN) Q -1

 I '$D(^AUPNPAT(DFN)) Q -1

 NEW AUPN,AUPNTR,Y,X

 S Y=1

 D ENP^XBDIQ1(9000001,DFN,"1108;1109.9;1111","AUPN(","I")

 I AUPN(1108,"I")'>0 Q -1 ;no tribe

 D ENP^XBDIQ1(9999999.03,AUPN(1108,"I"),".04;.02","AUPNTR(")

 I AUPNTR(.04)="YES" Q -1 ;old tribe code

 F X="000","970" I AUPNTR(.02)=X S Y=0 Q  ;non-indian tribes

 I 'Y Q Y

 I 999=AUPNTR(.02),AUPN(1109.9)>0 Q 1 ;unspecified ,Quantum>0

 Q Y

 ;

AUPNPAT1  ; IHS/CMI/LAB - EXTRINSICS ; [ 08/09/01  9:08 AM ]

 +1       ;;99.1;IHS DICTIONARIES (PATIENT);;MAR 09, 1999

 +2       ;

 +3        QUIT 

 +4       ;

 +5       ; BEN:

 +6       ;   Input - DFN

 +7       ;   Output - 1 = Yes

 +8       ;            0 = No

 +9       ;           -1 = No/old tribe or unable.

 +10      ;

BEN(DFN)  ;PEP - Return BEN/Non-BEN Status.

 +1        IF '$GET(DFN)

               QUIT -1

 +2        IF '$DATA(^AUPNPAT(DFN))

               QUIT -1

 +3        NEW AUPN,AUPNTR,Y,X

 +4        SET Y=1

 +5        DO ENP^XBDIQ1(9000001,DFN,"1108;1109.9;1111","AUPN(","I")

 +6       ;no tribe

           IF AUPN(1108,"I")'>0

               QUIT -1

 +7        DO ENP^XBDIQ1(9999999.03,AUPN(1108,"I"),".04;.02","AUPNTR(")

 +8       ;old tribe code

           IF AUPNTR(.04)="YES"

               QUIT -1

 +9       ;non-indian tribes

           FOR X="000","970"

               IF AUPNTR(.02)=X

                   SET Y=0

                   QUIT 

 +10       IF 'Y

               QUIT Y

 +11      ;unspecified ,Quantum>0

           IF 999=AUPNTR(.02)

               IF AUPN(1109.9)>0

                   QUIT 1

 +12       QUIT Y

 +13      ;