source: cprs/branches/tmg-cprs/m_files/TMGHRPC2.m@ 1620

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

Initial upload

File size: 9.8 KB
Line 
1TMGHRPC2 ;TMG/elh/Support Functions for TMG_CPRS ;10/20/09
2 ;;1.0;TMG-LIB;**1**;10/20/09;Build 3
3 ;
4 ;"Eddie Hagood
5 ;"GNU Lessor General Public License (LGPL) applies
6 ;"10/20/09
7 ;
8 ;"=======================================================================
9 ;" RPC -- Public Functions.
10 ;"=======================================================================
11 ;" <none>
12 ;"=======================================================================
13 ;"PRIVATE API FUNCTIONS
14 ;"=======================================================================
15 ;" ;
16 ;"=======================================================================
17 ;"Dependencies:
18 ;" ;
19 ;"=======================================================================
20 ;
21LISTALL(Y,FROM,DIR) ; Return a bolus of patient names. From is either Name or IEN^Name.
22 merge ^TMG("TMP","RPC","LISTALL^TMGHRPC2","FROM")=FROM
23 merge ^TMG("TMP","RPC","LISTALL^TMGHRPC2","DIR")=DIR
24 ;"IF $EXTRACT(FROM,1)="." DO INEXACT(.Y,FROM,.DIR) QUIT
25 IF $$WEDGE^TMGHRPC2(.Y,FROM,.DIR) QUIT
26 IF FROM'="" DO INEXACT(.Y,FROM,.DIR) QUIT
27 DO LISTALL^ORWPT(.Y,.FROM,.DIR)
28 QUIT
29 ;
30WEDGE(OUT,FROM,DIR) ;
31 ;"Purpose: Return a bolus of patient names, handling a leading date
32 ;"Input: OUT -- Out parameter, pass by reference.
33 ;" FROM -- User specified string to search from.
34 ;" If in format of a date, then handled here. Otherwise
35 ;" this function quits, and handling will occur elsewhere
36 ;". Input can be either Name or IEN^Name (but later not
37 ;" handled here)
38 ;" Example of Input: '10/1/67 Too~'
39 ;" Note: CPRS decrements the terminal character of user
40 ;" input, and adds a ~
41 ;" DIR -- should be 1 or -1
42 ;"Results: 1 if handled, 0 if not handled.
43 ;"
44 NEW TMGCH,TMGTEMP,TMGTNAME,TMGSUBIEN,TMGB,TMGABORT
45 NEW I,IEN,CNT,FROMIEN,TMGNAME,TMGA,TMGANAME,TMGRESULT
46 NEW %DT,X,Y
47 SET CNT=44,I=0,TMGABORT=0
48 SET DIR=$GET(DIR,1)
49 SET TMGRESULT=0 ;"Default to failure
50 SET TMGA=$PIECE(FROM," ",1)
51 SET TMGB=$PIECE(FROM," ",2)
52 IF $$ISPHONE(FROM) QUIT $$HANDLEPHONE(.OUT,.FROM,.DIR)
53 IF $$ISMONTH(TMGA) DO
54 . NEW YEAR SET YEAR=$P(FROM," ",3)
55 . IF (YEAR?2.4N) DO
56 . . SET TMGA=$PIECE(FROM," ",1,3)
57 . . SET TMGB=$PIECE(FROM," ",4)
58 . ELSE DO
59 . . SET TMGA=$PIECE(FROM," ",1,2)
60 . . SET TMGB=$PIECE(FROM," ",3)
61 ELSE DO
62 . ;"Test for nN/nN/nnNN pattern
63 . IF '(TMGA?1.2N1(1"-",1"/")1.2N1(1"-",1"/")2.4E0.1"~") SET TMGABORT=1
64 IF TMGABORT GOTO WQ
65 SET TMGA=$TRANSLATE(TMGA,"~","")
66 IF (DIR=1),TMGB="" DO ;"Reverse CPRS's inc/dec of terminal digit if isolated date
67 . SET TMGCH=$E(TMGA,$L(TMGA))
68 . SET TMGCH=$CHAR($ASCII(TMGCH)+DIR)
69 . SET TMGA=$E(TMGA,1,$L(TMGA)-1)_TMGCH
70 SET %DT="P" ;"Assume past dates
71 SET X=TMGA
72 DO ^%DT ;"convert external date to FM Date
73 IF Y=-1 GOTO WQ
74 SET IEN=0
75 ;"Gather ALL patients with specified DOB, so can be sorted alphabetically
76 FOR SET IEN=$ORDER(^DPT("ADOB",Y,IEN)) QUIT:'IEN DO
77 . SET TMGNAME=$P($G(^DPT(IEN,0)),U,1) ; Get zero node name.
78 . NEW TEMP SET TEMP=TMGA_" "_TMGNAME
79 . SET TMGTEMP(TEMP,IEN_U_TEMP_U_U_U_U_TEMP)=""
80 . SET TMGSUBIEN=0
81 . FOR SET TMGSUBIEN=$O(^DPT(IEN,.01,TMGSUBIEN)) QUIT:TMGSUBIEN="" DO
82 . . SET TMGANAME=$P($G(^DPT(IEN,.01,TMGSUBIEN,0)),U,1)
83 . . NEW TEMP2 SET TEMP2=TMGA_" "_TMGANAME
84 . . SET TMGTEMP(TEMP2,IEN_U_TEMP2_U_U_U_U_TEMP)=""
85 ;
86 KILL OUT
87 SET TMGTNAME=TMGA_" "_$$UP^XLFSTR($TRANSLATE(TMGB,"~",""))
88 ;"Get sublist of patients starting at specified last name etc.
89 FOR SET TMGTNAME=$ORDER(TMGTEMP(TMGTNAME),DIR) QUIT:TMGTNAME="" DO QUIT:I=CNT
90 . NEW ENTRY SET ENTRY=""
91 . FOR SET ENTRY=$O(TMGTEMP(TMGTNAME,ENTRY),DIR) QUIT:ENTRY="" DO QUIT:I=CNT
92 . . SET I=I+1
93 . . SET OUT(I)=ENTRY
94 SET TMGRESULT=1
95 GOTO WQ
96 ;
97WQ QUIT TMGRESULT
98 ;
99ISMONTH(S)
100 ;"Purpose: to determine if S is a string specifying a month.
101 ;"Input: S -- the string to test. It is altered, so don't pass by reference
102 ;"Results: 1 if is a month name, or 0 if not.
103 SET S=$$UP^XLFSTR(S)
104 SET S=$TRANSLATE(S,".","")
105 IF S="JANUARY"!(S="JAN") QUIT 1
106 IF S="FEBRUARY"!(S="FEB") QUIT 1
107 IF S="MARCH"!(S="MAR") QUIT 1
108 IF S="APRIL"!(S="APR") QUIT 1
109 IF S="MAY" QUIT 1
110 IF S="JUNE"!(S="JUN") QUIT 1
111 IF S="JULY"!(S="JUL") QUIT 1
112 IF S="AUGUST"!(S="AUG") QUIT 1
113 IF S="SEPTEMBER"!(S="SEP")!(S="SEPT") QUIT 1
114 IF S="OCTOBER"!(S="OCT") QUIT 1
115 IF S="NOVEMBER"!(S="NOV") QUIT 1
116 IF S="DECEMBER"!(S="DEC") QUIT 1
117 QUIT 0
118 ;
119ISPHONE(S)
120 ;"Purpose: to determine is S is a phone number.
121 ;"Input: S -- the string to test.
122 ;"Results: 1 if a phone number, or 0 if not.
123 IF (S?3N1(1"-",1" ")3N1(1"-",1" ")1.4N.E) QUIT 1
124 ;IF (S?3N1(1"-",1" ")3.4N.E) QUIT 1
125 IF $EXTRACT(S,1)="(" QUIT 1
126 QUIT 0
127 ;
128INEXACT(OUT,FROM,DIR)
129 ;"Purpose: To perform an inexact, old-style Fileman lookup on user input
130 ;"Input: OUT -- Out parameter, pass by reference.
131 ;" FROM -- User specified string to search from.
132 ;". Input can be either Name or IEN^Name
133 ;" Example of Input: '.Smit,Joh~'
134 ;" Note: CPRS decrements the terminal character of user
135 ;" input, and adds a ~
136 ;" DIR -- should be 1 or -1
137 ;"Results: NONE
138 ;
139 NEW I,IEN,CNT,FROMIEN
140 SET CNT=44,I=0,FROMIEN=0
141 SET DIR=$GET(DIR,1)
142 NEW TMGCH,TMGTRIM SET TMGTRIM=""
143 ;"Trim any leading '.' or ' '
144 FOR SET TMGCH=$EXTRACT(FROM,1) QUIT:(". "'[TMGCH) DO
145 . SET TMGTRIM=TMGTRIM_$EXTRACT(FROM,1)
146 . SET FROM=$EXTRACT(FROM,2,999)
147 IF $PIECE(FROM,U,2)'="" DO
148 . SET FROM=$PIECE(FROM,U,2)
149 . SET FROMIEN=$PIECE(FROM,U,1)
150 NEW TMGSRCH SET TMGSRCH=$TRANSLATE(FROM,"~","")
151 NEW TMGSRFROM SET TMGSRFROM=""
152 IF TMGSRCH[" -- " DO
153 . SET TMGSRFROM=$PIECE(TMGSRCH," -- ",2)
154 . SET TMGSRCH=$PIECE(TMGSRCH," -- ",1)
155 IF (DIR=1),(TMGSRFROM="") DO ;"Reverse CPRS's inc/dec of terminal digit
156 . SET TMGCH=$EXTRACT(TMGSRCH,$LENGTH(TMGSRCH))
157 . SET TMGCH=$CHAR($ASCII(TMGCH)+DIR)
158 . SET TMGSRCH=$EXTRACT(TMGSRCH,1,$LENGTH(TMGSRCH)-1)_TMGCH
159 NEW TMGOUT,TMGMSG
160 DO FIND^DIC(2,,"@;.01","PBC",TMGSRCH,"*",,,,"TMGOUT","TMGMSG")
161 KILL OUT
162 IF +TMGOUT("DILIST",0)'>0 QUIT ;"No matches found.
163 ;
164 ;"Gather ALL matching patients so can be sorted alphabetically
165 NEW TMGBYIEN,TMGTEMP
166 NEW TMGIDX SET TMGIDX=0
167 FOR SET TMGIDX=$ORDER(TMGOUT("DILIST",TMGIDX)) QUIT:(TMGIDX="") DO
168 . SET TMGNAME=$PIECE($GET(TMGOUT("DILIST",TMGIDX,0)),U,2)
169 . SET IEN=+$PIECE($GET(TMGOUT("DILIST",TMGIDX,0)),U,1)
170 . NEW TEMP SET TEMP=TMGTRIM_TMGSRCH_" -- "_TMGNAME
171 . SET TMGTEMP(TEMP,IEN_U_TEMP_U_U_U_U_TEMP)=""
172 . IF FROMIEN>0 SET TMGBYIEN(IEN)=IEN_U_TEMP_U_U_U_U_TEM
173 ;
174 KILL OUT
175 IF $DATA(TMGBYIEN) DO
176 . SET IEN=FROMIEN-DIR
177 . FOR SET IEN=$ORDER(TMGBYIEN(IEN),DIR) QUIT:(+IEN'>0)!(I=CNT) DO
178 . . SET I=I+1
179 . . SET OUT(I)=$GET(TMGBYIEN(IEN))
180 ELSE DO
181 . SET TMGTNAME=TMGTRIM_TMGSRCH_" -- "_TMGSRFROM
182 . FOR SET TMGTNAME=$ORDER(TMGTEMP(TMGTNAME),DIR) QUIT:TMGTNAME="" DO QUIT:I=CNT
183 . . NEW ENTRY SET ENTRY=""
184 . . FOR SET ENTRY=$ORDER(TMGTEMP(TMGTNAME,ENTRY),DIR) QUIT:ENTRY="" DO QUIT:I=CNT
185 . . . SET I=I+1
186 . . . SET OUT(I)=ENTRY
187 QUIT
188 ;
189HANDLEPHONE(OUT,FROM,DIR)
190 ;"PURPOSE: To handle patient lookup by telephone
191 ;"Gather ALL patients with specified DOB, so can be sorted alphabetically
192 ;"Results: 1 if handled, 0 if not handled.
193 NEW TEMP1,TEMP2,TEMP3,TEMPNUM,IEN,TMGNAME,TMGTNAME,TMGCH
194 SET FROM=$TRANSLATE(FROM,"~","")
195 IF (DIR=1) DO ;"Reverse CPRS's inc/dec of terminal digit if isolated date
196 . SET TMGCH=$E(FROM,$L(FROM))
197 . SET TMGCH=$CHAR($ASCII(TMGCH)+DIR)
198 . SET FROM=$E(FROM,1,$L(FROM)-1)_TMGCH
199 SET TEMPNUM=$TR(FROM,"(")
200 SET TEMPNUM=$TR(TEMPNUM," ")
201 SET TEMPNUM=$TR(TEMPNUM,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%^&*)-_=+[]{}<>,./?:;'\|")
202 SET TEMP1=$EXTRACT(TEMPNUM,1,3)
203 SET TEMP2=$EXTRACT(TEMPNUM,4,6)
204 SET TEMP3=$EXTRACT(TEMPNUM,7,99)
205 ;
206 NEW TMGIDX
207 FOR TMGIDX="AZVWVOE","ATMGPHONEWORK","ATMGPHONETEMP","ATMGPHONECELL" DO
208 . SET TEMPNUM=TEMP1_TEMP2_TEMP3
209 . DO DOLOOKUP(.TMGTEMP,TMGIDX,TEMPNUM,FROM)
210 . SET TEMPNUM=TEMP1_" "_TEMP2_" "_TEMP3
211 . DO DOLOOKUP(.TMGTEMP,TMGIDX,TEMPNUM,FROM)
212 . SET TEMPNUM=TEMP1_" "_TEMP2_TEMP3
213 . DO DOLOOKUP(.TMGTEMP,TMGIDX,TEMPNUM,FROM)
214 . SET TEMPNUM=TEMP1_TEMP2_" "_TEMP3
215 . DO DOLOOKUP(.TMGTEMP,TMGIDX,TEMPNUM,FROM)
216 ;
217 KILL OUT
218 SET TMGTNAME=FROM_" "_$$UP^XLFSTR($TRANSLATE(FROM,"~",""))
219 ;"Get sublist of patients starting at specified last name etc.
220 FOR SET TMGTNAME=$ORDER(TMGTEMP(TMGTNAME),DIR) QUIT:TMGTNAME="" DO QUIT:I=CNT
221 . NEW ENTRY SET ENTRY=""
222 . FOR SET ENTRY=$O(TMGTEMP(TMGTNAME,ENTRY),DIR) QUIT:ENTRY="" DO QUIT:I=CNT
223 . . SET I=I+1
224 . . SET OUT(I)=ENTRY
225 QUIT 1
226 ;
227DOLOOKUP(TMGTEMP,INDEX,ITEM,FROM)
228 NEW TMGNAME,IEN
229 SET IEN=0
230 FOR SET IEN=$ORDER(^DPT(INDEX,ITEM,IEN)) QUIT:'IEN DO
231 . SET TMGNAME=$P($G(^DPT(IEN,0)),U,1) ; Get zero node name.
232 . NEW TEMP SET TEMP=FROM_" "_TMGNAME
233 . SET TMGTEMP(TEMP,IEN_U_TEMP_U_U_U_U_TEMP)=""
234 . SET TMGSUBIEN=0
235 QUIT
236FIXINDEX ;
237 ;Check date of last run
238 ;if < 5 mins exit
239 ;loop through entry in Index
240 ;check entry for proper format
241 ;if improper format, then have fileman store new properly formatted number
242 ;store date of last run
243 ;
244SETRPC(TMGMODULE) ;
245 ;"Purpose: Set module for RPC call.
246 IF $GET(TMGMODULE)="" QUIT
247 NEW TMGDATA,TMGMSG
248 SET DIC(0)="B"
249 SET DIC=8994
250 SET X="ORWPT LIST ALL"
251 DO ^DIC
252 IF Y=-1 QUIT
253 SET TMGDATA(8994,$P(Y,U,1)_",",".03")=TMGMODULE
254 DO FILE^DIE("K","TMGDATA","TMGMSG")
255 QUIT
256 ;
257INSTWEDG ;
258 ;"Purpose: ROUTES RPC FOR CPRS PATIENT LOOKUP FROM ORWPT TO TMGHRPC2, IF IT EXISTS
259 DO SETRPC("TMGHRPC2") ;
260 QUIT
261 ;
262DELWEDG ;
263 ;"Purpose: ROUTES RPC FOR CPRS PATIENT LOOKUP FROM ORWPT TO TMGHRPC2, IF IT EXISTS
264 DO SETRPC("ORWPT") ;
265 QUIT
266
Note: See TracBrowser for help on using the repository browser.