- AUPNPAT2 ; IHS/CMI/LAB - PATIENT ELIGIBILITY EXTRINSICS ; [ 02/14/2005 11:00 AM ]
- ;;99.1;IHS DICTIONARIES (PATIENT);**4,8,9,10,15**;JUN 13, 2003;Build 9
- ;
- Q
- ;
- ;---------
- ; MCR: Input - P = DFN
- ; D = Date
- ; Output - 1 = Yes, patient is/was MCare eligible on date D.
- ; 0 = No, or unable.
- ;
- ; Examples: I $$MCR^AUPNPAT(DFN,2930701)
- ; S AGMCR=$$MCR^AUPNPAT(DFN,DT)
- ;
- MCR(P,D) ;EP - Is patient P medicare eligible on date D. 1 = yes, 0 = no.
- ; I = IEN in ^AUPNMCR multiple.
- I '$G(P) Q 0
- I '$G(D) Q 0
- NEW I,Y
- S Y=0,U="^"
- 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 I=0
- F S I=$O(^AUPNMCR(P,11,I)) Q:I'=+I D
- . Q:$P(^AUPNMCR(P,11,I,0),U)>D
- . I $P(^AUPNMCR(P,11,I,0),U,2)]"",$P(^(0),U,2)<D Q
- . S Y=1
- .Q
- MCRX ;
- Q Y
- ;
- ;----------
- ; MCD: Input - P = DFN
- ; D = Date
- ; Output - 1 = Yes, patient is/was MCaid eligible on date D.
- ; 0 = No, or unable.
- ;
- ; Examples: I $$MCD^AUPNPAT(DFN,2930701)
- ; S AGMCD=$$MCD^AUPNPAT(DFN,DT)
- ;
- MCD(P,D) ;EP - Is patient P medicaid eligible on date D.
- ; I = IEN.
- ; J = Node 11 IEN in ^AUPNMCD.
- I '$G(P) Q 0
- I '$G(D) Q 0
- NEW I,J,Y
- S Y=0,U="^"
- 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 I=0 F S I=$O(^AUPNMCD("B",P,I)) Q:I'=+I D
- .Q:'$D(^AUPNMCD(I,11))
- .S J=0 F S J=$O(^AUPNMCD(I,11,J)) Q:J'=+J D
- ..Q:J>D
- ..I $P(^AUPNMCD(I,11,J,0),U,2)]"",$P(^(0),U,2)<D Q
- ..S Y=1
- ..Q
- .Q
- ;
- MCDX ;
- Q Y
- ;
- ;----------
- ; MCDPN: Input - P = DFN
- ; D = Date
- ; F = Form for output of plan (Insurer) name.
- ; If F = "E", return external form, else pointer to INSURER file.
- ; Output - Literal = Cleartext name of insurer.
- ; Number = Pointer to INSURER file.
- ;
- ; Examples: I $$MCDPN^AUPNPAT(DFN,2930701)
- ; S AGMCDPN=$$MCDPN^AUPNPAT(DFN,DT,"E")
- ;
- MCDPN(P,D,F) ;EP - return medicaid plan name for patient P on date D in form F.
- ; I = IEN
- ; J = Node 11 IEN
- I '$G(P) Q ""
- I '$G(D) Q ""
- S F=$G(F)
- NEW I,J,Y
- S Y="",U="^"
- I '$D(^DPT(P,0)) G MCDPNX
- I $P(^DPT(P,0),U,19) G MCDPNX
- I '$D(^AUPNPAT(P,0)) G MCDPNX
- I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G MCDPNX
- S I=0
- F S I=$O(^AUPNMCD("B",P,I)) Q:I'=+I D
- . Q:'$D(^AUPNMCD(I,11))
- . S J=0
- . F S J=$O(^AUPNMCD(I,11,J)) Q:J'=+J D
- .. Q:J>D
- .. I $P(^AUPNMCD(I,11,J,0),U,2)]"",$P(^(0),U,2)<D Q
- .. S Y=$P(^AUPNMCD(I,0),U,10)
- .. I Y]"" S Y=$S(F="E":$P(^AUTNINS(Y,0),U),1:Y)
- ..Q
- .Q
- ;
- MCDPNX ;
- Q Y
- ;
- ;----------
- ; PI: Input - P = DFN
- ; D = Date
- ; Output - 1 = Yes, patient is/was PI eligible on date D.
- ; 0 = No, or unable.
- ;
- ; Examples: I $$PI^AUPNPAT(DFN,2930701)
- ; S AGPI=$$PI^AUPNPAT(DFN,DT)
- ;
- PI(P,D) ;EP - Is patient P private insurance eligible on date D. 1= yes, 0=no.
- ; I = IEN
- ; Y = 1:yes, 0:no
- ; X = Pointer to INSURER file.
- I '$G(P) Q 0
- I '$G(D) Q 0
- NEW I,Y,X
- S Y=0,U="^"
- 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 I=0
- F S I=$O(^AUPNPRVT(P,11,I)) Q:I'=+I D
- . Q:$P(^AUPNPRVT(P,11,I,0),U)=""
- . S X=$P(^AUPNPRVT(P,11,I,0),U) Q:X=""
- . Q:$P(^AUTNINS(X,0),U)["AHCCCS"
- . Q:$P(^AUPNPRVT(P,11,I,0),U,6)>D
- . I $P(^AUPNPRVT(P,11,I,0),U,7)]"",$P(^(0),U,7)<D Q
- . S Y=1
- .Q
- PIX ;
- Q Y
- ;
- ;----------
- ; PIN: Input - P = DFN
- ; D = Date
- ; F = Form for output of plan (Insurer) name.
- ; If F = "E", return external form, else pointer to INSURER file.
- ; Output - Literal = Cleartext name of insurer.
- ; Number = Pointer to INSURER file.
- ;
- ; Examples: I $$PIN^AUPNPAT(DFN,2930701)
- ; S AGPIN=$$PIN^AUPNPAT(DFN,DT,"E")
- ;
- PIN(P,D,F) ;EP - return private insurer name for patient P on date D in form F
- ; I = IEN
- I '$G(P) Q 0
- I '$G(D) Q 0
- NEW I,Y,J
- S F=$G(F)
- S Y="",U="^",J=""
- I '$D(^DPT(P,0)) G PINX
- I $P(^DPT(P,0),U,19) G PINX
- I '$D(^AUPNPAT(P,0)) G PINX
- I '$D(^AUPNPRVT(P,11)) G PINX
- I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G PINX
- S I=0
- F S I=$O(^AUPNPRVT(P,11,I)) Q:I'=+I D
- . Q:$P(^AUPNPRVT(P,11,I,0),U)=""
- . S Y=$P(^AUPNPRVT(P,11,I,0),U)
- . I $P(^AUTNINS(Y,0),U)["AHCCCS" Q
- . I $P(^AUPNPRVT(P,11,I,0),U,6)>D Q
- . I $P(^AUPNPRVT(P,11,I,0),U,7)]"",$P(^(0),U,7)<D Q
- . ;AUPN*99.1*15 fix follows
- . S J=J_$S($L(J):";",1:"")_$S(F="E":$P(^AUTNINS(Y,0),U),1:Y)
- .Q
- PINX ;
- Q J
- ;
- ;Begin New Code;IHS/SET/GTH AUPN*99.1*8 10/04/2002
- RRE(P,D) ;EP - Does pt have Railroad insurance on date? 1 = yes, 0 = no.
- ; I = IEN in ^AUPNRRE multiple.
- I '$G(P) Q 0
- I '$G(D) Q 0
- NEW I,Y
- S Y=0,U="^"
- I '$D(^DPT(P,0)) Q 0
- I $P($G(^DPT(P,0)),U,19) Q 0
- I '$D(^AUPNPAT(P,0)) Q 0
- I '$D(^AUPNRRE(P,11)) Q 0
- I $D(^DPT(P,.35)),$P(^DPT(P,.35),U)]"",$P($G(^DPT(P,.35)),U)<D Q 0
- S I=0
- F S I=$O(^AUPNRRE(P,11,I)) Q:I'=+I D
- . Q:$P(^AUPNRRE(P,11,I,0),U)>D
- . I $P($G(^AUPNRRE(P,11,I,0)),U,2)]"",$P($G(^AUPNRRE(P,11,I,0)),U,2)<D Q
- . S Y=1
- .Q
- RREX ;
- Q Y
- ;
- ;End New Code;IHS/SET/GTH AUPN*99.1*8 10/04/2002
- AUPNPAT2 ; IHS/CMI/LAB - PATIENT ELIGIBILITY EXTRINSICS ; [ 02/14/2005 11:00 AM ]
- +1 ;;99.1;IHS DICTIONARIES (PATIENT);**4,8,9,10,15**;JUN 13, 2003;Build 9
- +2 ;
- +3 QUIT
- +4 ;
- +5 ;---------
- +6 ; MCR: Input - P = DFN
- +7 ; D = Date
- +8 ; Output - 1 = Yes, patient is/was MCare eligible on date D.
- +9 ; 0 = No, or unable.
- +10 ;
- +11 ; Examples: I $$MCR^AUPNPAT(DFN,2930701)
- +12 ; S AGMCR=$$MCR^AUPNPAT(DFN,DT)
- +13 ;
- MCR(P,D) ;EP - Is patient P medicare eligible on date D. 1 = yes, 0 = no.
- +1 ; I = IEN in ^AUPNMCR multiple.
- +2 IF '$GET(P)
- QUIT 0
- +3 IF '$GET(D)
- QUIT 0
- +4 NEW I,Y
- +5 SET Y=0
- SET U="^"
- +6 IF '$DATA(^DPT(P,0))
- GOTO MCRX
- +7 IF $PIECE(^DPT(P,0),U,19)
- GOTO MCRX
- +8 IF '$DATA(^AUPNPAT(P,0))
- GOTO MCRX
- +9 IF '$DATA(^AUPNMCR(P,11))
- GOTO MCRX
- +10 IF $DATA(^DPT(P,.35))
- IF $PIECE(^(.35),U)]""
- IF $PIECE(^(.35),U)<D
- GOTO MCRX
- +11 SET I=0
- +12 FOR
- SET I=$ORDER(^AUPNMCR(P,11,I))
- IF I'=+I
- QUIT
- Begin DoDot:1
- +13 IF $PIECE(^AUPNMCR(P,11,I,0),U)>D
- QUIT
- +14 IF $PIECE(^AUPNMCR(P,11,I,0),U,2)]""
- IF $PIECE(^(0),U,2)<D
- QUIT
- +15 SET Y=1
- +16 QUIT
- End DoDot:1
- MCRX ;
- +1 QUIT Y
- +2 ;
- +3 ;----------
- +4 ; MCD: Input - P = DFN
- +5 ; D = Date
- +6 ; Output - 1 = Yes, patient is/was MCaid eligible on date D.
- +7 ; 0 = No, or unable.
- +8 ;
- +9 ; Examples: I $$MCD^AUPNPAT(DFN,2930701)
- +10 ; S AGMCD=$$MCD^AUPNPAT(DFN,DT)
- +11 ;
- MCD(P,D) ;EP - Is patient P medicaid eligible on date D.
- +1 ; I = IEN.
- +2 ; J = Node 11 IEN in ^AUPNMCD.
- +3 IF '$GET(P)
- QUIT 0
- +4 IF '$GET(D)
- QUIT 0
- +5 NEW I,J,Y
- +6 SET Y=0
- SET U="^"
- +7 IF '$DATA(^DPT(P,0))
- GOTO MCDX
- +8 IF $PIECE(^DPT(P,0),U,19)
- GOTO MCDX
- +9 IF '$DATA(^AUPNPAT(P,0))
- GOTO MCDX
- +10 IF $DATA(^DPT(P,.35))
- IF $PIECE(^(.35),U)]""
- IF $PIECE(^(.35),U)<D
- GOTO MCDX
- +11 SET I=0
- FOR
- SET I=$ORDER(^AUPNMCD("B",P,I))
- IF I'=+I
- QUIT
- Begin DoDot:1
- +12 IF '$DATA(^AUPNMCD(I,11))
- QUIT
- +13 SET J=0
- FOR
- SET J=$ORDER(^AUPNMCD(I,11,J))
- IF J'=+J
- QUIT
- Begin DoDot:2
- +14 IF J>D
- QUIT
- +15 IF $PIECE(^AUPNMCD(I,11,J,0),U,2)]""
- IF $PIECE(^(0),U,2)<D
- QUIT
- +16 SET Y=1
- +17 QUIT
- End DoDot:2
- +18 QUIT
- End DoDot:1
- +19 ;
- MCDX ;
- +1 QUIT Y
- +2 ;
- +3 ;----------
- +4 ; MCDPN: Input - P = DFN
- +5 ; D = Date
- +6 ; F = Form for output of plan (Insurer) name.
- +7 ; If F = "E", return external form, else pointer to INSURER file.
- +8 ; Output - Literal = Cleartext name of insurer.
- +9 ; Number = Pointer to INSURER file.
- +10 ;
- +11 ; Examples: I $$MCDPN^AUPNPAT(DFN,2930701)
- +12 ; S AGMCDPN=$$MCDPN^AUPNPAT(DFN,DT,"E")
- +13 ;
- MCDPN(P,D,F) ;EP - return medicaid plan name for patient P on date D in form F.
- +1 ; I = IEN
- +2 ; J = Node 11 IEN
- +3 IF '$GET(P)
- QUIT ""
- +4 IF '$GET(D)
- QUIT ""
- +5 SET F=$GET(F)
- +6 NEW I,J,Y
- +7 SET Y=""
- SET U="^"
- +8 IF '$DATA(^DPT(P,0))
- GOTO MCDPNX
- +9 IF $PIECE(^DPT(P,0),U,19)
- GOTO MCDPNX
- +10 IF '$DATA(^AUPNPAT(P,0))
- GOTO MCDPNX
- +11 IF $DATA(^DPT(P,.35))
- IF $PIECE(^(.35),U)]""
- IF $PIECE(^(.35),U)<D
- GOTO MCDPNX
- +12 SET I=0
- +13 FOR
- SET I=$ORDER(^AUPNMCD("B",P,I))
- IF I'=+I
- QUIT
- Begin DoDot:1
- +14 IF '$DATA(^AUPNMCD(I,11))
- QUIT
- +15 SET J=0
- +16 FOR
- SET J=$ORDER(^AUPNMCD(I,11,J))
- IF J'=+J
- QUIT
- Begin DoDot:2
- +17 IF J>D
- QUIT
- +18 IF $PIECE(^AUPNMCD(I,11,J,0),U,2)]""
- IF $PIECE(^(0),U,2)<D
- QUIT
- +19 SET Y=$PIECE(^AUPNMCD(I,0),U,10)
- +20 IF Y]""
- SET Y=$SELECT(F="E":$PIECE(^AUTNINS(Y,0),U),1:Y)
- +21 QUIT
- End DoDot:2
- +22 QUIT
- End DoDot:1
- +23 ;
- MCDPNX ;
- +1 QUIT Y
- +2 ;
- +3 ;----------
- +4 ; PI: Input - P = DFN
- +5 ; D = Date
- +6 ; Output - 1 = Yes, patient is/was PI eligible on date D.
- +7 ; 0 = No, or unable.
- +8 ;
- +9 ; Examples: I $$PI^AUPNPAT(DFN,2930701)
- +10 ; S AGPI=$$PI^AUPNPAT(DFN,DT)
- +11 ;
- PI(P,D) ;EP - Is patient P private insurance eligible on date D. 1= yes, 0=no.
- +1 ; I = IEN
- +2 ; Y = 1:yes, 0:no
- +3 ; X = Pointer to INSURER file.
- +4 IF '$GET(P)
- QUIT 0
- +5 IF '$GET(D)
- QUIT 0
- +6 NEW I,Y,X
- +7 SET Y=0
- SET U="^"
- +8 IF '$DATA(^DPT(P,0))
- GOTO PIX
- +9 IF $PIECE(^DPT(P,0),U,19)
- GOTO PIX
- +10 IF '$DATA(^AUPNPAT(P,0))
- GOTO PIX
- +11 IF '$DATA(^AUPNPRVT(P,11))
- GOTO PIX
- +12 IF $DATA(^DPT(P,.35))
- IF $PIECE(^(.35),U)]""
- IF $PIECE(^(.35),U)<D
- GOTO PIX
- +13 SET I=0
- +14 FOR
- SET I=$ORDER(^AUPNPRVT(P,11,I))
- IF I'=+I
- QUIT
- Begin DoDot:1
- +15 IF $PIECE(^AUPNPRVT(P,11,I,0),U)=""
- QUIT
- +16 SET X=$PIECE(^AUPNPRVT(P,11,I,0),U)
- IF X=""
- QUIT
- +17 IF $PIECE(^AUTNINS(X,0),U)["AHCCCS"
- QUIT
- +18 IF $PIECE(^AUPNPRVT(P,11,I,0),U,6)>D
- QUIT
- +19 IF $PIECE(^AUPNPRVT(P,11,I,0),U,7)]""
- IF $PIECE(^(0),U,7)<D
- QUIT
- +20 SET Y=1
- +21 QUIT
- End DoDot:1
- PIX ;
- +1 QUIT Y
- +2 ;
- +3 ;----------
- +4 ; PIN: Input - P = DFN
- +5 ; D = Date
- +6 ; F = Form for output of plan (Insurer) name.
- +7 ; If F = "E", return external form, else pointer to INSURER file.
- +8 ; Output - Literal = Cleartext name of insurer.
- +9 ; Number = Pointer to INSURER file.
- +10 ;
- +11 ; Examples: I $$PIN^AUPNPAT(DFN,2930701)
- +12 ; S AGPIN=$$PIN^AUPNPAT(DFN,DT,"E")
- +13 ;
- PIN(P,D,F) ;EP - return private insurer name for patient P on date D in form F
- +1 ; I = IEN
- +2 IF '$GET(P)
- QUIT 0
- +3 IF '$GET(D)
- QUIT 0
- +4 NEW I,Y,J
- +5 SET F=$GET(F)
- +6 SET Y=""
- SET U="^"
- SET J=""
- +7 IF '$DATA(^DPT(P,0))
- GOTO PINX
- +8 IF $PIECE(^DPT(P,0),U,19)
- GOTO PINX
- +9 IF '$DATA(^AUPNPAT(P,0))
- GOTO PINX
- +10 IF '$DATA(^AUPNPRVT(P,11))
- GOTO PINX
- +11 IF $DATA(^DPT(P,.35))
- IF $PIECE(^(.35),U)]""
- IF $PIECE(^(.35),U)<D
- GOTO PINX
- +12 SET I=0
- +13 FOR
- SET I=$ORDER(^AUPNPRVT(P,11,I))
- IF I'=+I
- QUIT
- Begin DoDot:1
- +14 IF $PIECE(^AUPNPRVT(P,11,I,0),U)=""
- QUIT
- +15 SET Y=$PIECE(^AUPNPRVT(P,11,I,0),U)
- +16 IF $PIECE(^AUTNINS(Y,0),U)["AHCCCS"
- QUIT
- +17 IF $PIECE(^AUPNPRVT(P,11,I,0),U,6)>D
- QUIT
- +18 IF $PIECE(^AUPNPRVT(P,11,I,0),U,7)]""
- IF $PIECE(^(0),U,7)<D
- QUIT
- +19 ;AUPN*99.1*15 fix follows
- +20 SET J=J_$SELECT($LENGTH(J):";",1:"")_$SELECT(F="E":$PIECE(^AUTNINS(Y,0),U),1:Y)
- +21 QUIT
- End DoDot:1
- PINX ;
- +1 QUIT J
- +2 ;
- +3 ;Begin New Code;IHS/SET/GTH AUPN*99.1*8 10/04/2002
- RRE(P,D) ;EP - Does pt have Railroad insurance on date? 1 = yes, 0 = no.
- +1 ; I = IEN in ^AUPNRRE multiple.
- +2 IF '$GET(P)
- QUIT 0
- +3 IF '$GET(D)
- QUIT 0
- +4 NEW I,Y
- +5 SET Y=0
- SET U="^"
- +6 IF '$DATA(^DPT(P,0))
- QUIT 0
- +7 IF $PIECE($GET(^DPT(P,0)),U,19)
- QUIT 0
- +8 IF '$DATA(^AUPNPAT(P,0))
- QUIT 0
- +9 IF '$DATA(^AUPNRRE(P,11))
- QUIT 0
- +10 IF $DATA(^DPT(P,.35))
- IF $PIECE(^DPT(P,.35),U)]""
- IF $PIECE($GET(^DPT(P,.35)),U)<D
- QUIT 0
- +11 SET I=0
- +12 FOR
- SET I=$ORDER(^AUPNRRE(P,11,I))
- IF I'=+I
- QUIT
- Begin DoDot:1
- +13 IF $PIECE(^AUPNRRE(P,11,I,0),U)>D
- QUIT
- +14 IF $PIECE($GET(^AUPNRRE(P,11,I,0)),U,2)]""
- IF $PIECE($GET(^AUPNRRE(P,11,I,0)),U,2)<D
- QUIT
- +15 SET Y=1
- +16 QUIT
- End DoDot:1
- RREX ;
- +1 QUIT Y
- +2 ;
- +3 ;End New Code;IHS/SET/GTH AUPN*99.1*8 10/04/2002