source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCDXUTL0.m@ 642

Last change on this file since 642 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.4 KB
Line 
1SCDXUTL0 ;ALB/ESD - Generic functions for Amb Care HL7 Interface ; 5/31/05 11:23am
2 ;;5.3;Scheduling;**44,55,69,77,85,110,122,94,66,132,180,235,256,258,325,451**;Aug 13, 1993
3 ;
4 ; This routine contains functions used with the Ambulatory Care
5 ; Reporting Project (ACRP).
6 ;
7MTI(DFN,DATE,EC,AT,SDOE) ;Calculate Means Test Indicator
8 ;
9 ; Input: DFN = Patient IEN
10 ; Date = Encounter Date/Time
11 ; EC = Eligibility (Code) of Encounter
12 ; AT = Appointment Type of Encounter
13 ; SDOE = Outpatient Encounter IEN
14 ;
15 ; Output: MTI = Means Test Indicator
16 ;
17 N MT,MTI,SDVD1,SDINPT,SDANS,SDANS1,SDINPT,SDMT,VET,X
18 S MTI=""
19 S DFN=$G(DFN),DATE=$G(DATE),EC=$G(EC),AT=$G(AT),SDOE=$G(SDOE)
20 I (DFN="")!(DATE="")!(EC="")!(EC=0)!(AT="")!(SDOE="") G MTQ
21 ;
22 ;- VA Code (get from MAS Eligibility Code IEN)
23 S X=$G(^DIC(8.1,$P($G(^DIC(8,+EC,0)),"^",9),0))
24 S EC=$P(X,"^",4),VET=$P(X,"^",5)
25 ;- Non-Veteran
26 I $P($G(^DPT(DFN,"VET")),"^")="N"!(VET="N") S MTI="N" G MTQ
27 ;- Dom patient
28 I EC=6 S MTI="X" G MTQ
29 ;- Inpatient status
30 S SDVD1=DATE D INPT^SDOPC1 I SDMT="X0" S MTI="X" G MTQ
31 ;- Service Connected > 50 %
32 I EC=1 S MTI="AS" G MTQ
33 ;-- Service Connected < 50 %
34 I EC=3,$$SC^DGMTR(DFN) D I MTI'="" G MTQ
35 .; 'AS' if seen for SC condition
36 .I $P($G(^SDD(409.42,+$O(^SDD(409.42,"AO",+SDOE,3,0)),0)),U,3) S MTI="AS"
37 ;-Military Disability Retiree
38 ;S X=$P($G(^DPT(DFN,.36)),"^",2) I X,(X<3) S MTI="AS" G MTQ
39 ;-Military Disability Retirement OR Discharge Due To Disability
40 I $P($G(^DPT(DFN,.36)),"^",12)!($P($G(^DPT(DFN,.36)),"^",13)) S MTI="AS" G MTQ
41 ;
42 I EC=2 D I MTI'="" G MTQ
43 .;- Mexican Border Period or World War I
44 .I $P($G(^DIC(21,+$P($G(^DPT(DFN,.32)),"^",3),0)),"^",3)=1!($P($G(^DIC(21,+$P($G(^DPT(DFN,.32)),"^",3),0)),"^",3)=3) S MTI="AS" Q
45 .;- Prisoner of War (POW)
46 .I $P($G(^DPT(DFN,.52)),"^",5)="Y" S MTI="AS" Q
47 .;- Purple Heart Recipient
48 .I $P($G(^DPT(DFN,.53)),"^")="Y" S MTI="AS" Q
49 .;- Aid and Attendance
50 .I $P($G(^DPT(DFN,.362)),"^",12)="Y" S MTI="AN" Q
51 .;- Housebound
52 .I $P($G(^DPT(DFN,.362)),"^",13)="Y" S MTI="AN" Q
53 ;- Receiving VA Pension
54 I EC=4,$P($G(^DPT(DFN,.362)),"^",14)="Y" S MTI="AN" G MTQ
55 ;
56 I EC=5!(EC=3) D I MTI'="" G MTQ
57 .;- Eligible for Medicaid
58 .I $P($G(^DPT(DFN,.38)),"^")=1 S MTI="AN" Q
59 .;- Appt types with ignore billing set to 1 (except comp gen)
60 .I AT'=10,$P($G(^SD(409.1,+AT,0)),"^",2) S MTI="X" Q
61 .;- Treatment for AO, IR, EC, MST, HNC
62 .F SDANS1=1,2,4,5,6 S SDANS=$S('$D(^SDD(409.42,"AO",+SDOE,SDANS1)):"",$P($G(^SDD(409.42,$O(^(SDANS1,0)),0)),"^",3):1,1:0) I SDANS=1 S MTI="AS" Q
63 .I MTI]"" Q
64 .;- Means Test Code A, C, or G (also Pending Adj = Code C or Code G)
65 .S MT=$$LST^DGMTU(DFN,DATE)
66 .I $P(MT,"^",4)="A" S MTI="AN" Q
67 .I $P(MT,"^",4)="C" S MTI="C" Q
68 .I $P(MT,"^",4)="G" S MTI="G" Q
69 .I $P(MT,"^",4)="P" D Q
70 . .S MTI=$$PA^DGMTUTL($P(MT,"^")),MTI=$S('$D(MTI):"U",MTI="MT":"C",MTI="GMT":"G",1:"U")
71 .;- no means test status or no longer required...check current eligibility data
72 .S X=+$G(^DPT(DFN,.36)),X=+$P($G(^DIC(8,X,0)),U,9) ; get MAS eligibility
73 .;- Service connected > 50 %
74 .I X=1 S MTI="AS" Q
75 .;- Service connected < 50 %
76 .I EC=3,'$$SC^DGMTR(DFN) S MTI="AS" Q
77 .;- mex border or WWI or POW
78 .I X=16!(X=17)!(X=18)!(X=22) S MTI="AS" Q
79 .;- A&A or Pension or HB
80 .I X=2!(X=4)!(X=15) S MTI="AN" Q
81 ;- Means Test required and not done/completed
82 S MTI="U"
83MTQ Q MTI
84 ;
85 ;
86PATCLASS(DFN,SDOE) ; - Return classification questions from PATIENT (#2) file
87 ; (Agent Orange, Radiation Exposure, Service Connected,
88 ; Environmental Contaminants, Military Sexual Trauma and
89 ; Head/Neck Cancer questions)
90 ;
91 ; Input: DFN = Patient IEN (from file #2)
92 ; SDOE = Outpatient Encounter File IEN [Optional]
93 ;
94 ; Output: String containing Y if classification question = YES, N if
95 ; = NO, null otherwise (classifications separated by "^")
96 ;
97 N NODE,PATCLASS,SDTEMP,X
98 S SDTEMP(1)=$$AO^SDCO22(DFN,$G(SDOE))
99 S SDTEMP(2)=$$IR^SDCO22(DFN,$G(SDOE))
100 S SDTEMP(3)=$$SC^SDCO22(DFN,$G(SDOE))
101 S SDTEMP(4)=$$EC^SDCO22(DFN,$G(SDOE))
102 S SDTEMP(5)=$$MST^SDCO22(DFN,$G(SDOE))
103 S SDTEMP(6)=$$HNC^SDCO22(DFN,$G(SDOE))
104 S SDTEMP(7)=$$CV^SDCO22(DFN,$G(SDOE))
105 F X=1:1:7 S $P(PATCLASS,U,X)=$S(SDTEMP(X)=1:"Y",1:"N")
106 Q PATCLASS
107 ;
108 ;
109CLASS(SDOE,SCDXARRY) ; - Return array of classification types for encounter
110 ;
111 ; Input: SDOE = Outpatient Encounter IEN (from file #409.68)
112 ;
113 ; Output: Array (pass desired name as parameter) containing
114 ; Classification Type^Value
115 ;
116 N CLASS,I,X
117 S CLASS="",(I,X)=0
118 S SDOE=+$G(SDOE)
119 F S CLASS=+$O(^SDD(409.42,"OE",SDOE,CLASS)) Q:'CLASS D
120 . S I=$P($G(^SDD(409.42,CLASS,0)),"^"),X=X+1
121 . S @SCDXARRY@(I)=$P($G(^SDD(409.42,CLASS,0)),"^")_"^"_$P($G(^SDD(409.42,CLASS,0)),"^",3)
122CLASSQ S @SCDXARRY@(0)=X
123 Q
124 ;
125 ;
126CHKCLASS(DFN,SDOE) ; - Get classification data for HL7 VAFHLZCL segment
127 ;
128 ; Input: DFN = Patient IEN (from file #2)
129 ; SDOE = Outpatient Encounter IEN (from file #409.68)
130 ;
131 ; Output: String separated by "^" containing:
132 ; 1 (patient class = YES and encounter class = YES)
133 ; 0 (patient class = YES and encounter class = NO)
134 ; HLQ ("""""") otherwise
135 ;
136EN N OECLASS,OUT,PATCLASS,TYPE,ENCVAL,CLCNT,PATVAL
137 S PATCLASS=$$PATCLASS(DFN,SDOE)
138 D CLASS(SDOE,"OECLASS")
139 S CLCNT=$L(PATCLASS,"^")
140 F TYPE=1:1:CLCNT D
141 .S ENCVAL=$P($G(OECLASS(TYPE)),"^",2)
142 .S PATVAL=$P(PATCLASS,"^",TYPE)
143 .S $P(OUT,"^",TYPE)=""""""
144 .I PATVAL="Y" S $P(OUT,"^",TYPE)=ENCVAL
145ENQ Q OUT
146 ;
147 ;
148POV(DFN,DATE,CLINIC,APTYP) ; - Determine Purpose of Visit for encounter
149 ;
150 ; Input: DFN = Patient IEN
151 ; DATE = Appointment Date/Time
152 ; CLINIC = Clinic
153 ; APTYP = Appointment Type
154 ;
155 ; Output: Purpose of Visit value (combination of Purpose of Visit
156 ; and Appointment Type)
157 ;
158 N POV,SCDXPOV
159 I (DFN=""!(DATE="")!(CLINIC="")!(APTYP="")) G POVQ
160 I $P($G(^DPT(DFN,"S",+DATE,0)),"^")'=CLINIC G POVQ
161 S POV=$P($G(^DPT(DFN,"S",+DATE,0)),"^",7),POV=$S($L(POV)=1:"0"_POV,1:POV)
162 S APTYP=$S($L(APTYP)=1:"0"_APTYP,1:APTYP)
163 S SCDXPOV=POV_APTYP
164POVQ Q $G(SCDXPOV)
165 ;
166 ;
167SCODE(SDOE,SCDXARRY) ; Return array of stop codes for encounter
168 ;
169 ; Input: SDOE = Outpatient Encounter IEN (from file #409.68)
170 ;
171 ; Output: Array (pass desired name as parameter) containing
172 ; stop codes
173 ;
174 ;
175 N CNT,I,SDOE0,SDOEC,SDOEC0
176 S CNT=1,(I,SDOEC)=0
177 S SDOE=+$G(SDOE)
178 I '$D(^SCE(SDOE,0)) G SCODEQ
179 I '$P($G(^SCE(SDOE,0)),"^",3) G SCODEQ
180 S SDOE0=$G(^SCE(SDOE,0))
181 ;
182 ;- Get stop code from parent encounter
183 I $P(SDOE0,"^",3) S @SCDXARRY@(CNT)=$P(SDOE0,"^",3),I=CNT
184 ;
185 ;- Get stop code from child encounter (credit stop)
186 F S SDOEC=+$O(^SCE("APAR",SDOE,SDOEC)) Q:('SDOEC)!(CNT=2) D
187 . S SDOEC0=$G(^SCE(SDOEC,0))
188 . I $P(SDOEC0,"^",3),($P(SDOEC0,"^",8)=4) D
189 .. S CNT=CNT+1,I=CNT
190 .. S @SCDXARRY@(CNT)=$P(SDOEC0,"^",3)
191SCODEQ S @SCDXARRY@(0)=I
192 Q
193 ;
194 ;
195PROC(SDOE,SCDXARRY) ; Return array of procedures for encounter
196 ;
197 ;
198 ; Input: SDOE = Outpatient Encounter IEN (from file #409.68)
199 ;
200 ; Output: Array (pass desired name as parameter) containing
201 ; procedures
202 ;
203 N CNT
204 S CNT=0,SDOE=+$G(SDOE)
205 I '$D(^SCE(SDOE,0)) G PROCQ
206 ;
207 D GETPROC(.CNT,SDOE,SCDXARRY) G PROCQ
208 ;
209 ;- Array of procedures
210PROCQ S @SCDXARRY@(0)=CNT
211 Q
212 ;
213 ;
214GETPROC(CNT,ENC,SCDXARRY) ;Get procedures from Scheduling Visits file
215 ;
216 N CPTS,VCPT
217 D GETCPT^SDOE(ENC,"CPTS")
218 N CPT,QTY,I
219 S VCPT=0
220 F S VCPT=$O(CPTS(VCPT)) Q:'VCPT D
221 . S CPT=$G(CPTS(VCPT))
222 . S QTY=+$P(CPT,U,16)
223 . F I=1:1:QTY S CNT=CNT+1,@SCDXARRY@(CNT)=+CPT
224 Q
Note: See TracBrowser for help on using the repository browser.