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

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

Now adds allergies
File size: 14.1 KB
Line 
1C0XPT0 ; VEN/SMH - Get patient data and do something about it ;2013-02-06 3:08 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^XLFSTR(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
211 ;
212NP() ; New Person Entry
213 N C0XFDA,C0XIEN,C0XERR
214 S C0XFDA(200,"?+1,",.01)="PROVIDER,UNKNOWN SMART" ; Name
215 S C0XFDA(200,"?+1,",1)="USP" ; Initials
216 S C0XFDA(200,"?+1,",28)="SMART" ; Mail Code
217 ;
218 N DIC S DIC(0)="" ; An XREF in File 200 requires this.
219 D UPDATE^DIE("E",$NA(C0XFDA),$NA(C0XIEN),$NA(C0XERR)) ; Typical UPDATE
220 Q C0XIEN(1) ;Provider IEN
221 ;
222PROBADD(DFN,CODE,TEXT,EXPIEN,STARTDT) ; Add a problem to a patient's record.
223 ; Input
224 ; DFN - you know what that is
225 ; CODE - SNOMED code; not used alas; for the future.
226 ; TEXT - SNOMED Text
227 ; EXPIEN - IEN of Snomed CT Expression in the Expressions File (757.01)
228 ; STARTDT - Internal Date of when the problem was first noted.
229 ;
230 ; Output:
231 ; NONE
232 ; Crash expected if code fails to add a problem.
233 ;
234 ;
235 ;
236 N GMPDFN S GMPDFN=DFN ; patient dfn
237 ;
238 ; Add unknown provider to database
239 N GMPPROV S GMPPROV=$$NP^C0XPT0() ;Smart Provider IEN
240 ;
241 N GMPVAMC S GMPVAMC=$$KSP^XUPARAM("INST") ; Problem Institution. Ideally, the external one. But we are taking a shortcut here.
242 ;
243 N GMPFLD ; Input array
244 S GMPFLD(".01")="" ;Code IEN - API will assign 799.9.
245 ; .02 field (Patient IEN) not used. Pass variable GMPDFN instead.
246 S GMPFLD(".03")=DT ;Date Last Modified
247 S GMPFLD(".05")="^"_TEXT ;Expression text
248 S GMPFLD(".08")=DT ; today's date (entry?)
249 S GMPFLD(".12")="A" ;Active/Inactive
250 S GMPFLD(".13")=STARTDT ;Onset date
251 S GMPFLD("1.01")=EXPIEN_U_TEXT ;^LEX(757.01 ien,descip
252 S GMPFLD("1.03")=GMPPROV ;Entered by
253 S GMPFLD("1.04")=GMPPROV ;Recording provider
254 S GMPFLD("1.05")=GMPPROV ;Responsible provider
255 S GMPFLD("1.06")="" ; SERVICE FILE - LEAVE BLANK(#49)
256 S GMPFLD("1.07")="" ; Date resolved
257 S GMPFLD("1.08")="" ; Clinic (#44)
258 S GMPFLD("1.09")=DT ;entry date
259 S GMPFLD("1.1")=0 ;Service Connected
260 S GMPFLD("1.11")=0 ;Agent Orange exposure
261 S GMPFLD("1.12")=0 ;Ionizing radiation exposure
262 S GMPFLD("1.13")=0 ;Persian Gulf exposure
263 S GMPFLD("1.14")="C" ;Accute/Chronic (A,C)
264 S GMPFLD("1.15")="" ;Head/neck cancer
265 S GMPFLD("1.16")="" ;Military sexual trauma
266 S GMPFLD("10",0)=0 ; Note. No note.
267 ;
268 ;
269 N DA ; Return variable
270 D NEW^GMPLSAVE ; API call
271 I '$D(DA) S $EC=",U1," ; Fail here if API fails.
272 QUIT
273 ;
274 ;
275ADR(G,DFN) ; Private Proc; Extract Allergies and ADRs from Graph and add to Patient's Record
276 ; Input: G, Patient Graph, DFN, you should know that that is; Both by value.
277 ;
278 ; Try No known allergies first.
279 N NKA S NKA=$$ONETYPE1^C0XGET3(G,"sp:AllergyExclusion") ; Get NKA node
280 ;
281 ; Add allergies to record.
282 ; We don't really care about the return value. If patient already has
283 ; allergies, we just keep them.
284 I $L(NKA) N % S %=$$NKA^C0XPT0(DFN) QUIT ; If it exists, let's try to file it into VISTA
285 ;
286 ; If we are here, it means that the patient has allergies. Fun!
287 ; Process incoming allergies
288 N RETURN ; Local return variable. I don't expect a patient to have more than 50 allergies.
289 D ONETYPE^C0XGET3($NA(RETURN),G,"sp:Allergy") ; Get all allergies for patient
290 ;
291 N S F S=0:0 S S=$O(RETURN(S)) Q:'S D ; For each allergy
292 . ; Get the SNOMED code for the category
293 . N ALLERGYTYPE
294 . N SNOCAT S SNOCAT=$$GSPO1^C0XGET3(G,RETURN(S),"sp:category.sp:code"),SNOCAT=$P(SNOCAT,"/",$L(SNOCAT,"/"))
295 . I SNOCAT=414285001 S ALLERGYTYPE="F" ; Food
296 . E I SNOCAT=416098002 S ALLERGYTYPE="D" ; Drug
297 . I '$D(ALLERGYTYPE) S $EC=",U1," ; Crash if neither of these is true.
298 . ;
299 . N ALLERGEN,ALLERGENI ; Allergen, Internal Allergen
300 . I ALLERGYTYPE="F" D ; Food
301 . . S ALLERGEN=$$UP^XLFSTR($$GSPO1^C0XGET3(G,RETURN(S),"sp:otherAllergen.dcterms:title")) ; uppercase the allergen
302 . . I ALLERGEN="PEANUT" S ALLERGEN="PEANUTS" ; TODO: temporary fix
303 . . S ALLERGENI=$$GMRA^C0XPT0(ALLERGEN) ; Get internal representation for GMRA call
304 . ;
305 . ; Otherwise, it's a drug. But we need to find out if it's a class,
306 . ; ingredient, canonical drug, etc. Unfortunately, Smart examples don't
307 . ; show such variety. The only one specified is a drug class.
308 . ; Therefore
309 . ; TODO: Handle other drug items besides drug class
310 . ;
311 . E D ; Drug
312 . . N DC S DC=$$GSPO1^C0XGET3(G,RETURN(S),"sp:drugClassAllergen.sp:code") ; drug class
313 . . I '$L(DC) QUIT ; edit this line out when handling other items
314 . . S ALLERGEN=$P(DC,"/",$L(DC,"/")) ; Get last piece
315 . . ; TODO: Resolve drug class properly. Need all of RxNorm for that.
316 . . N STR S STR=$$UP^XLFSTR($$GSPO1^C0XGET3(G,RETURN(S),"sp:drugClassAllergen.dcterms:title"))
317 . . I ALLERGEN="N0000175503" S ALLERGENI=STR_U_"23;PS(50.605," ; hard codeded for sulfonamides
318 . . ;
319 . ; DEBUG.ASSERT THAT allergen Internal isn't empty
320 . I '$L(ALLERGENI) S $EC=",U1,"
321 . ;
322 . ; Get Severity (Mild or Severe) - We get free text rather than SNOMED
323 . N SEVERITY S SEVERITY=$$UP^XLFSTR($$GSPO1^C0XGET3(G,RETURN(S),"sp:severity.dcterms:title"))
324 . I '$L(SEVERITY) S $EC=",U1,"
325 . ;
326 . ; Get Reaction - We get free text rather than SNOMED
327 . N REACTION S REACTION=$$UP^XLFSTR($$GSPO1^C0XGET3(G,RETURN(S),"sp:allergicReaction.dcterms:title"))
328 . I '$L(REACTION) S $EC=",U1,"
329 . ;
330 . ; Now that we have determined the allergy, add it
331 . D FILEADR^C0XPT0(DFN,ALLERGENI,REACTION,SEVERITY,ALLERGYTYPE) ; Internal API
332 QUIT
333 ;
334NKA(DFN) ; Public $$; Add no known allergies to patient record
335 N ORDFN S ORDFN=DFN ; CPRS API requires this one
336 N ORY ; Return value: 0 - Everything is okay; -1^msg: Patient already has allergies
337 D NKA^GMRAGUI1 ; API
338 QUIT $G(ORY) ; Not always returned
339 ;
340GMRA(NAME) ; $$ Private - Retrieve GMRAGNT for food allergy from 120.82
341 ; Input: Brand Name, By Value
342 ; Output: Entry Name^IEN;File Root for IEN
343 N C0PIEN S C0PIEN=$$FIND1^DIC(120.82,"","O",NAME,"B")
344 Q:C0PIEN $$GET1^DIQ(120.82,C0PIEN,.01)_"^"_C0PIEN_";GMRD(120.82,"
345 QUIT "" ; no match otherwise
346 ;
347TYPE(GMRAGNT) ; $$ Private - Get allergy Type (Drug, food, or other)
348 ; Input: Allergen, formatted as Allergen^IEN;File Root
349 ; Output: Type (internal)^Type (external) e.g. D^Drug
350 N C0PIEN S C0PIEN=+$P(GMRAGNT,U,2)
351 I GMRAGNT["GMRD(120.82," Q $$GET1^DIQ(120.82,C0PIEN,"ALLERGY TYPE","I")_U_$$GET1^DIQ(120.82,C0PIEN,"ALLERGY TYPE","E")
352 Q "D^Drug" ; otherwise, it's a drug
353 ;
354FILEADR(DFN,AGENT,REACTION,SEVERITY,TYPE) ; Private Proc - File Drug Reaction
355 N C0XRXN
356 S C0XRXN("GMRAGNT")=AGENT ; Agent^Agent in variable pointer format
357 S C0XRXN("GMRATYPE")=TYPE ; F(ood), D(rug), or O(ther) or combination.
358 S C0XRXN("GMRANATR")="U^Unknown" ; Allergic, Pharmacologic, or Unknown
359 S C0XRXN("GMRAORIG")=$$NP^C0XPT0 ; New Person generated for SMART
360 ; S C0XRXN("GMRACHT",0)=1 ; Mark Chart as allergy document - commented out b/c depends on Paper Docs
361 ; S C0XRXN("GMRACHT",1)=$$NOW^XLFDT ; Chart documentation date - commented out depends on Paper Docs
362 S C0XRXN("GMRAORDT")=$$NOW^XLFDT
363 S C0XRXN("GMRAOBHX")="h^HISTORICAL"
364 S C0XRXN("GMRACMTS",0)=1 ; Comments
365 S C0XRXN("GMRACMTS",1)=SEVERITY ; Store severity in the comments
366 N ORY ; Return value 0: success; -1: failure; discarded.
367 D UPDATE^GMRAGUI1("",DFN,$NA(C0XRXN))
368 QUIT
Note: See TracBrowser for help on using the repository browser.