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
