[1603] | 1 | C0XPT0 ; VEN/SMH - Get patient data and do something about it ;2013-01-28 4:24 PM
|
---|
[1602] | 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 | ;
|
---|
[1603] | 125 | ;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") S $EC=",U1,"
|
---|
[1602] | 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
|
---|
[1603] | 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
|
---|
[1602] | 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
|
---|
[1603] | 205 | . S EXPIEN=$P(LEXS("SCT",1),U) ; First match on Snomed CT. Crash if isn't present.
|
---|
[1602] | 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
|
---|
[1603] | 209 | . D PROBADD(DFN,CODE,TEXT,EXPIEN,STARTDT) ; Add problem to VISTA.
|
---|
[1602] | 210 | QUIT
|
---|
| 211 | PROBADD(DFN,CODE,TEXT,EXPIEN,STARTDT) ; Add a problem to a patient's record.
|
---|
[1603] | 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.
|
---|
[1602] | 218 | ;
|
---|
[1603] | 219 | ; Output:
|
---|
| 220 | ; NONE
|
---|
| 221 | ; Crash expectd if code fails to add a problem.
|
---|
[1602] | 222 | ;
|
---|
[1603] | 223 | ;
|
---|
| 224 | ;
|
---|
[1602] | 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
|
---|
[1603] | 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
|
---|
[1602] | 235 | N GMPPROV S GMPPROV=C0XIEN(1) ;Provider IEN
|
---|
| 236 | ;
|
---|
[1603] | 237 | N GMPVAMC S GMPVAMC=$$KSP^XUPARAM("INST") ; Problem Institution. Ideally, the external one. But we are taking a shortcut here.
|
---|
[1602] | 238 | ;
|
---|
[1603] | 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
|
---|
[1602] | 244 | S GMPFLD(".08")=DT ; today's date (entry?)
|
---|
[1603] | 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)
|
---|
[1602] | 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
|
---|
[1603] | 259 | S GMPFLD("1.14")="C" ;Accute/Chronic (A,C)
|
---|
[1602] | 260 | S GMPFLD("1.15")="" ;Head/neck cancer
|
---|
| 261 | S GMPFLD("1.16")="" ;Military sexual trauma
|
---|
[1603] | 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
|
---|