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

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

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