source: cprs/branches/tmg-cprs/m_files/TMGRPC4B.m@ 1727

Last change on this file since 1727 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload
File size: 11.6 KB
Line 
1TMGRPC4B ;TMG/kst/Support Functions for DxLink ;11/16/08
2 ;;1.0;TMG-LIB;**1**;11/16/08
3 ;
4 ;"TMG RPC FUNCTIONS for a DxLinkprogram
5 ;
6 ;"Kevin Toppenberg MD
7 ;"GNU Lessor General Public License (LGPL) applies
8 ;"7/20/08
9 ;
10 ;"=======================================================================
11 ;" RPC -- Public Functions.
12 ;"=======================================================================
13 ;" <none>
14 ;"=======================================================================
15 ;"PRIVATE API FUNCTIONS
16 ;"=======================================================================
17 ;"LOOKUPAT(TMGOUT,TMGPARAMS) -- find a patient that is already registered, using exact search
18 ;"ENSURVST(TMGOUT,TMGPARAMS)--ensure that a Visit entry exists for appt info
19 ;
20 ;"=======================================================================
21 ;"Dependencies:
22 ;" TMGRPC3*,TMGRPC4*
23 ;" TMGGDFN
24 ;
25 ;"=======================================================================
26 ;
27LOOKUPAT(TMGOUT,TMGPARAMS) ;"LOOKUP PATIENT
28 ;"Purpose: To find a patient that is already registered, using exact search
29 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
30 ;" TMGPARAMS -- LNAME,FName^DOB^SequelPMSAccount#
31 ;"Output: TMGOUT is filled as follows:
32 ;" TMGOUT(0)="1^Success" or "-1^Message"
33 ;" TMGOUT(1)=DFN (or 0 if not found)
34 ;"Results: None
35 ;
36 NEW TMGA,TMGDFN
37 SET TMGA(.01)=$PIECE(TMGPARAMS,"^",1)
38 IF TMGA(.01)[", " DO
39 . NEW SPEC SET SPEC(", ")=","
40 . SET TMGA(.01)=$$REPLACE^XLFSTR(TMGA(.01),.SPEC)
41 SET TMGA(.03)=$PIECE(TMGPARAMS,"^",2)
42 SET TMGA(22701)=$PIECE(TMGPARAMS,"^",3)
43 SET TMGOUT(1)=$$GetDFN2^TMGGDFN(.TMGA,0)
44 IF TMGOUT(1)>0 SET TMGOUT(0)="1^Success"
45 ELSE SET TEMGOUT(0)="-1^Patient not found: "_TMGPARAMS
46 ;
47 QUIT
48 ;
49ENSURVST(TMGOUT,TMGPARAMS) ;"ENSURE VISIT
50 ;"Purpose: To ensure that a Visit entry exists for appt info
51 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
52 ;" TMGPARAMS -- DFN^Date@Time^DurationMins^Reason^Location^Provider^Comments
53 ;" Notes: DFN -- patient IEN
54 ;" Date@Time -- time of appt
55 ;" DurationMinutes -- duration of appt.
56 ;" Reason -- text reason for purpose of appt.
57 ;" Location -- clinic name as stored in Fileman
58 ;" Provider -- Sequel ShortName for appt provider
59 ;" Comments -- misc free text.
60 ;"Output: TMGOUT is filled as follows:
61 ;" TMGOUT(0)="1^Success" or "-1^Message"
62 ;" TMGOUT(1)=IEN (or 0 if not found)
63 ;"Results: None
64 ;"Note: I have added a custom XRef on the HOSPITAL LOCATION file, and a
65 ;" new field (22700, PMS NAME), that allows the location to be
66 ;" looked up by the name provided by the PMS.
67 ;" ** If this were to be used in another site, this would need to be
68 ;" addressed. A value would need to be put into that 22700 field etc.
69 ;
70 SET TMGOUT(0)="1^Success" ;"set default result
71 SET TMGOUT(1)=0
72
73
74 if $data(^TMG("TMP","Killthis","ENSURVST")) do goto T2
75 . set TMGPARAMS=$get(^TMG("TMP","Killthis","ENSURVST"))
76
77 merge ^TMG("TMP","Killthis","ENSURVST")=TMGPARAMS
78 goto EVSTDONE
79 ;
80
81T2
82 NEW TMGDFN SET TMGDFN=+$PIECE(TMGPARAMS,"^",1)
83 NEW TMGVDT SET TMGVDT=$PIECE(TMGPARAMS,"^",2)
84 NEW TMGDUR SET TMGDUR=$PIECE(TMGPARAMS,"^",3)
85 NEW TMGRSN SET TMGRSN=$PIECE(TMGPARAMS,"^",4)
86 ;"Note: TMGLOC holds a Sequl Shortname. Depends on added 'TMG' xref in file 4
87 NEW TMGLOC SET TMGLOC=$PIECE(TMGPARAMS,"^",5)
88 ;"NEW TMGDOC SET TMGDOC=$PIECE(TMGPARAMS,"^",6)
89 NEW TMGCOM SET TMGCOM=$PIECE(TMGPARAMS,"^",7)
90
91 ;
92 IF TMGDFN'>0 DO GOTO EVSTDONE
93 . SET TMGOUT(0)="-1^Patient DFN > 0 not specified: "_TMGPARAMS
94 NEW TMGDFNIH SET TMGDFNIH=TMGDFN ;"IEN's same in file 9000001 <--> 2
95 ;
96 ;"new TMGLIEN,DIC,X,Y
97 ;"set DIC=4,DIC(0)="M",X=TMGLOC
98 ;"do ^DIC
99
100 ;
101 SET TMGVDT=$TRANSLATE(TMGVDT," ","")
102 NEW TMGFMDT,TMGMSG
103 DO DT^DILF("R",TMGVDT,.TMGFMDT,,"TMGMSG")
104 IF (+$get(TMGFMDT)'>0)!$DATA(TMGMSG) DO GOTO EVSTDONE
105 . SET TMGOUT(0)="-1^Invalid Date/Time: "_TMGVDT
106 ;
107 ;"IF TMGDOC="" DO GOTO EVSTDONE
108 ;". SET TMGOUT(0)="-1^No provider specified: "_TMGPARAMS
109 ;"NEW TMGIEN2 SET TMGIEN2=$ORDER(^VA(200,"TMG",TMGDOC,""))
110 ;"IF TMGIEN2'>0 DO GOTO EVSTDONE
111 ;". SET TMGOUT(0)="-1^Unable to convert Sequel shortname '"_TMGDOC_"' to a VistA provider name"
112 ;"SET TMGDOC=$PIECE($GET(^VA(200,TMGIEN2,0)),"^",1)
113 ;
114 NEW TMGFDA,TMGIEN,TMGMSG,TMGIENS
115 ;"Look for existing visit
116 NEW TMGI SET TMGI=""
117 NEW TMGDONE SET TMGDONE=0
118 FOR SET TMGI=$ORDER(^AUPNVSIT("C",TMGDFNIH,TMGI)) QUIT:(+TMGI'>0)!TMGDONE DO
119 . NEW VDT SET VDT=$PIECE($GET(^AUPNVSIT(TMGI,0)),"^",1) ;"0;1=VISIT DATE/TIME
120 . NEW X1,X2,X
121 . SET X1=VDT,X2=TMGFMDT
122 . DO ^%DTC ;"Return difference in days between dates: X=X1-X2
123 . IF X=0 DO QUIT ;"Later could do a more strict compare, i.e. same TIME
124 . . SET TMGDONE=1
125 IF TMGI>0 DO
126 . SET TMGIEN=TMGI
127 . SET TMGIENS=TMGIEN_","
128 ELSE DO
129 . SET TMGIEN=0
130 . SET TMGIENS="+1,"
131 ;
132 SET TMGFDA(9000010,TMGIENS,.01)=TMGVDT ;".01-VISIT/ADMIT DATE&TIME
133 ;"SET TMGFDA(9000010,TMGIENS,.02)="NOW" ;".02-DATE VISIT CREATED
134 SET TMGFDA(9000010,TMGIENS,.03)="OTHER" ;".03-TYPE
135 SET TMGFDA(9000010,TMGIENS,.05)="`"_TMGDFNIH ;".05-PATIENT NAME
136 SET TMGFDA(9000010,TMGIENS,.06)=TMGLOC ;".06-LOC. OF ENCOUNTER
137 SET TMGFDA(9000010,TMGIENS,.07)="AMBULATORY" ;".07-SERVICE CATEGORY
138 SET TMGFDA(9000010,TMGIENS,.09)=1 ;".09-DEPENDENT ENTRY COUNT
139 ;"SET TMGFDA(9000010,TMGIENS,.13)="NOW" ;".13-DATE LAST MODIFIED
140 SET TMGFDA(9000010,TMGIENS,.22)=TMGLOC ;".22-HOSPITAL LOCATION
141 SET TMGFDA(9000010,TMGIENS,.23)="`"_DUZ ;".23-CREATED BY USER
142 SET TMGFDA(9000010,TMGIENS,.24)="TMG RPC CONTEXT DXLINK" ;".24-OPTION USED TO CREATE
143 SET TMGFDA(9000010,TMGIENS,15002)="OUT" ;"15002-PATIENT STATUS IN/OUT
144 SET TMGFDA(9000010,TMGIENS,15003)="PRIMARY" ;"15003-ENCOUNTER TYPE
145 SET TMGFDA(9000010,TMGIENS,81202)="TMG" ;"81202-PACKAGE (or should value be 'PCE'?)
146 SET TMGFDA(9000010,TMGIENS,81203)="TEXT INTEGRATION UTILITIES"
147 ;"?? Add field: 15001-VISIT ID : 10GJ-TEST <-- added by Visit Tracking
148 ;
149 IF TMGIEN=0 DO
150 . ;"Add record and return a pointer to it.
151 . KILL TMGIEN
152 . DO UPDATE^DIE("ES","TMGFDA","TMGIEN","TMGMSG")
153 . SET TMGOUT(1)=+$get(TMGIEN(1))
154 ELSE DO
155 . KILL TMGFDA(9000010,TMGIENS,.05) ;"FM says: 'Can't be edited'
156 . KILL TMGFDA(9000010,TMGIENS,81203) ;"FM says: 'Can't be edited'
157 . ;"Store values provided in existing record
158 . DO FILE^DIE("E","TMGFDA","TMGMSG")
159 . SET TMGOUT(1)=TMGIEN
160 IF $DATA(TMGMSG("DIERR")) DO
161 . SET TMGOUT(0)="-1^See Fileman message"
162 . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
163 ;
164EVSTDONE ;
165 QUIT
166 ;
167 ;
168APPTLST(TMGOUT,TMGPARAMS) ;"APPT LIST
169 ;"Purpose: Return a list of appts for given date.
170 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
171 ;" TMGPARAMS -- Date^Location(Optional)
172 ;" Notes: Date -- date to look for dates. In external (user-input) format
173 ;" Location -- clinic name as stored in Fileman
174 ;"Output: TMGOUT is filled as follows:
175 ;" TMGOUT(0)="1^Success" or "-1^Message"
176 ;" TMGOUT(1)=(0 if none found)
177 ;" TMGOUT(1)=DateTime^PatientName^DFN^DOB^SeqHRN^Location(Sequel ShortName)^CPTList^ICD9List
178 ;" CPTList format: 'Code#|CodeName;Code#|CodeName;Code#|CodeName...;'
179 ;" ICD9List format: 'Code#|CodeName;Code#|CodeName;Code#|CodeName...;'
180 ;"Results: None
181 ;"Note: I have added a custom XRef on the HOSPITAL LOCATION file, and a
182 ;" new field (22700, PMS NAME), that allows the location to be
183 ;" looked up by the name provided by the PMS.
184 ;" ** If this were to be used in another site, this would need to be
185 ;" addressed. A value would need to be put into that 22700 field etc.
186 ;
187 SET TMGOUT(0)="1^Success" ;"set default result
188 SET TMGOUT(1)=0
189 ;
190 NEW TMGVDT SET TMGVDT=$PIECE(TMGPARAMS,"^",1)
191 NEW TMGLOC SET TMGLOC=$PIECE(TMGPARAMS,"^",2)
192 ;
193 NEW TMGLIEN SET TMGLIEN=0
194 IF TMGLOC="" GOTO AL2
195 NEW X,Y,DIC
196 SET DIC=44,DIC(0)="M",X=TMGLOC
197 DO ^DIC
198 IF Y'>0 DO GOTO APLDONE
199 . SET TMGOUT(0)="-1^Invalid location name: '"_TMGLOC_"'"
200 SET TMGLIEN=+Y
201AL2 ;
202 SET TMGVDT=$TRANSLATE(TMGVDT," ","")
203 NEW TMGFMDT,TMGMSG
204 DO DT^DILF("X",TMGVDT,.TMGFMDT,,"TMGMSG")
205 IF (+$get(TMGFMDT)'>0)!$DATA(TMGMSG) DO GOTO APLDONE
206 . SET TMGOUT(0)="-1^Invalid Date/Time: "_TMGVDT
207 ;
208 NEW TMGARRAY,TMGS
209 NEW TMGCOUNT SET TMGCOUNT=1
210 NEW TMG1DT SET TMG1DT=TMGFMDT
211 FOR SET TMG1DT=$ORDER(^AUPNVSIT("B",TMG1DT)) Q:(TMG1DT'>0)!(TMG1DT>(TMGFMDT+1)) DO
212 . NEW IEN SET IEN=""
213 . FOR SET IEN=$ORDER(^AUPNVSIT("B",TMG1DT,IEN)) Q:(IEN'>0) DO
214 . . NEW LOC SET LOC=+$P($G(^AUPNVSIT(IEN,0)),U,22)
215 . . IF (TMGLIEN>0)&(LOC'=TMGLIEN) QUIT
216 . . NEW DFN SET DFN=+$P($G(^AUPNVSIT(IEN,0)),U,5) Q:(DFN'>0)
217 . . NEW Y SET Y=+$P($G(^AUPNVSIT(IEN,0)),U,1)
218 . . DO DD^%DT
219 . . SET TMGS=Y_"^"
220 . . SET TMGS=TMGS_$P($G(^DPT(DFN,0)),U,1)_"^"_DFN_"^"
221 . . SET Y=$P($G(^DPT(DFN,0)),U,3) DO DD^%DT SET TMGS=TMGS_Y_"^"
222 . . NEW SHRN SET SHRN=$P($G(^DPT(DFN,"TMG")),U,2)
223 . . SET TMGS=TMGS_SHRN_"^"
224 . . SET TMGS=TMGS_$PIECE($GET(^SC(LOC,"TMG")),U,1)_"^" ;"Custom field 22700
225 . . SET TMGS=TMGS_$$CPTLIST(IEN)_"^"
226 . . SET TMGS=TMGS_$$ICDLIST(IEN)_"^"
227 . . SET TMGOUT(TMGCOUNT)=TMGS
228 . . SET TMGCOUNT=TMGCOUNT+1
229 ;
230APLDONE ;
231 QUIT
232 ;
233CPTLIST(VSTIEN) ;
234 ;"Purpose: To return a list of CPT's associated with given visit.
235 ;"Input: VSTIEN -- IEN in VISIT file (9000010)
236 ;"Results: 'Code#|CodeName;Code#|CodeName;Code#|CodeName...;' , or '' if none found
237 NEW RESULT SET RESULT=""
238 NEW IEN SET IEN=""
239 FOR SET IEN=$ORDER(^AUPNVCPT("AD",VSTIEN,IEN)) QUIT:(IEN="") DO
240 . NEW CPTIEN SET CPTIEN=$P($G(^AUPNVCPT(IEN,0)),U,1) ;"0;1=CPT Name
241 . NEW CODESTR SET CODESTR=$P($G(^ICPT(CPTIEN,0)),U,1)
242 . NEW DESCR SET DESCR=$P($G(^ICPT(CPTIEN,0)),U,2)
243 . IF (CODESTR="")&(DESCR="") QUIT
244 . SET RESULT=RESULT_CODESTR_"|"_DESCR_";"
245 QUIT RESULT
246 ;
247ICDLIST(VSTIEN) ;
248 ;"Purpose: To return a list of ICD9 codes associated with given visit.
249 ;"Input: VSTIEN -- IEN in VISIT file (9000010)
250 ;"Results: 'Code#|CodeName;Code#|CodeName;Code#|CodeName...;' , or '' if none found
251 NEW RESULT SET RESULT=""
252 NEW IEN SET IEN=""
253 FOR SET IEN=$ORDER(^AUPNVPOV("AD",VSTIEN,IEN)) QUIT:(IEN="") DO
254 . NEW ICDIEN SET ICDIEN=$P($G(^AUPNVPOV(IEN,0)),U,1) ;"0;1=POV
255 . NEW CODESTR SET CODESTR=$P($G(^ICD9(ICDIEN,0)),U,1)
256 . NEW DESCR SET DESCR=$P($G(^ICD9(ICDIEN,0)),U,3)
257 . IF (CODESTR="")&(DESCR="") QUIT
258 . SET RESULT=RESULT_CODESTR_"|"_DESCR_";"
259 QUIT RESULT
Note: See TracBrowser for help on using the repository browser.