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

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

Initial code for processing medications. Right now code just picks medicaitons out for a patient
File size: 6.3 KB
Line 
1C0XPT0 ; VEN/SMH - Get patient data and do something about it ;2013-02-19 2:14 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^C0XPT1(G,DFN) ; Extract Problems and File
33 D ADR^C0XPT2(G,DFN) ; Extract Allergies and File
34 D MEDS^C0XPT3(G,DFN) ; Extract Medicaments and File
35 ;
36 QUIT
37 ;
38NAME(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 ;
58 QUIT $$UP^XLFSTR(FAMILY_","_GIVEN_" "_MIDDLE)
59 ;
60 ;
61DOB(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 ;
76SEX(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 ;
92MRN(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 ;
104ADDPT(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 ;
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,"
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 ;
173VITALS(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 ;
185NP() ; 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 ;
Note: See TracBrowser for help on using the repository browser.