1 | C0XPT0 ; VEN/SMH - Get patient data and do something about it ;2013-01-25 5:00 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 | ;
|
---|
12 | PROGRAPH(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 | ZWRITE RETURN
|
---|
30 | N DFN S DFN=$P(RETURN(1),U,2)
|
---|
31 | D VITALS(G,DFN)
|
---|
32 | D PROBLEMS(G,DFN)
|
---|
33 | ;
|
---|
34 | QUIT
|
---|
35 | ;
|
---|
36 | NAME(DEMID) ; Public $$; Return VISTA name given the Demographics node ID.
|
---|
37 | ;
|
---|
38 | IF '$DATA(DEMID) SET $EC=",U1," ; Must pass this in.
|
---|
39 | ;
|
---|
40 | ; Get name node
|
---|
41 | NEW NAMENODE SET NAMENODE=$$object^C0XGET1(DEMID,"v:n")
|
---|
42 | IF '$L(NAMENODE) SET $EC=",U1," ; Not supposed to happen.
|
---|
43 | ;
|
---|
44 | ; Get Last name
|
---|
45 | NEW FAMILY SET FAMILY=$$object^C0XGET1(NAMENODE,"v:family-name")
|
---|
46 | IF '$L(FAMILY) SET $EC=",U1," ; Not supposed to happen
|
---|
47 | ;
|
---|
48 | ; Get First name
|
---|
49 | NEW GIVEN SET GIVEN=$$object^C0XGET1(NAMENODE,"v:given-name")
|
---|
50 | IF '$L(GIVEN) SET $EC=",U1," ; ditto
|
---|
51 | ;
|
---|
52 | ; Get Additional name (?Middle?)
|
---|
53 | NEW MIDDLE SET MIDDLE=$$object^C0XGET1(NAMENODE,"v:additional-name")
|
---|
54 | ; This is optional of course
|
---|
55 | ;
|
---|
56 | QUIT $$UP^DILIBF(FAMILY_","_GIVEN_" "_MIDDLE)
|
---|
57 | ;
|
---|
58 | ;
|
---|
59 | DOB(DEMID) ; Public $$; Return Timson Date for DOB given the Dem node ID.
|
---|
60 | ;
|
---|
61 | IF '$DATA(DEMID) SET $EC=",U1," ; Must pass this in.
|
---|
62 | ;
|
---|
63 | ; Get DOB.
|
---|
64 | NEW DOB S DOB=$$object^C0XGET1(DEMID,"v:bday")
|
---|
65 | IF '$L(DOB) SET $EC=",U1," ; ditto
|
---|
66 | ;
|
---|
67 | ; Convert to Timson Date using %DT
|
---|
68 | N X,Y,%DT
|
---|
69 | S X=DOB
|
---|
70 | D ^%DT
|
---|
71 | QUIT Y
|
---|
72 | ;
|
---|
73 | ;
|
---|
74 | SEX(DEMID) ; Public $$; Return Sex M or F given the demographics node ID.
|
---|
75 | ;
|
---|
76 | IF '$DATA(DEMID) SET $EC=",U1," ; Must pass this in.
|
---|
77 | ;
|
---|
78 | ; Get "gender"
|
---|
79 | NEW SEX S SEX=$$object^C0XGET1(DEMID,"foaf:gender")
|
---|
80 | IF '$L(SEX) SET $EC=",U1," ; ditto
|
---|
81 | ;
|
---|
82 | ; Convert to internal value
|
---|
83 | N SEXABBR ; Sex Abbreviation
|
---|
84 | D CHK^DIE(2,.02,,SEX,.SEXABBR) ; Check value and convert to internal
|
---|
85 | ;
|
---|
86 | IF SEXABBR="^" QUIT "F" ; Unknown sexes will be female (Sam sez so)
|
---|
87 | ELSE QUIT SEXABBR
|
---|
88 | ;
|
---|
89 | ;
|
---|
90 | MRN(DEMID) ; Public $$; Return the Medical Record Number given node ID.
|
---|
91 | ;
|
---|
92 | IF '$DATA(DEMID) SET $EC=",U1," ; Must pass this in.
|
---|
93 | ;
|
---|
94 | ; Get subject node, then the identifer under it.
|
---|
95 | NEW MRNNODE S MRNNODE=$$object^C0XGET1(DEMID,"sp:medicalRecordNumber")
|
---|
96 | NEW MRN S MRN=$$object^C0XGET1(MRNNODE,"dcterms:identifier")
|
---|
97 | ;
|
---|
98 | ; If it doesn't exist, invent one
|
---|
99 | I '$L(MRN) S MRN=$R(928749018234)
|
---|
100 | QUIT MRN
|
---|
101 | ;
|
---|
102 | ADDPT(RETURN,PARAM) ; Private Proc; Add Patient to VISTA.
|
---|
103 | ; Return RPC style return pass by reference. Pass empty.
|
---|
104 | ; PARAM passed by reference.
|
---|
105 | ; Required elements include:
|
---|
106 | ; PARAM("NAME")=NAME (last name minimal; recommend full name)
|
---|
107 | ; PARAM("GENDER")=SEX
|
---|
108 | ; PARAM("DOB")=DATE OF BIRTH
|
---|
109 | ; PARAM("MRN")=MEDICAL RECORD NUMBER
|
---|
110 | ;
|
---|
111 | ; Optional elements include:
|
---|
112 | ; PARAM("POBCTY")=PLACE OF BIRTH [CITY]
|
---|
113 | ; PARAM("POBST")=PLACE OF BIRTH [STATE]
|
---|
114 | ; PARAM("MMN")=MOTHER'S MAIDEN NAME
|
---|
115 | ; PARAM("ALIAS",#)=ALIAS NAME(last^first^middle^suffix)^ALIAS SSN
|
---|
116 | ;
|
---|
117 | ; These elements are calculated:
|
---|
118 | ; PARAM("PRFCLTY")=PREFERRED FACILITY
|
---|
119 | ; PARAM("SSN")=SOCIAL SECURITY NUMBER OR NULL IF NONE
|
---|
120 | ; PARAM("SRVCNCTD")=SERVICE CONNECTED?
|
---|
121 | ; PARAM("TYPE")=TYPE
|
---|
122 | ; PARAM("VET")=VETERAN (Y/N)?
|
---|
123 | ; PARAM("FULLICN")=INTEGRATION CONTROL NUMBER AND CHECKSUM
|
---|
124 | ;
|
---|
125 | ;TODO: CHECK THAT PATCH DG*5.3*800 is installed for routine VAFCPTAD to add pt.
|
---|
126 | ;I '$$PATCH^XPDUTL("DG*5.3*800") D EN^DDIOL("You need to have patch DG*5.3*800 to add patients")
|
---|
127 | ;
|
---|
128 | ; Crash if required params aren't present
|
---|
129 | N X F X="NAME","GENDER","DOB","MRN" S:'$D(PARAM(X)) $EC=",U1,"
|
---|
130 | ;
|
---|
131 | ; Calculate ICN and its checksum using MRN; then remove MRN.
|
---|
132 | S PARAM("FULLICN")=PARAM("MRN")_"V"_$$CHECKDG^MPIFSPC(PARAM("MRN"))
|
---|
133 | ;
|
---|
134 | ; Get Preferred Facility from this Facility's number.
|
---|
135 | S PARAM("PRFCLTY")=$P($$SITE^VASITE(),U,3) ; Must use Station number here for API.
|
---|
136 | I 'PARAM("PRFCLTY") S $EC=",U1," ; crash if Facility is not set-up properly.
|
---|
137 | ;
|
---|
138 | ; No SSN (for now)
|
---|
139 | S PARAM("SSN")=""
|
---|
140 | ;
|
---|
141 | ; Boiler plate stuff below:
|
---|
142 | ; TODO: This could be configurable in a File. WV uses "VISTA OFFICE EHR"
|
---|
143 | S PARAM("SRVCNCTD")="N"
|
---|
144 | S PARAM("TYPE")="NON-VETERAN (OTHER)"
|
---|
145 | S PARAM("VET")="N"
|
---|
146 | ;
|
---|
147 | ; Now for the finish. Add the patient to VISTA (but only adds it to 2 :-()
|
---|
148 | D ADD^VAFCPTAD(.RETURN,.PARAM)
|
---|
149 | ;
|
---|
150 | I +RETURN(1)=-1 S $EC=",U1," ; It failed.
|
---|
151 | E N PIEN S PIEN=$P(RETURN(1),U,2)
|
---|
152 | ;
|
---|
153 | ; Add to IHS Patient file using Laygo in case it's already there.
|
---|
154 | NEW C0XFDA
|
---|
155 | SET C0XFDA(9000001,"?+"_PIEN_",",.01)=PIEN
|
---|
156 | SET C0XFDA(9000001,"?+"_PIEN_",",.02)=DT
|
---|
157 | SET C0XFDA(9000001,"?+"_PIEN_",",.12)=DUZ ;logged in user IEN (e.g. "13")
|
---|
158 | SET C0XFDA(9000001,"?+"_PIEN_",",.16)=DT
|
---|
159 | DO UPDATE^DIE("",$NAME(C0XFDA))
|
---|
160 | I $D(^TMP("DIERR",$J)) S $EC=",U1,"
|
---|
161 | ;
|
---|
162 | ; Add medical record number.
|
---|
163 | NEW IENS S IENS="?+1,"_PIEN_","
|
---|
164 | NEW C0XFDA
|
---|
165 | SET C0XFDA(9000001.41,IENS,.01)=+$$SITE^VASITE() ; This time, the IEN of the primary site
|
---|
166 | SET C0XFDA(9000001.41,IENS,.02)=PARAM("MRN") ; Put Medical Record Number on Station Number
|
---|
167 | DO UPDATE^DIE("",$NAME(C0XFDA))
|
---|
168 | I $D(^TMP("DIERR",$J)) S $EC=",U1,"
|
---|
169 | QUIT
|
---|
170 | ;
|
---|
171 | VITALS(G,DFN) ; Private EP; Process Vitals for a patient graph.
|
---|
172 | ; Vital Sign Sets
|
---|
173 | K ^TMP($J) ; Global variable. A patient can have 1000 vital sets.
|
---|
174 | D GOPS^C0XGET3($NA(^TMP($J,"VS")),G,"sp:VitalSignSet","rdf:type")
|
---|
175 | ;
|
---|
176 | ; For each Vital Sign Set, grab encounter
|
---|
177 | N S F S=0:0 S S=$O(^TMP($J,"VS",S)) Q:S="" D
|
---|
178 | . N ENC S ENC=$$GSPO1^C0XGET3(G,^TMP($J,"VS",S),"sp:encounter")
|
---|
179 | . ZWRITE ENC
|
---|
180 | ;
|
---|
181 | ; D EN1^GMVDCSAV(.RESULT,DATA)
|
---|
182 | QUIT
|
---|
183 | ;
|
---|
184 | PROBLEMS(G,DFN) ; Private EP; Process Problems for a patient graph
|
---|
185 | N RETURN ; Local return variable. I don't expect a patient to have more than 50 problems.
|
---|
186 | D ONETYPE^C0XGET3($NA(RETURN),G,"sp:Problem") ; Get all problems for patient
|
---|
187 | N S F S=0:0 S S=$O(RETURN(S)) Q:'S D ; For each problem
|
---|
188 | . N PROBNM S PROBNM=$$GSPO1^C0XGET3(G,RETURN(S),"sp:problemName") ; Snomed-CT coding info
|
---|
189 | . N CODEURL S CODEURL=$$GSPO1^C0XGET3(G,PROBNM,"sp:code") ; Snomed-CT Code URL
|
---|
190 | . N TEXT S TEXT=$$GSPO1^C0XGET3(G,PROBNM,"dcterms:title") ; Snomed-CT Code description
|
---|
191 | . ;
|
---|
192 | . N CODE ; Actual Snomed code rather than URL
|
---|
193 | . S CODE=$P(CODEURL,"/",$L(CODEURL,"/")) ; Get last / piece
|
---|
194 | . N EXPIEN ; IEN in the EXPESSION file
|
---|
195 | . N LEXS ; Return from Lex call
|
---|
196 | . D EN^LEXCODE(CODE) ; Lex API
|
---|
197 | . ;S EXPIEN=$P(LEXS("SCT",1),U) ; First match on Snomed CT. Crash if isn't present.
|
---|
198 | . ;
|
---|
199 | . N STARTDT S STARTDT=$$GSPO1^C0XGET3(G,RETURN(S),"sp:startDate") ; Start Date
|
---|
200 | . N X,Y,%DT S X=STARTDT D ^%DT S STARTDT=Y ; Convert STARTDT to internal format
|
---|
201 | . ZWRITE CODE
|
---|
202 | . ZWRITE TEXT
|
---|
203 | . ZWRITE STARTDT
|
---|
204 | QUIT
|
---|
205 | PROBADD(DFN,CODE,TEXT,EXPIEN,STARTDT) ; Add a problem to a patient's record.
|
---|
206 | ; Input - DFN from Symbol Table
|
---|
207 | ;
|
---|
208 | ; Output - ISIRC [return code]
|
---|
209 | ; ISIRESUL(0)=1
|
---|
210 | ; ISIRESUL(1)=IEN
|
---|
211 | ;
|
---|
212 | N GMPDFN S GMPDFN=DFN ; patient dfn
|
---|
213 | ;
|
---|
214 | ; Add unknown provider to database
|
---|
215 | N C0XFDA,C0XIEN,C0XERR
|
---|
216 | S C0XFDA(200,"?+1,",.01)="PROVIDER,UNKNOWN SMART" ; Name
|
---|
217 | S C0XFDA(200,"?+1,",1)="USP" ; Initials
|
---|
218 | S C0XFDA(200,"?+1,",28)="SMART" ; Mail Code
|
---|
219 | D UPDATE^DIE("E",$NA(C0XFDA),$NA(C0XIEN),$NA(C0XERR))
|
---|
220 | N GMPPROV S GMPPROV=C0XIEN(1) ;Provider IEN
|
---|
221 | ;
|
---|
222 | N GMPVAMC S GMPVAMC=$$KSP^XUPARAM("INST")
|
---|
223 | ;
|
---|
224 | N GMPFLD
|
---|
225 | S GMPFLD(".01")=ISIMISC("ICDIEN") ;Code IEN
|
---|
226 | S GMPFLD(".03")=0 ;hard set
|
---|
227 | S GMPFLD(".05")="^"_ISIMISC("EXPNM") ;Expression text
|
---|
228 | S GMPFLD(".08")=DT ; today's date (entry?)
|
---|
229 | S GMPFLD(".12")=ISIMISC("STATUS") ;Active/Inactive
|
---|
230 | S GMPFLD(".13")=ISIMISC("ONSET") ;Onset date
|
---|
231 | S GMPFLD("1.01")=ISIMISC("EXPIEN")_"^"_ISIMISC("EXPNM") ;^LEX(757.01 ien,descip
|
---|
232 | S GMPFLD("1.03")=ISIMISC("PROVIDER") ;Entered by
|
---|
233 | S GMPFLD("1.04")=ISIMISC("PROVIDER") ;Recording provider
|
---|
234 | S GMPFLD("1.05")=ISIMISC("PROVIDER") ;Responsible provider
|
---|
235 | S GMPFLD("1.06")=1018 ;MEDICAL SERVICE (#49)
|
---|
236 | S GMPFLD("1.07")="" ; Date resolved
|
---|
237 | S GMPFLD("1.08")="" ; Clinic (#44)
|
---|
238 | S GMPFLD("1.09")=DT ;entry date
|
---|
239 | S GMPFLD("1.1")=0 ;Service Connected
|
---|
240 | S GMPFLD("1.11")=0 ;Agent Orange exposure
|
---|
241 | S GMPFLD("1.12")=0 ;Ionizing radiation exposure
|
---|
242 | S GMPFLD("1.13")=0 ;Persian Gulf exposure
|
---|
243 | S GMPFLD("1.14")=ISIMISC("TYPE") ;Accute/Chronic (A,C)
|
---|
244 | S GMPFLD("1.15")="" ;Head/neck cancer
|
---|
245 | S GMPFLD("1.16")="" ;Military sexual trauma
|
---|
246 | S GMPFLD("10",0)=0 ;auto set ""
|
---|
247 | D NEW^GMPLSAVE
|
---|
248 | I '$D(DA) Q "-1^Error creating problem"
|
---|
249 | S ISIRESUL(0)=1
|
---|
250 | S ISIRESUL(1)=DA
|
---|
251 | Q 1
|
---|
252 | ; Example FDA
|
---|
253 | ; SAM(9000011,"88,",.01)="410.90"
|
---|
254 | ; SAM(9000011,"88,",.02)="RODGERS,RONALD"
|
---|
255 | ; SAM(9000011,"88,",.03)="JUN 13,2011"
|
---|
256 | ; SAM(9000011,"88,",.04)=""
|
---|
257 | ; SAM(9000011,"88,",.05)="Acute myocardial infarction, unspecified site, episode of care unspecified"
|
---|
258 | ; SAM(9000011,"88,",.06)="VOE OFFICE INSTITUTION"
|
---|
259 | ; SAM(9000011,"88,",.07)=2
|
---|
260 | ; SAM(9000011,"88,",.08)="MAY 29,2011"
|
---|
261 | ; SAM(9000011,"88,",.12)="INACTIVE"
|
---|
262 | ; SAM(9000011,"88,",.13)="MAY 29,2011"
|
---|
263 | ; SAM(9000011,"88,",1.01)="Acute myocardial infarction, unspecified site, episode of care unspecified"
|
---|
264 | ; SAM(9000011,"88,",1.02)="PERMANENT"
|
---|
265 | ; SAM(9000011,"88,",1.03)="COORDINATOR,ONE"
|
---|
266 | ; SAM(9000011,"88,",1.04)="COORDINATOR,ONE"
|
---|
267 | ; SAM(9000011,"88,",1.05)="COORDINATOR,ONE"
|
---|
268 | ; SAM(9000011,"88,",1.06)="MEDICINE"
|
---|
269 | ; SAM(9000011,"88,",1.07)="JUN 13,2011"
|
---|
270 | ; SAM(9000011,"88,",1.08)=""
|
---|
271 | ; SAM(9000011,"88,",1.09)="MAY 29,2011"
|
---|
272 | ; SAM(9000011,"88,",1.1)="NO"
|
---|
273 | ; SAM(9000011,"88,",1.11)="NO"
|
---|
274 | ; SAM(9000011,"88,",1.12)="NO"
|
---|
275 | ; SAM(9000011,"88,",1.13)="NO"
|
---|
276 | ; SAM(9000011,"88,",1.14)="CHRONIC"
|
---|
277 | ; SAM(9000011,"88,",1.15)=""
|
---|
278 | ; SAM(9000011,"88,",1.16)=""
|
---|
279 | ; SAM(9000011,"88,",1.17)=""
|
---|
280 | ; SAM(9000011,"88,",1.18)=""
|
---|