[1609] | 1 | C0XPT0 ; VEN/SMH - Get patient data and do something about it ;2013-02-21 4:52 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.
|
---|
[1609] | 7 | N C0XI S C0XI="" F S C0XI=$O(RETURN(C0XI)) Q:C0XI="" D ; For each IEN
|
---|
| 8 | . N G S G="" F S G=$O(RETURN(C0XI,G)) Q:G="" D ; For each graph tied to IEN
|
---|
[1602] | 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 | N DFN S DFN=$P(RETURN(1),U,2)
|
---|
[1604] | 30 | I DFN<1 S $EC=",U1," ; Debug.Assert that patient is added.
|
---|
| 31 | ; D VITALS(G,DFN)
|
---|
[1606] | 32 | D PROBLEMS^C0XPT1(G,DFN) ; Extract Problems and File
|
---|
| 33 | D ADR^C0XPT2(G,DFN) ; Extract Allergies and File
|
---|
[1607] | 34 | D MEDS^C0XPT3(G,DFN) ; Extract Medicaments and File
|
---|
[1602] | 35 | ;
|
---|
| 36 | QUIT
|
---|
| 37 | ;
|
---|
| 38 | NAME(DEMID) ; Public $$; Return VISTA name given the Demographics node ID.
|
---|
| 39 | ;
|
---|
| 40 | IF '$DATA(DEMID) SET $EC=",U1," ; Must pass this in.
|
---|
| 41 | ;
|
---|
| 42 | ; Get name node
|
---|
| 43 | NEW NAMENODE SET NAMENODE=$$object^C0XGET1(DEMID,"v:n")
|
---|
| 44 | IF '$L(NAMENODE) SET $EC=",U1," ; Not supposed to happen.
|
---|
| 45 | ;
|
---|
| 46 | ; Get Last name
|
---|
| 47 | NEW FAMILY SET FAMILY=$$object^C0XGET1(NAMENODE,"v:family-name")
|
---|
| 48 | IF '$L(FAMILY) SET $EC=",U1," ; Not supposed to happen
|
---|
| 49 | ;
|
---|
| 50 | ; Get First name
|
---|
| 51 | NEW GIVEN SET GIVEN=$$object^C0XGET1(NAMENODE,"v:given-name")
|
---|
| 52 | IF '$L(GIVEN) SET $EC=",U1," ; ditto
|
---|
| 53 | ;
|
---|
| 54 | ; Get Additional name (?Middle?)
|
---|
| 55 | NEW MIDDLE SET MIDDLE=$$object^C0XGET1(NAMENODE,"v:additional-name")
|
---|
| 56 | ; This is optional of course
|
---|
| 57 | ;
|
---|
[1605] | 58 | QUIT $$UP^XLFSTR(FAMILY_","_GIVEN_" "_MIDDLE)
|
---|
[1602] | 59 | ;
|
---|
| 60 | ;
|
---|
| 61 | DOB(DEMID) ; Public $$; Return Timson Date for DOB given the Dem node ID.
|
---|
| 62 | ;
|
---|
| 63 | IF '$DATA(DEMID) SET $EC=",U1," ; Must pass this in.
|
---|
| 64 | ;
|
---|
| 65 | ; Get DOB.
|
---|
| 66 | NEW DOB S DOB=$$object^C0XGET1(DEMID,"v:bday")
|
---|
| 67 | IF '$L(DOB) SET $EC=",U1," ; ditto
|
---|
| 68 | ;
|
---|
| 69 | ; Convert to Timson Date using %DT
|
---|
| 70 | N X,Y,%DT
|
---|
| 71 | S X=DOB
|
---|
| 72 | D ^%DT
|
---|
| 73 | QUIT Y
|
---|
| 74 | ;
|
---|
| 75 | ;
|
---|
| 76 | SEX(DEMID) ; Public $$; Return Sex M or F given the demographics node ID.
|
---|
| 77 | ;
|
---|
| 78 | IF '$DATA(DEMID) SET $EC=",U1," ; Must pass this in.
|
---|
| 79 | ;
|
---|
| 80 | ; Get "gender"
|
---|
| 81 | NEW SEX S SEX=$$object^C0XGET1(DEMID,"foaf:gender")
|
---|
| 82 | IF '$L(SEX) SET $EC=",U1," ; ditto
|
---|
| 83 | ;
|
---|
| 84 | ; Convert to internal value
|
---|
| 85 | N SEXABBR ; Sex Abbreviation
|
---|
| 86 | D CHK^DIE(2,.02,,SEX,.SEXABBR) ; Check value and convert to internal
|
---|
| 87 | ;
|
---|
| 88 | IF SEXABBR="^" QUIT "F" ; Unknown sexes will be female (Sam sez so)
|
---|
| 89 | ELSE QUIT SEXABBR
|
---|
| 90 | ;
|
---|
| 91 | ;
|
---|
| 92 | MRN(DEMID) ; Public $$; Return the Medical Record Number given node ID.
|
---|
| 93 | ;
|
---|
| 94 | IF '$DATA(DEMID) SET $EC=",U1," ; Must pass this in.
|
---|
| 95 | ;
|
---|
| 96 | ; Get subject node, then the identifer under it.
|
---|
| 97 | NEW MRNNODE S MRNNODE=$$object^C0XGET1(DEMID,"sp:medicalRecordNumber")
|
---|
| 98 | NEW MRN S MRN=$$object^C0XGET1(MRNNODE,"dcterms:identifier")
|
---|
| 99 | ;
|
---|
| 100 | ; If it doesn't exist, invent one
|
---|
| 101 | I '$L(MRN) S MRN=$R(928749018234)
|
---|
| 102 | QUIT MRN
|
---|
| 103 | ;
|
---|
| 104 | ADDPT(RETURN,PARAM) ; Private Proc; Add Patient to VISTA.
|
---|
| 105 | ; Return RPC style return pass by reference. Pass empty.
|
---|
| 106 | ; PARAM passed by reference.
|
---|
| 107 | ; Required elements include:
|
---|
| 108 | ; PARAM("NAME")=NAME (last name minimal; recommend full name)
|
---|
| 109 | ; PARAM("GENDER")=SEX
|
---|
| 110 | ; PARAM("DOB")=DATE OF BIRTH
|
---|
| 111 | ; PARAM("MRN")=MEDICAL RECORD NUMBER
|
---|
| 112 | ;
|
---|
| 113 | ; Optional elements include:
|
---|
| 114 | ; PARAM("POBCTY")=PLACE OF BIRTH [CITY]
|
---|
| 115 | ; PARAM("POBST")=PLACE OF BIRTH [STATE]
|
---|
| 116 | ; PARAM("MMN")=MOTHER'S MAIDEN NAME
|
---|
| 117 | ; PARAM("ALIAS",#)=ALIAS NAME(last^first^middle^suffix)^ALIAS SSN
|
---|
| 118 | ;
|
---|
| 119 | ; These elements are calculated:
|
---|
| 120 | ; PARAM("PRFCLTY")=PREFERRED FACILITY
|
---|
| 121 | ; PARAM("SSN")=SOCIAL SECURITY NUMBER OR NULL IF NONE
|
---|
| 122 | ; PARAM("SRVCNCTD")=SERVICE CONNECTED?
|
---|
| 123 | ; PARAM("TYPE")=TYPE
|
---|
| 124 | ; PARAM("VET")=VETERAN (Y/N)?
|
---|
| 125 | ; PARAM("FULLICN")=INTEGRATION CONTROL NUMBER AND CHECKSUM
|
---|
| 126 | ;
|
---|
[1603] | 127 | ;CHECK THAT PATCH DG*5.3*800 is installed for routine VAFCPTAD to add pt.
|
---|
| 128 | 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] | 129 | ;
|
---|
| 130 | ; Crash if required params aren't present
|
---|
| 131 | N X F X="NAME","GENDER","DOB","MRN" S:'$D(PARAM(X)) $EC=",U1,"
|
---|
| 132 | ;
|
---|
| 133 | ; Calculate ICN and its checksum using MRN; then remove MRN.
|
---|
| 134 | S PARAM("FULLICN")=PARAM("MRN")_"V"_$$CHECKDG^MPIFSPC(PARAM("MRN"))
|
---|
| 135 | ;
|
---|
| 136 | ; Get Preferred Facility from this Facility's number.
|
---|
| 137 | S PARAM("PRFCLTY")=$P($$SITE^VASITE(),U,3) ; Must use Station number here for API.
|
---|
| 138 | I 'PARAM("PRFCLTY") S $EC=",U1," ; crash if Facility is not set-up properly.
|
---|
| 139 | ;
|
---|
| 140 | ; No SSN (for now)
|
---|
| 141 | S PARAM("SSN")=""
|
---|
| 142 | ;
|
---|
| 143 | ; Boiler plate stuff below:
|
---|
| 144 | ; TODO: This could be configurable in a File. WV uses "VISTA OFFICE EHR"
|
---|
| 145 | S PARAM("SRVCNCTD")="N"
|
---|
| 146 | S PARAM("TYPE")="NON-VETERAN (OTHER)"
|
---|
| 147 | S PARAM("VET")="N"
|
---|
| 148 | ;
|
---|
| 149 | ; Now for the finish. Add the patient to VISTA (but only adds it to 2 :-()
|
---|
| 150 | D ADD^VAFCPTAD(.RETURN,.PARAM)
|
---|
| 151 | ;
|
---|
| 152 | I +RETURN(1)=-1 S $EC=",U1," ; It failed.
|
---|
| 153 | E N PIEN S PIEN=$P(RETURN(1),U,2)
|
---|
| 154 | ;
|
---|
| 155 | ; Add to IHS Patient file using Laygo in case it's already there.
|
---|
| 156 | NEW C0XFDA
|
---|
| 157 | SET C0XFDA(9000001,"?+"_PIEN_",",.01)=PIEN
|
---|
| 158 | SET C0XFDA(9000001,"?+"_PIEN_",",.02)=DT
|
---|
| 159 | SET C0XFDA(9000001,"?+"_PIEN_",",.12)=DUZ ;logged in user IEN (e.g. "13")
|
---|
| 160 | SET C0XFDA(9000001,"?+"_PIEN_",",.16)=DT
|
---|
| 161 | DO UPDATE^DIE("",$NAME(C0XFDA))
|
---|
| 162 | I $D(^TMP("DIERR",$J)) S $EC=",U1,"
|
---|
| 163 | ;
|
---|
| 164 | ; Add medical record number.
|
---|
| 165 | NEW IENS S IENS="?+1,"_PIEN_","
|
---|
| 166 | NEW C0XFDA
|
---|
| 167 | SET C0XFDA(9000001.41,IENS,.01)=+$$SITE^VASITE() ; This time, the IEN of the primary site
|
---|
| 168 | SET C0XFDA(9000001.41,IENS,.02)=PARAM("MRN") ; Put Medical Record Number on Station Number
|
---|
| 169 | DO UPDATE^DIE("",$NAME(C0XFDA))
|
---|
| 170 | I $D(^TMP("DIERR",$J)) S $EC=",U1,"
|
---|
| 171 | QUIT
|
---|
| 172 | ;
|
---|
| 173 | VITALS(G,DFN) ; Private EP; Process Vitals for a patient graph.
|
---|
| 174 | ; Vital Sign Sets
|
---|
| 175 | K ^TMP($J) ; Global variable. A patient can have 1000 vital sets.
|
---|
| 176 | D GOPS^C0XGET3($NA(^TMP($J,"VS")),G,"sp:VitalSignSet","rdf:type")
|
---|
| 177 | ;
|
---|
| 178 | ; For each Vital Sign Set, grab encounter
|
---|
| 179 | N S F S=0:0 S S=$O(^TMP($J,"VS",S)) Q:S="" D
|
---|
| 180 | . N ENC S ENC=$$GSPO1^C0XGET3(G,^TMP($J,"VS",S),"sp:encounter")
|
---|
| 181 | ;
|
---|
| 182 | ; D EN1^GMVDCSAV(.RESULT,DATA)
|
---|
| 183 | QUIT
|
---|
| 184 | ;
|
---|
[1605] | 185 | NP() ; New Person Entry
|
---|
| 186 | N C0XFDA,C0XIEN,C0XERR
|
---|
| 187 | S C0XFDA(200,"?+1,",.01)="PROVIDER,UNKNOWN SMART" ; Name
|
---|
| 188 | S C0XFDA(200,"?+1,",1)="USP" ; Initials
|
---|
| 189 | S C0XFDA(200,"?+1,",28)="SMART" ; Mail Code
|
---|
| 190 | ;
|
---|
| 191 | N DIC S DIC(0)="" ; An XREF in File 200 requires this.
|
---|
| 192 | D UPDATE^DIE("E",$NA(C0XFDA),$NA(C0XIEN),$NA(C0XERR)) ; Typical UPDATE
|
---|
| 193 | Q C0XIEN(1) ;Provider IEN
|
---|
| 194 | ;
|
---|