[1602] | 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)=""
|
---|