source: fmts/trunk/p/C0XPT0.m@ 1604

Last change on this file since 1604 was 1604, checked in by Sam Habiel, 11 years ago

Further work on importing patients. Now implementing allergies. Implemented relational navigation for predicate in C0XGET3
File size: 12.4 KB
Line 
1C0XPT0 ; VEN/SMH - Get patient data and do something about it ;2013-02-04 3:41 PM
2 ;;1.1;FILEMAN TRIPLE STORE;;
3 ;
4 ; Get all graphs
5 NEW RETURN
6 DO GRAPHS^C0XGET1(.RETURN) ; TODO: Return could be a global due to large data.
7 N I S I="" F S I=$O(RETURN(I)) Q:I="" D ; For each IEN
8 . N G S G="" F S G=$O(RETURN(I,G)) Q:G="" D ; For each graph tied to IEN
9 . . D PROGRAPH(G) ; Process Graph
10 QUIT
11 ;
12PROGRAPH(G) ; Process Graph (i.e. Patient)
13 NEW RETURN
14 N DEM S DEM=$$ONETYPE1^C0XGET3(G,"sp:Demographics")
15 I DEM="" QUIT
16 ;
17 ; PARAM("NAME")=NAME (last name minimal; recommend full name)
18 ; PARAM("GENDER")=SEX
19 ; PARAM("DOB")=DATE OF BIRTH
20 ; PARAM("MRN")=MEDICAL RECORD NUMBER
21 ;
22 NEW PARAM
23 SET PARAM("NAME")=$$NAME(DEM)
24 SET PARAM("GENDER")=$$SEX(DEM)
25 SET PARAM("DOB")=$$DOB(DEM)
26 SET PARAM("MRN")=$$MRN(DEM)
27 NEW RETURN
28 D ADDPT(.RETURN,.PARAM)
29 N DFN S DFN=$P(RETURN(1),U,2)
30 I DFN<1 S $EC=",U1," ; Debug.Assert that patient is added.
31 ; D VITALS(G,DFN)
32 D PROBLEMS(G,DFN)
33 D ADR(G,DFN) ; Adverse Drug Reactions
34 ;
35 QUIT
36 ;
37NAME(DEMID) ; Public $$; Return VISTA name given the Demographics node ID.
38 ;
39 IF '$DATA(DEMID) SET $EC=",U1," ; Must pass this in.
40 ;
41 ; Get name node
42 NEW NAMENODE SET NAMENODE=$$object^C0XGET1(DEMID,"v:n")
43 IF '$L(NAMENODE) SET $EC=",U1," ; Not supposed to happen.
44 ;
45 ; Get Last name
46 NEW FAMILY SET FAMILY=$$object^C0XGET1(NAMENODE,"v:family-name")
47 IF '$L(FAMILY) SET $EC=",U1," ; Not supposed to happen
48 ;
49 ; Get First name
50 NEW GIVEN SET GIVEN=$$object^C0XGET1(NAMENODE,"v:given-name")
51 IF '$L(GIVEN) SET $EC=",U1," ; ditto
52 ;
53 ; Get Additional name (?Middle?)
54 NEW MIDDLE SET MIDDLE=$$object^C0XGET1(NAMENODE,"v:additional-name")
55 ; This is optional of course
56 ;
57 QUIT $$UP^DILIBF(FAMILY_","_GIVEN_" "_MIDDLE)
58 ;
59 ;
60DOB(DEMID) ; Public $$; Return Timson Date for DOB given the Dem node ID.
61 ;
62 IF '$DATA(DEMID) SET $EC=",U1," ; Must pass this in.
63 ;
64 ; Get DOB.
65 NEW DOB S DOB=$$object^C0XGET1(DEMID,"v:bday")
66 IF '$L(DOB) SET $EC=",U1," ; ditto
67 ;
68 ; Convert to Timson Date using %DT
69 N X,Y,%DT
70 S X=DOB
71 D ^%DT
72 QUIT Y
73 ;
74 ;
75SEX(DEMID) ; Public $$; Return Sex M or F given the demographics node ID.
76 ;
77 IF '$DATA(DEMID) SET $EC=",U1," ; Must pass this in.
78 ;
79 ; Get "gender"
80 NEW SEX S SEX=$$object^C0XGET1(DEMID,"foaf:gender")
81 IF '$L(SEX) SET $EC=",U1," ; ditto
82 ;
83 ; Convert to internal value
84 N SEXABBR ; Sex Abbreviation
85 D CHK^DIE(2,.02,,SEX,.SEXABBR) ; Check value and convert to internal
86 ;
87 IF SEXABBR="^" QUIT "F" ; Unknown sexes will be female (Sam sez so)
88 ELSE QUIT SEXABBR
89 ;
90 ;
91MRN(DEMID) ; Public $$; Return the Medical Record Number given node ID.
92 ;
93 IF '$DATA(DEMID) SET $EC=",U1," ; Must pass this in.
94 ;
95 ; Get subject node, then the identifer under it.
96 NEW MRNNODE S MRNNODE=$$object^C0XGET1(DEMID,"sp:medicalRecordNumber")
97 NEW MRN S MRN=$$object^C0XGET1(MRNNODE,"dcterms:identifier")
98 ;
99 ; If it doesn't exist, invent one
100 I '$L(MRN) S MRN=$R(928749018234)
101 QUIT MRN
102 ;
103ADDPT(RETURN,PARAM) ; Private Proc; Add Patient to VISTA.
104 ; Return RPC style return pass by reference. Pass empty.
105 ; PARAM passed by reference.
106 ; Required elements include:
107 ; PARAM("NAME")=NAME (last name minimal; recommend full name)
108 ; PARAM("GENDER")=SEX
109 ; PARAM("DOB")=DATE OF BIRTH
110 ; PARAM("MRN")=MEDICAL RECORD NUMBER
111 ;
112 ; Optional elements include:
113 ; PARAM("POBCTY")=PLACE OF BIRTH [CITY]
114 ; PARAM("POBST")=PLACE OF BIRTH [STATE]
115 ; PARAM("MMN")=MOTHER'S MAIDEN NAME
116 ; PARAM("ALIAS",#)=ALIAS NAME(last^first^middle^suffix)^ALIAS SSN
117 ;
118 ; These elements are calculated:
119 ; PARAM("PRFCLTY")=PREFERRED FACILITY
120 ; PARAM("SSN")=SOCIAL SECURITY NUMBER OR NULL IF NONE
121 ; PARAM("SRVCNCTD")=SERVICE CONNECTED?
122 ; PARAM("TYPE")=TYPE
123 ; PARAM("VET")=VETERAN (Y/N)?
124 ; PARAM("FULLICN")=INTEGRATION CONTROL NUMBER AND CHECKSUM
125 ;
126 ;CHECK THAT PATCH DG*5.3*800 is installed for routine VAFCPTAD to add pt.
127 I '$$PATCH^XPDUTL("DG*5.3*800") D EN^DDIOL("You need to have patch DG*5.3*800 to add patients") S $EC=",U1,"
128 ;
129 ; Crash if required params aren't present
130 N X F X="NAME","GENDER","DOB","MRN" S:'$D(PARAM(X)) $EC=",U1,"
131 ;
132 ; Calculate ICN and its checksum using MRN; then remove MRN.
133 S PARAM("FULLICN")=PARAM("MRN")_"V"_$$CHECKDG^MPIFSPC(PARAM("MRN"))
134 ;
135 ; Get Preferred Facility from this Facility's number.
136 S PARAM("PRFCLTY")=$P($$SITE^VASITE(),U,3) ; Must use Station number here for API.
137 I 'PARAM("PRFCLTY") S $EC=",U1," ; crash if Facility is not set-up properly.
138 ;
139 ; No SSN (for now)
140 S PARAM("SSN")=""
141 ;
142 ; Boiler plate stuff below:
143 ; TODO: This could be configurable in a File. WV uses "VISTA OFFICE EHR"
144 S PARAM("SRVCNCTD")="N"
145 S PARAM("TYPE")="NON-VETERAN (OTHER)"
146 S PARAM("VET")="N"
147 ;
148 ; Now for the finish. Add the patient to VISTA (but only adds it to 2 :-()
149 D ADD^VAFCPTAD(.RETURN,.PARAM)
150 ;
151 I +RETURN(1)=-1 S $EC=",U1," ; It failed.
152 E N PIEN S PIEN=$P(RETURN(1),U,2)
153 ;
154 ; Add to IHS Patient file using Laygo in case it's already there.
155 NEW C0XFDA
156 SET C0XFDA(9000001,"?+"_PIEN_",",.01)=PIEN
157 SET C0XFDA(9000001,"?+"_PIEN_",",.02)=DT
158 SET C0XFDA(9000001,"?+"_PIEN_",",.12)=DUZ ;logged in user IEN (e.g. "13")
159 SET C0XFDA(9000001,"?+"_PIEN_",",.16)=DT
160 DO UPDATE^DIE("",$NAME(C0XFDA))
161 I $D(^TMP("DIERR",$J)) S $EC=",U1,"
162 ;
163 ; Add medical record number.
164 NEW IENS S IENS="?+1,"_PIEN_","
165 NEW C0XFDA
166 SET C0XFDA(9000001.41,IENS,.01)=+$$SITE^VASITE() ; This time, the IEN of the primary site
167 SET C0XFDA(9000001.41,IENS,.02)=PARAM("MRN") ; Put Medical Record Number on Station Number
168 DO UPDATE^DIE("",$NAME(C0XFDA))
169 I $D(^TMP("DIERR",$J)) S $EC=",U1,"
170 QUIT
171 ;
172VITALS(G,DFN) ; Private EP; Process Vitals for a patient graph.
173 ; Vital Sign Sets
174 K ^TMP($J) ; Global variable. A patient can have 1000 vital sets.
175 D GOPS^C0XGET3($NA(^TMP($J,"VS")),G,"sp:VitalSignSet","rdf:type")
176 ;
177 ; For each Vital Sign Set, grab encounter
178 N S F S=0:0 S S=$O(^TMP($J,"VS",S)) Q:S="" D
179 . N ENC S ENC=$$GSPO1^C0XGET3(G,^TMP($J,"VS",S),"sp:encounter")
180 ;
181 ; D EN1^GMVDCSAV(.RESULT,DATA)
182 QUIT
183 ;
184PROBLEMS(G,DFN) ; Private EP; Process Problems for a patient graph
185 ; Delete existing problems if they are present
186 ; PS: This is a risky operation if somebody points to the original data.
187 ; PS2: Another idea is just to quit here if Patient has problems already.
188 I $D(^AUPNPROB("AC",DFN)) DO ; Patient already has problems.
189 . N DIK S DIK="^AUPNPROB(" ; Global to kill
190 . N DA F DA=0:0 S DA=$O(^AUPNPROB("AC",DFN,DA)) Q:'DA D ^DIK ; Kill each entry
191 ;
192 ; Process incoming problems
193 N RETURN ; Local return variable. I don't expect a patient to have more than 50 problems.
194 D ONETYPE^C0XGET3($NA(RETURN),G,"sp:Problem") ; Get all problems for patient
195 N S F S=0:0 S S=$O(RETURN(S)) Q:'S D ; For each problem
196 . N PROBNM S PROBNM=$$GSPO1^C0XGET3(G,RETURN(S),"sp:problemName") ; Snomed-CT coding info
197 . N CODEURL S CODEURL=$$GSPO1^C0XGET3(G,PROBNM,"sp:code") ; Snomed-CT Code URL
198 . N TEXT S TEXT=$$GSPO1^C0XGET3(G,PROBNM,"dcterms:title") ; Snomed-CT Code description
199 . ;
200 . N CODE ; Actual Snomed code rather than URL
201 . S CODE=$P(CODEURL,"/",$L(CODEURL,"/")) ; Get last / piece
202 . N EXPIEN ; IEN in the EXPESSION file
203 . N LEXS ; Return from Lex call
204 . D EN^LEXCODE(CODE) ; Lex API
205 . S EXPIEN=$P(LEXS("SCT",1),U) ; First match on Snomed CT. Crash if isn't present.
206 . ;
207 . N STARTDT S STARTDT=$$GSPO1^C0XGET3(G,RETURN(S),"sp:startDate") ; Start Date
208 . N X,Y,%DT S X=STARTDT D ^%DT S STARTDT=Y ; Convert STARTDT to internal format
209 . D PROBADD(DFN,CODE,TEXT,EXPIEN,STARTDT) ; Add problem to VISTA.
210 QUIT
211PROBADD(DFN,CODE,TEXT,EXPIEN,STARTDT) ; Add a problem to a patient's record.
212 ; Input
213 ; DFN - you know what that is
214 ; CODE - SNOMED code; not used alas; for the future.
215 ; TEXT - SNOMED Text
216 ; EXPIEN - IEN of Snomed CT Expression in the Expressions File (757.01)
217 ; STARTDT - Internal Date of when the problem was first noted.
218 ;
219 ; Output:
220 ; NONE
221 ; Crash expectd if code fails to add a problem.
222 ;
223 ;
224 ;
225 N GMPDFN S GMPDFN=DFN ; patient dfn
226 ;
227 ; Add unknown provider to database
228 N C0XFDA,C0XIEN,C0XERR
229 S C0XFDA(200,"?+1,",.01)="PROVIDER,UNKNOWN SMART" ; Name
230 S C0XFDA(200,"?+1,",1)="USP" ; Initials
231 S C0XFDA(200,"?+1,",28)="SMART" ; Mail Code
232 ;
233 N DIC S DIC(0)="" ; An XREF in File 200 requires this.
234 D UPDATE^DIE("E",$NA(C0XFDA),$NA(C0XIEN),$NA(C0XERR)) ; Typical UPDATE
235 N GMPPROV S GMPPROV=C0XIEN(1) ;Provider IEN
236 ;
237 N GMPVAMC S GMPVAMC=$$KSP^XUPARAM("INST") ; Problem Institution. Ideally, the external one. But we are taking a shortcut here.
238 ;
239 N GMPFLD ; Input array
240 S GMPFLD(".01")="" ;Code IEN - API will assign 799.9.
241 ; .02 field (Patient IEN) not used. Pass variable GMPDFN instead.
242 S GMPFLD(".03")=DT ;Date Last Modified
243 S GMPFLD(".05")="^"_TEXT ;Expression text
244 S GMPFLD(".08")=DT ; today's date (entry?)
245 S GMPFLD(".12")="A" ;Active/Inactive
246 S GMPFLD(".13")=STARTDT ;Onset date
247 S GMPFLD("1.01")=EXPIEN_U_TEXT ;^LEX(757.01 ien,descip
248 S GMPFLD("1.03")=GMPPROV ;Entered by
249 S GMPFLD("1.04")=GMPPROV ;Recording provider
250 S GMPFLD("1.05")=GMPPROV ;Responsible provider
251 S GMPFLD("1.06")="" ; SERVICE FILE - LEAVE BLANK(#49)
252 S GMPFLD("1.07")="" ; Date resolved
253 S GMPFLD("1.08")="" ; Clinic (#44)
254 S GMPFLD("1.09")=DT ;entry date
255 S GMPFLD("1.1")=0 ;Service Connected
256 S GMPFLD("1.11")=0 ;Agent Orange exposure
257 S GMPFLD("1.12")=0 ;Ionizing radiation exposure
258 S GMPFLD("1.13")=0 ;Persian Gulf exposure
259 S GMPFLD("1.14")="C" ;Accute/Chronic (A,C)
260 S GMPFLD("1.15")="" ;Head/neck cancer
261 S GMPFLD("1.16")="" ;Military sexual trauma
262 S GMPFLD("10",0)=0 ; Note. No note.
263 ;
264 ;
265 N DA ; Return variable
266 D NEW^GMPLSAVE ; API call
267 I '$D(DA) S $EC=",U1," ; Fail here if API fails.
268 QUIT
269 ;
270 ;
271ADR(G,DFN) ; Private Proc; Extract Allergies and ADRs from Graph and add to Patient's Record
272 ; Input: G, Patient Graph, DFN, you should know that that is; Both by value.
273 ;
274 ; Try No known allergies first.
275 N NKA S NKA=$$ONETYPE1^C0XGET3(G,"sp:AllergyExclusion") ; Get NKA node
276 ;
277 ; Add allergies to record.
278 ; We don't really care about the return value. If patient already has
279 ; allergies, we just keep them.
280 I $L(NKA) N % S %=$$NKA^C0XPT0(DFN) QUIT ; If it exists, let's try to file it into VISTA
281 ;
282 ; If we are here, it means that the patient has allergies. Fun!
283 ; Process incoming allergies
284 N RETURN ; Local return variable. I don't expect a patient to have more than 50 allergies.
285 D ONETYPE^C0XGET3($NA(RETURN),G,"sp:Allergy") ; Get all allergies for patient
286 ;
287 N S F S=0:0 S S=$O(RETURN(S)) Q:'S D ; For each allergy
288 . ; Get the SNOMED code for the category
289 . N ALLERGYTYPE
290 . N SNOCAT S SNOCAT=$$GSPO1^C0XGET3(G,RETURN(S),"sp:category.sp:code"),SNOCAT=$P(SNOCAT,"/",$L(SNOCAT,"/"))
291 . I SNOCAT=414285001 S ALLERGYTYPE="F" ; Food
292 . E I SNOCAT=416098002 S ALLERGYTYPE="D" ; Drug
293 . I '$D(ALLERGYTYPE) S $EC=",U1," ; Crash if neither of these is true.
294 . ;
295 . N ALLERGEN,ALLERGENI ; Allergen, Internal Allergen
296 . I ALLERGYTYPE="F" D ; Food
297 . . S ALLERGEN=$$UP^XLFSTR($$GSPO1^C0XGET3(G,RETURN(S),"sp:otherAllergen.dcterms:title")) ; uppercase the allergen
298 . . I ALLERGEN="PEANUT" S ALLERGEN="PEANUTS" ; temporary fix
299 . . S ALLERGENI=$$GMRA^C0XPT0(ALLERGEN) ; Get internal representation for GMRA call
300 . ;
301 . ; Otherwise, it's a drug. But we need to find out if it's a class,
302 . ; ingredient, canonical drug, etc. Unfortunately, Smart examples don't
303 . ; show such variety. The only one specified is a drug class.
304 . ; Therefore
305 . ; TODO: Handle other drug items besides drug class
306 . ;
307 . E D ; Drug
308 . . N DC S DC=$$GSPO1^C0XGET3(G,RETURN(S),"sp:drugClassAllergen.sp:code") ; drug class
309 . . I '$L(DC) QUIT ; edit this line out when handling other items
310 . . S ALLERGEN=$P(DC,"/",$L(DC,"/")) ; Get last piece
311 . . ; TODO: Resolve drug class properly. Need all of RxNorm for that.
312 . . I ALLERGEN="N0000175503"
313 QUIT
314 ;
315NKA(DFN) ; Public $$; Add no known allergies to patient record
316 N ORDFN S ORDFN=DFN ; CPRS API requires this one
317 N ORY ; Return value: 0 - Everything is okay; -1^msg: Patient already has allergies
318 D NKA^GMRAGUI1 ; API
319 QUIT $G(ORY) ; Not always returned
320 ;
321GMRA(NAME) ; $$ Private - Retrieve GMRAGNT for food allergy from 120.82
322 ; Input: Brand Name, By Value
323 ; Output: Entry Name^IEN;File Root for IEN
324 N C0PIEN S C0PIEN=$$FIND1^DIC(120.82,"","O",NAME,"B")
325 Q:C0PIEN $$GET1^DIQ(120.82,C0PIEN,.01)_"^"_C0PIEN_";GMRD(120.82,"
326 QUIT "" ; no match otherwise
327 ;
328TYPE(GMRAGNT) ; $$ Private - Get allergy Type (Drug, food, or other)
329 ; Input: Allergen, formatted as Allergen^IEN;File Root
330 ; Output: Type (internal)^Type (external) e.g. D^Drug
331 N C0PIEN S C0PIEN=+$P(GMRAGNT,U,2)
332 I GMRAGNT["GMRD(120.82," Q $$GET1^DIQ(120.82,C0PIEN,"ALLERGY TYPE","I")_U_$$GET1^DIQ(120.82,C0PIEN,"ALLERGY TYPE","E")
333 Q "D^Drug" ; otherwise, it's a drug
Note: See TracBrowser for help on using the repository browser.