source: WorldVistAEHR/trunk/r/IHS_ROUTINES-AUP/AUPNPAT2.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.2 KB
Line 
1AUPNPAT2 ; IHS/CMI/LAB - PATIENT ELIGIBILITY EXTRINSICS ; [ 05/09/2003 8:02 AM ]
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**167**;Aug 12, 1996;Build 22
3 ;
4 Q
5 ;
6 ;---------
7 ; MCR: Input - P = DFN
8 ; D = Date
9 ; Output - 1 = Yes, patient is/was MCare eligible on date D.
10 ; 0 = No, or unable.
11 ;
12 ; Examples: I $$MCR^AUPNPAT(DFN,2930701)
13 ; S AGMCR=$$MCR^AUPNPAT(DFN,DT)
14 ;
15MCR(P,D) ;EP - Is patient P medicare eligible on date D. 1 = yes, 0 = no.
16 ; I = IEN in ^AUPNMCR multiple.
17 I '$G(P) Q 0
18 I '$G(D) Q 0
19 NEW I,Y
20 S Y=0,U="^"
21 I '$D(^DPT(P,0)) G MCRX
22 I $P(^DPT(P,0),U,19) G MCRX
23 I '$D(^AUPNPAT(P,0)) G MCRX
24 I '$D(^AUPNMCR(P,11)) G MCRX
25 I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G MCRX
26 S I=0
27 F S I=$O(^AUPNMCR(P,11,I)) Q:I'=+I D
28 . Q:$P(^AUPNMCR(P,11,I,0),U)>D
29 . I $P(^AUPNMCR(P,11,I,0),U,2)]"",$P(^(0),U,2)<D Q
30 . S Y=1
31 .Q
32MCRX ;
33 Q Y
34 ;
35 ;----------
36 ; MCD: Input - P = DFN
37 ; D = Date
38 ; Output - 1 = Yes, patient is/was MCaid eligible on date D.
39 ; 0 = No, or unable.
40 ;
41 ; Examples: I $$MCD^AUPNPAT(DFN,2930701)
42 ; S AGMCD=$$MCD^AUPNPAT(DFN,DT)
43 ;
44MCD(P,D) ;EP - Is patient P medicaid eligible on date D.
45 ; I = IEN.
46 ; J = Node 11 IEN in ^AUPNMCD.
47 I '$G(P) Q 0
48 I '$G(D) Q 0
49 NEW I,J,Y
50 S Y=0,U="^"
51 I '$D(^DPT(P,0)) G MCDX
52 I $P(^DPT(P,0),U,19) G MCDX
53 I '$D(^AUPNPAT(P,0)) G MCDX
54 I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G MCDX
55 S I=0 F S I=$O(^AUPNMCD("B",P,I)) Q:I'=+I D
56 .Q:'$D(^AUPNMCD(I,11))
57 .S J=0 F S J=$O(^AUPNMCD(I,11,J)) Q:J'=+J D
58 ..Q:J>D
59 ..I $P(^AUPNMCD(I,11,J,0),U,2)]"",$P(^(0),U,2)<D Q
60 ..S Y=1
61 ..Q
62 .Q
63 ;
64MCDX ;
65 Q Y
66 ;
67 ;----------
68 ; MCDPN: Input - P = DFN
69 ; D = Date
70 ; F = Form for output of plan (Insurer) name.
71 ; If F = "E", return external form, else pointer to INSURER file.
72 ; Output - Literal = Cleartext name of insurer.
73 ; Number = Pointer to INSURER file.
74 ;
75 ; Examples: I $$MCDPN^AUPNPAT(DFN,2930701)
76 ; S AGMCDPN=$$MCDPN^AUPNPAT(DFN,DT,"E")
77 ;
78MCDPN(P,D,F) ;EP - return medicaid plan name for patient P on date D in form F.
79 ; I = IEN
80 ; J = Node 11 IEN
81 I '$G(P) Q ""
82 I '$G(D) Q ""
83 S F=$G(F)
84 NEW I,J,Y
85 S Y="",U="^"
86 I '$D(^DPT(P,0)) G MCDPNX
87 I $P(^DPT(P,0),U,19) G MCDPNX
88 I '$D(^AUPNPAT(P,0)) G MCDPNX
89 I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G MCDPNX
90 S I=0
91 F S I=$O(^AUPNMCD("B",P,I)) Q:I'=+I D
92 . Q:'$D(^AUPNMCD(I,11))
93 . S J=0
94 . F S J=$O(^AUPNMCD(I,11,J)) Q:J'=+J D
95 .. Q:J>D
96 .. I $P(^AUPNMCD(I,11,J,0),U,2)]"",$P(^(0),U,2)<D Q
97 .. S Y=$P(^AUPNMCD(I,0),U,10)
98 .. I Y]"" S Y=$S(F="E":$P(^AUTNINS(Y,0),U),1:Y)
99 ..Q
100 .Q
101 ;
102MCDPNX ;
103 Q Y
104 ;
105 ;----------
106 ; PI: Input - P = DFN
107 ; D = Date
108 ; Output - 1 = Yes, patient is/was PI eligible on date D.
109 ; 0 = No, or unable.
110 ;
111 ; Examples: I $$PI^AUPNPAT(DFN,2930701)
112 ; S AGPI=$$PI^AUPNPAT(DFN,DT)
113 ;
114PI(P,D) ;EP - Is patient P private insurance eligible on date D. 1= yes, 0=no.
115 ; I = IEN
116 ; Y = 1:yes, 0:no
117 ; X = Pointer to INSURER file.
118 I '$G(P) Q 0
119 I '$G(D) Q 0
120 NEW I,Y,X
121 S Y=0,U="^"
122 I '$D(^DPT(P,0)) G PIX
123 I $P(^DPT(P,0),U,19) G PIX
124 I '$D(^AUPNPAT(P,0)) G PIX
125 I '$D(^AUPNPRVT(P,11)) G PIX
126 I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G PIX
127 S I=0
128 F S I=$O(^AUPNPRVT(P,11,I)) Q:I'=+I D
129 . Q:$P(^AUPNPRVT(P,11,I,0),U)=""
130 . S X=$P(^AUPNPRVT(P,11,I,0),U) Q:X=""
131 . Q:$P(^AUTNINS(X,0),U)["AHCCCS"
132 . Q:$P(^AUPNPRVT(P,11,I,0),U,6)>D
133 . I $P(^AUPNPRVT(P,11,I,0),U,7)]"",$P(^(0),U,7)<D Q
134 . S Y=1
135 .Q
136PIX ;
137 Q Y
138 ;
139 ;----------
140 ; PIN: Input - P = DFN
141 ; D = Date
142 ; F = Form for output of plan (Insurer) name.
143 ; If F = "E", return external form, else pointer to INSURER file.
144 ; Output - Literal = Cleartext name of insurer.
145 ; Number = Pointer to INSURER file.
146 ;
147 ; Examples: I $$PIN^AUPNPAT(DFN,2930701)
148 ; S AGPIN=$$PIN^AUPNPAT(DFN,DT,"E")
149 ;
150PIN(P,D,F) ;EP - return private insurer name for patient P on date D in form F
151 ; I = IEN
152 I '$G(P) Q 0
153 I '$G(D) Q 0
154 NEW I,Y,J
155 S F=$G(F)
156 S Y="",U="^",J=""
157 I '$D(^DPT(P,0)) G PINX
158 I $P(^DPT(P,0),U,19) G PINX
159 I '$D(^AUPNPAT(P,0)) G PINX
160 I '$D(^AUPNPRVT(P,11)) G PINX
161 I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G PINX
162 S I=0
163 F S I=$O(^AUPNPRVT(P,11,I)) Q:I'=+I D
164 . Q:$P(^AUPNPRVT(P,11,I,0),U)=""
165 . S Y=$P(^AUPNPRVT(P,11,I,0),U)
166 . I $P(^AUTNINS(Y,0),U)["AHCCCS" Q
167 . I $P(^AUPNPRVT(P,11,I,0),U,6)>D Q
168 . I $P(^AUPNPRVT(P,11,I,0),U,7)]"",$P(^(0),U,7)<D Q
169 . S J=$S(F="E":$P(^AUTNINS(Y,0),U),1:Y)
170 .Q
171PINX ;
172 Q J
173 ;
174 ;Begin New Code;IHS/SET/GTH AUPN*99.1*8 10/04/2002
175RRE(P,D) ;EP - Does pt have Railroad insurance on date? 1 = yes, 0 = no.
176 ; I = IEN in ^AUPNRRE multiple.
177 I '$G(P) Q 0
178 I '$G(D) Q 0
179 NEW I,Y
180 S Y=0,U="^"
181 I '$D(^DPT(P,0)) Q 0
182 I $P($G(^DPT(P,0)),U,19) Q 0
183 I '$D(^AUPNPAT(P,0)) Q 0
184 I '$D(^AUPNRRE(P,11)) Q 0
185 I $D(^DPT(P,.35)),$P(^DPT(P,.35),U)]"",$P($G(^DPT(P,.35)),U)<D Q 0
186 S I=0
187 F S I=$O(^AUPNRRE(P,11,I)) Q:I'=+I D
188 . Q:$P(^AUPNRRE(P,11,I,0),U)>D
189 . I $P($G(^AUPNRRE(P,11,I,0)),U,2)]"",$P($G(^AUPNRRE(P,11,I,0)),U,2)<D Q
190 . S Y=1
191 .Q
192RREX ;
193 Q Y
194 ;
195 ;End New Code;IHS/SET/GTH AUPN*99.1*8 10/04/2002
Note: See TracBrowser for help on using the repository browser.