source: cprs/branches/tmg-cprs/Server_KIDS/TMG-CPRS-LOOKUP-1.0-2.KIDS@ 1620

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

Adding patch for Custom CPRS patient Lookup

File size: 31.4 KB
RevLine 
[656]1KIDS Distribution saved on Nov 06, 2009@17:51
2This is Version 2 of the TMG CPRS LOOKUP
3**KIDS**:TMG-CPRS-LOOKUP*1.0*2^
4
5**INSTALL NAME**
6TMG-CPRS-LOOKUP*1.0*2
7"BLD",6143,0)
8TMG-CPRS-LOOKUP*1.0*2^^0^3091106^n
9"BLD",6143,1,0)
10^^1^1^3091029^^
11"BLD",6143,1,1,0)
12Enhanced CPRS Patient Lookup (DOB, Partial Name)
13"BLD",6143,4,0)
14^9.64PA^2^1
15"BLD",6143,4,2,0)
162
17"BLD",6143,4,2,2,0)
18^9.641^2^1
19"BLD",6143,4,2,2,2,0)
20PATIENT (File-top level)
21"BLD",6143,4,2,2,2,1,0)
22^9.6411^.131^4
23"BLD",6143,4,2,2,2,1,.1219,0)
24TEMPORARY PHONE NUMBER
25"BLD",6143,4,2,2,2,1,.131,0)
26PHONE NUMBER [RESIDENCE]
27"BLD",6143,4,2,2,2,1,.132,0)
28PHONE NUMBER [WORK]
29"BLD",6143,4,2,2,2,1,.134,0)
30PHONE NUMBER [CELLULAR]
31"BLD",6143,4,2,222)
32y^y^p^^^^n^^n
33"BLD",6143,4,2,224)
34
35"BLD",6143,4,"APDD",2,2)
36
37"BLD",6143,4,"APDD",2,2,.1219)
38
39"BLD",6143,4,"APDD",2,2,.131)
40
41"BLD",6143,4,"APDD",2,2,.132)
42
43"BLD",6143,4,"APDD",2,2,.134)
44
45"BLD",6143,4,"B",2,2)
46
47"BLD",6143,6.3)
483
49"BLD",6143,"INID")
50^n
51"BLD",6143,"INIT")
52INSTWEDG^TMGHRPC2
53"BLD",6143,"KRN",0)
54^9.67PA^8989.52^19
55"BLD",6143,"KRN",.4,0)
56.4
57"BLD",6143,"KRN",.401,0)
58.401
59"BLD",6143,"KRN",.402,0)
60.402
61"BLD",6143,"KRN",.403,0)
62.403
63"BLD",6143,"KRN",.5,0)
64.5
65"BLD",6143,"KRN",.84,0)
66.84
67"BLD",6143,"KRN",3.6,0)
683.6
69"BLD",6143,"KRN",3.8,0)
703.8
71"BLD",6143,"KRN",9.2,0)
729.2
73"BLD",6143,"KRN",9.8,0)
749.8
75"BLD",6143,"KRN",9.8,"NM",0)
76^9.68A^1^1
77"BLD",6143,"KRN",9.8,"NM",1,0)
78TMGHRPC2^^0^B18190063
79"BLD",6143,"KRN",9.8,"NM","B","TMGHRPC2",1)
80
81"BLD",6143,"KRN",19,0)
8219
83"BLD",6143,"KRN",19.1,0)
8419.1
85"BLD",6143,"KRN",101,0)
86101
87"BLD",6143,"KRN",409.61,0)
88409.61
89"BLD",6143,"KRN",771,0)
90771
91"BLD",6143,"KRN",870,0)
92870
93"BLD",6143,"KRN",8989.51,0)
948989.51
95"BLD",6143,"KRN",8989.52,0)
968989.52
97"BLD",6143,"KRN",8994,0)
988994
99"BLD",6143,"KRN","B",.4,.4)
100
101"BLD",6143,"KRN","B",.401,.401)
102
103"BLD",6143,"KRN","B",.402,.402)
104
105"BLD",6143,"KRN","B",.403,.403)
106
107"BLD",6143,"KRN","B",.5,.5)
108
109"BLD",6143,"KRN","B",.84,.84)
110
111"BLD",6143,"KRN","B",3.6,3.6)
112
113"BLD",6143,"KRN","B",3.8,3.8)
114
115"BLD",6143,"KRN","B",9.2,9.2)
116
117"BLD",6143,"KRN","B",9.8,9.8)
118
119"BLD",6143,"KRN","B",19,19)
120
121"BLD",6143,"KRN","B",19.1,19.1)
122
123"BLD",6143,"KRN","B",101,101)
124
125"BLD",6143,"KRN","B",409.61,409.61)
126
127"BLD",6143,"KRN","B",771,771)
128
129"BLD",6143,"KRN","B",870,870)
130
131"BLD",6143,"KRN","B",8989.51,8989.51)
132
133"BLD",6143,"KRN","B",8989.52,8989.52)
134
135"BLD",6143,"KRN","B",8994,8994)
136
137"BLD",6143,"QUES",0)
138^9.62^^
139"FIA",2)
140PATIENT
141"FIA",2,0)
142^DPT(
143"FIA",2,0,0)
1442I
145"FIA",2,0,1)
146y^y^p^^^^n^^n
147"FIA",2,0,10)
148
149"FIA",2,0,11)
150
151"FIA",2,0,"RLRO")
152
153"FIA",2,2)
1541
155"FIA",2,2,.1219)
156
157"FIA",2,2,.131)
158
159"FIA",2,2,.132)
160
161"FIA",2,2,.134)
162
163"INIT")
164INSTWEDG^TMGHRPC2
165"MBREQ")
1660
167"QUES","XPF1",0)
168Y
169"QUES","XPF1","??")
170^D REP^XPDH
171"QUES","XPF1","A")
172Shall I write over your |FLAG| File
173"QUES","XPF1","B")
174YES
175"QUES","XPF1","M")
176D XPF1^XPDIQ
177"QUES","XPF2",0)
178Y
179"QUES","XPF2","??")
180^D DTA^XPDH
181"QUES","XPF2","A")
182Want my data |FLAG| yours
183"QUES","XPF2","B")
184YES
185"QUES","XPF2","M")
186D XPF2^XPDIQ
187"QUES","XPI1",0)
188YO
189"QUES","XPI1","??")
190^D INHIBIT^XPDH
191"QUES","XPI1","A")
192Want KIDS to INHIBIT LOGONs during the install
193"QUES","XPI1","B")
194YES
195"QUES","XPI1","M")
196D XPI1^XPDIQ
197"QUES","XPM1",0)
198PO^VA(200,:EM
199"QUES","XPM1","??")
200^D MG^XPDH
201"QUES","XPM1","A")
202Enter the Coordinator for Mail Group '|FLAG|'
203"QUES","XPM1","B")
204
205"QUES","XPM1","M")
206D XPM1^XPDIQ
207"QUES","XPO1",0)
208Y
209"QUES","XPO1","??")
210^D MENU^XPDH
211"QUES","XPO1","A")
212Want KIDS to Rebuild Menu Trees Upon Completion of Install
213"QUES","XPO1","B")
214YES
215"QUES","XPO1","M")
216D XPO1^XPDIQ
217"QUES","XPZ1",0)
218Y
219"QUES","XPZ1","??")
220^D OPT^XPDH
221"QUES","XPZ1","A")
222Want to DISABLE Scheduled Options, Menu Options, and Protocols
223"QUES","XPZ1","B")
224YES
225"QUES","XPZ1","M")
226D XPZ1^XPDIQ
227"QUES","XPZ2",0)
228Y
229"QUES","XPZ2","??")
230^D RTN^XPDH
231"QUES","XPZ2","A")
232Want to MOVE routines to other CPUs
233"QUES","XPZ2","B")
234NO
235"QUES","XPZ2","M")
236D XPZ2^XPDIQ
237"RTN")
2381
239"RTN","TMGHRPC2")
2400^1^B18190063
241"RTN","TMGHRPC2",1,0)
242TMGHRPC2 ;TMG/elh/Support Functions for TMG_CPRS ;10/20/09
243"RTN","TMGHRPC2",2,0)
244 ;;1.0;TMG-LIB;**1**;10/20/09;Build 3
245"RTN","TMGHRPC2",3,0)
246 ;
247"RTN","TMGHRPC2",4,0)
248 ;"Eddie Hagood
249"RTN","TMGHRPC2",5,0)
250 ;"GNU Lessor General Public License (LGPL) applies
251"RTN","TMGHRPC2",6,0)
252 ;"10/20/09
253"RTN","TMGHRPC2",7,0)
254 ;
255"RTN","TMGHRPC2",8,0)
256 ;"=======================================================================
257"RTN","TMGHRPC2",9,0)
258 ;" RPC -- Public Functions.
259"RTN","TMGHRPC2",10,0)
260 ;"=======================================================================
261"RTN","TMGHRPC2",11,0)
262 ;" <none>
263"RTN","TMGHRPC2",12,0)
264 ;"=======================================================================
265"RTN","TMGHRPC2",13,0)
266 ;"PRIVATE API FUNCTIONS
267"RTN","TMGHRPC2",14,0)
268 ;"=======================================================================
269"RTN","TMGHRPC2",15,0)
270 ;" ;
271"RTN","TMGHRPC2",16,0)
272 ;"=======================================================================
273"RTN","TMGHRPC2",17,0)
274 ;"Dependencies:
275"RTN","TMGHRPC2",18,0)
276 ;" ;
277"RTN","TMGHRPC2",19,0)
278 ;"=======================================================================
279"RTN","TMGHRPC2",20,0)
280 ;
281"RTN","TMGHRPC2",21,0)
282LISTALL(Y,FROM,DIR) ; Return a bolus of patient names. From is either Name or IEN^Name.
283"RTN","TMGHRPC2",22,0)
284 merge ^TMG("TMP","RPC","LISTALL^TMGHRPC2","FROM")=FROM
285"RTN","TMGHRPC2",23,0)
286 merge ^TMG("TMP","RPC","LISTALL^TMGHRPC2","DIR")=DIR
287"RTN","TMGHRPC2",24,0)
288 ;"IF $EXTRACT(FROM,1)="." DO INEXACT(.Y,FROM,.DIR) QUIT
289"RTN","TMGHRPC2",25,0)
290 IF $$WEDGE^TMGHRPC2(.Y,FROM,.DIR) QUIT
291"RTN","TMGHRPC2",26,0)
292 IF FROM'="" DO INEXACT(.Y,FROM,.DIR) QUIT
293"RTN","TMGHRPC2",27,0)
294 DO LISTALL^ORWPT(.Y,.FROM,.DIR)
295"RTN","TMGHRPC2",28,0)
296 QUIT
297"RTN","TMGHRPC2",29,0)
298 ;
299"RTN","TMGHRPC2",30,0)
300WEDGE(OUT,FROM,DIR) ;
301"RTN","TMGHRPC2",31,0)
302 ;"Purpose: Return a bolus of patient names, handling a leading date
303"RTN","TMGHRPC2",32,0)
304 ;"Input: OUT -- Out parameter, pass by reference.
305"RTN","TMGHRPC2",33,0)
306 ;" FROM -- User specified string to search from.
307"RTN","TMGHRPC2",34,0)
308 ;" If in format of a date, then handled here. Otherwise
309"RTN","TMGHRPC2",35,0)
310 ;" this function quits, and handling will occur elsewhere
311"RTN","TMGHRPC2",36,0)
312 ;". Input can be either Name or IEN^Name (but later not
313"RTN","TMGHRPC2",37,0)
314 ;" handled here)
315"RTN","TMGHRPC2",38,0)
316 ;" Example of Input: '10/1/67 Too~'
317"RTN","TMGHRPC2",39,0)
318 ;" Note: CPRS decrements the terminal character of user
319"RTN","TMGHRPC2",40,0)
320 ;" input, and adds a ~
321"RTN","TMGHRPC2",41,0)
322 ;" DIR -- should be 1 or -1
323"RTN","TMGHRPC2",42,0)
324 ;"Results: 1 if handled, 0 if not handled.
325"RTN","TMGHRPC2",43,0)
326 ;"
327"RTN","TMGHRPC2",44,0)
328 NEW TMGCH,TMGTEMP,TMGTNAME,TMGSUBIEN,TMGB,TMGABORT
329"RTN","TMGHRPC2",45,0)
330 NEW I,IEN,CNT,FROMIEN,TMGNAME,TMGA,TMGANAME,TMGRESULT
331"RTN","TMGHRPC2",46,0)
332 NEW %DT,X,Y
333"RTN","TMGHRPC2",47,0)
334 SET CNT=44,I=0,TMGABORT=0
335"RTN","TMGHRPC2",48,0)
336 SET DIR=$GET(DIR,1)
337"RTN","TMGHRPC2",49,0)
338 SET TMGRESULT=0 ;"Default to failure
339"RTN","TMGHRPC2",50,0)
340 SET TMGA=$PIECE(FROM," ",1)
341"RTN","TMGHRPC2",51,0)
342 SET TMGB=$PIECE(FROM," ",2)
343"RTN","TMGHRPC2",52,0)
344 IF $$ISPHONE(FROM) QUIT $$HANDLEPHONE(.OUT,.FROM,.DIR)
345"RTN","TMGHRPC2",53,0)
346 IF $$ISMONTH(TMGA) DO
347"RTN","TMGHRPC2",54,0)
348 . NEW YEAR SET YEAR=$P(FROM," ",3)
349"RTN","TMGHRPC2",55,0)
350 . IF (YEAR?2.4N) DO
351"RTN","TMGHRPC2",56,0)
352 . . SET TMGA=$PIECE(FROM," ",1,3)
353"RTN","TMGHRPC2",57,0)
354 . . SET TMGB=$PIECE(FROM," ",4)
355"RTN","TMGHRPC2",58,0)
356 . ELSE DO
357"RTN","TMGHRPC2",59,0)
358 . . SET TMGA=$PIECE(FROM," ",1,2)
359"RTN","TMGHRPC2",60,0)
360 . . SET TMGB=$PIECE(FROM," ",3)
361"RTN","TMGHRPC2",61,0)
362 ELSE DO
363"RTN","TMGHRPC2",62,0)
364 . ;"Test for nN/nN/nnNN pattern
365"RTN","TMGHRPC2",63,0)
366 . IF '(TMGA?1.2N1(1"-",1"/")1.2N1(1"-",1"/")2.4E0.1"~") SET TMGABORT=1
367"RTN","TMGHRPC2",64,0)
368 IF TMGABORT GOTO WQ
369"RTN","TMGHRPC2",65,0)
370 SET TMGA=$TRANSLATE(TMGA,"~","")
371"RTN","TMGHRPC2",66,0)
372 IF (DIR=1),TMGB="" DO ;"Reverse CPRS's inc/dec of terminal digit if isolated date
373"RTN","TMGHRPC2",67,0)
374 . SET TMGCH=$E(TMGA,$L(TMGA))
375"RTN","TMGHRPC2",68,0)
376 . SET TMGCH=$CHAR($ASCII(TMGCH)+DIR)
377"RTN","TMGHRPC2",69,0)
378 . SET TMGA=$E(TMGA,1,$L(TMGA)-1)_TMGCH
379"RTN","TMGHRPC2",70,0)
380 SET %DT="P" ;"Assume past dates
381"RTN","TMGHRPC2",71,0)
382 SET X=TMGA
383"RTN","TMGHRPC2",72,0)
384 DO ^%DT ;"convert external date to FM Date
385"RTN","TMGHRPC2",73,0)
386 IF Y=-1 GOTO WQ
387"RTN","TMGHRPC2",74,0)
388 SET IEN=0
389"RTN","TMGHRPC2",75,0)
390 ;"Gather ALL patients with specified DOB, so can be sorted alphabetically
391"RTN","TMGHRPC2",76,0)
392 FOR SET IEN=$ORDER(^DPT("ADOB",Y,IEN)) QUIT:'IEN DO
393"RTN","TMGHRPC2",77,0)
394 . SET TMGNAME=$P($G(^DPT(IEN,0)),U,1) ; Get zero node name.
395"RTN","TMGHRPC2",78,0)
396 . NEW TEMP SET TEMP=TMGA_" "_TMGNAME
397"RTN","TMGHRPC2",79,0)
398 . SET TMGTEMP(TEMP,IEN_U_TEMP_U_U_U_U_TEMP)=""
399"RTN","TMGHRPC2",80,0)
400 . SET TMGSUBIEN=0
401"RTN","TMGHRPC2",81,0)
402 . FOR SET TMGSUBIEN=$O(^DPT(IEN,.01,TMGSUBIEN)) QUIT:TMGSUBIEN="" DO
403"RTN","TMGHRPC2",82,0)
404 . . SET TMGANAME=$P($G(^DPT(IEN,.01,TMGSUBIEN,0)),U,1)
405"RTN","TMGHRPC2",83,0)
406 . . NEW TEMP2 SET TEMP2=TMGA_" "_TMGANAME
407"RTN","TMGHRPC2",84,0)
408 . . SET TMGTEMP(TEMP2,IEN_U_TEMP2_U_U_U_U_TEMP)=""
409"RTN","TMGHRPC2",85,0)
410 ;
411"RTN","TMGHRPC2",86,0)
412 KILL OUT
413"RTN","TMGHRPC2",87,0)
414 SET TMGTNAME=TMGA_" "_$$UP^XLFSTR($TRANSLATE(TMGB,"~",""))
415"RTN","TMGHRPC2",88,0)
416 ;"Get sublist of patients starting at specified last name etc.
417"RTN","TMGHRPC2",89,0)
418 FOR SET TMGTNAME=$ORDER(TMGTEMP(TMGTNAME),DIR) QUIT:TMGTNAME="" DO QUIT:I=CNT
419"RTN","TMGHRPC2",90,0)
420 . NEW ENTRY SET ENTRY=""
421"RTN","TMGHRPC2",91,0)
422 . FOR SET ENTRY=$O(TMGTEMP(TMGTNAME,ENTRY),DIR) QUIT:ENTRY="" DO QUIT:I=CNT
423"RTN","TMGHRPC2",92,0)
424 . . SET I=I+1
425"RTN","TMGHRPC2",93,0)
426 . . SET OUT(I)=ENTRY
427"RTN","TMGHRPC2",94,0)
428 SET TMGRESULT=1
429"RTN","TMGHRPC2",95,0)
430 GOTO WQ
431"RTN","TMGHRPC2",96,0)
432 ;
433"RTN","TMGHRPC2",97,0)
434WQ QUIT TMGRESULT
435"RTN","TMGHRPC2",98,0)
436 ;
437"RTN","TMGHRPC2",99,0)
438ISMONTH(S)
439"RTN","TMGHRPC2",100,0)
440 ;"Purpose: to determine if S is a string specifying a month.
441"RTN","TMGHRPC2",101,0)
442 ;"Input: S -- the string to test. It is altered, so don't pass by reference
443"RTN","TMGHRPC2",102,0)
444 ;"Results: 1 if is a month name, or 0 if not.
445"RTN","TMGHRPC2",103,0)
446 SET S=$$UP^XLFSTR(S)
447"RTN","TMGHRPC2",104,0)
448 SET S=$TRANSLATE(S,".","")
449"RTN","TMGHRPC2",105,0)
450 IF S="JANUARY"!(S="JAN") QUIT 1
451"RTN","TMGHRPC2",106,0)
452 IF S="FEBRUARY"!(S="FEB") QUIT 1
453"RTN","TMGHRPC2",107,0)
454 IF S="MARCH"!(S="MAR") QUIT 1
455"RTN","TMGHRPC2",108,0)
456 IF S="APRIL"!(S="APR") QUIT 1
457"RTN","TMGHRPC2",109,0)
458 IF S="MAY" QUIT 1
459"RTN","TMGHRPC2",110,0)
460 IF S="JUNE"!(S="JUN") QUIT 1
461"RTN","TMGHRPC2",111,0)
462 IF S="JULY"!(S="JUL") QUIT 1
463"RTN","TMGHRPC2",112,0)
464 IF S="AUGUST"!(S="AUG") QUIT 1
465"RTN","TMGHRPC2",113,0)
466 IF S="SEPTEMBER"!(S="SEP")!(S="SEPT") QUIT 1
467"RTN","TMGHRPC2",114,0)
468 IF S="OCTOBER"!(S="OCT") QUIT 1
469"RTN","TMGHRPC2",115,0)
470 IF S="NOVEMBER"!(S="NOV") QUIT 1
471"RTN","TMGHRPC2",116,0)
472 IF S="DECEMBER"!(S="DEC") QUIT 1
473"RTN","TMGHRPC2",117,0)
474 QUIT 0
475"RTN","TMGHRPC2",118,0)
476 ;
477"RTN","TMGHRPC2",119,0)
478ISPHONE(S)
479"RTN","TMGHRPC2",120,0)
480 ;"Purpose: to determine is S is a phone number.
481"RTN","TMGHRPC2",121,0)
482 ;"Input: S -- the string to test.
483"RTN","TMGHRPC2",122,0)
484 ;"Results: 1 if a phone number, or 0 if not.
485"RTN","TMGHRPC2",123,0)
486 IF (S?3N1(1"-",1" ")3N1(1"-",1" ")1.4N.E) QUIT 1
487"RTN","TMGHRPC2",124,0)
488 ;IF (S?3N1(1"-",1" ")3.4N.E) QUIT 1
489"RTN","TMGHRPC2",125,0)
490 IF $EXTRACT(S,1)="(" QUIT 1
491"RTN","TMGHRPC2",126,0)
492 QUIT 0
493"RTN","TMGHRPC2",127,0)
494 ;
495"RTN","TMGHRPC2",128,0)
496INEXACT(OUT,FROM,DIR)
497"RTN","TMGHRPC2",129,0)
498 ;"Purpose: To perform an inexact, old-style Fileman lookup on user input
499"RTN","TMGHRPC2",130,0)
500 ;"Input: OUT -- Out parameter, pass by reference.
501"RTN","TMGHRPC2",131,0)
502 ;" FROM -- User specified string to search from.
503"RTN","TMGHRPC2",132,0)
504 ;". Input can be either Name or IEN^Name
505"RTN","TMGHRPC2",133,0)
506 ;" Example of Input: '.Smit,Joh~'
507"RTN","TMGHRPC2",134,0)
508 ;" Note: CPRS decrements the terminal character of user
509"RTN","TMGHRPC2",135,0)
510 ;" input, and adds a ~
511"RTN","TMGHRPC2",136,0)
512 ;" DIR -- should be 1 or -1
513"RTN","TMGHRPC2",137,0)
514 ;"Results: NONE
515"RTN","TMGHRPC2",138,0)
516 ;
517"RTN","TMGHRPC2",139,0)
518 NEW I,IEN,CNT,FROMIEN
519"RTN","TMGHRPC2",140,0)
520 SET CNT=44,I=0,FROMIEN=0
521"RTN","TMGHRPC2",141,0)
522 SET DIR=$GET(DIR,1)
523"RTN","TMGHRPC2",142,0)
524 NEW TMGCH,TMGTRIM SET TMGTRIM=""
525"RTN","TMGHRPC2",143,0)
526 ;"Trim any leading '.' or ' '
527"RTN","TMGHRPC2",144,0)
528 FOR SET TMGCH=$EXTRACT(FROM,1) QUIT:(". "'[TMGCH) DO
529"RTN","TMGHRPC2",145,0)
530 . SET TMGTRIM=TMGTRIM_$EXTRACT(FROM,1)
531"RTN","TMGHRPC2",146,0)
532 . SET FROM=$EXTRACT(FROM,2,999)
533"RTN","TMGHRPC2",147,0)
534 IF $PIECE(FROM,U,2)'="" DO
535"RTN","TMGHRPC2",148,0)
536 . SET FROM=$PIECE(FROM,U,2)
537"RTN","TMGHRPC2",149,0)
538 . SET FROMIEN=$PIECE(FROM,U,1)
539"RTN","TMGHRPC2",150,0)
540 NEW TMGSRCH SET TMGSRCH=$TRANSLATE(FROM,"~","")
541"RTN","TMGHRPC2",151,0)
542 NEW TMGSRFROM SET TMGSRFROM=""
543"RTN","TMGHRPC2",152,0)
544 IF TMGSRCH[" -- " DO
545"RTN","TMGHRPC2",153,0)
546 . SET TMGSRFROM=$PIECE(TMGSRCH," -- ",2)
547"RTN","TMGHRPC2",154,0)
548 . SET TMGSRCH=$PIECE(TMGSRCH," -- ",1)
549"RTN","TMGHRPC2",155,0)
550 IF (DIR=1),(TMGSRFROM="") DO ;"Reverse CPRS's inc/dec of terminal digit
551"RTN","TMGHRPC2",156,0)
552 . SET TMGCH=$EXTRACT(TMGSRCH,$LENGTH(TMGSRCH))
553"RTN","TMGHRPC2",157,0)
554 . SET TMGCH=$CHAR($ASCII(TMGCH)+DIR)
555"RTN","TMGHRPC2",158,0)
556 . SET TMGSRCH=$EXTRACT(TMGSRCH,1,$LENGTH(TMGSRCH)-1)_TMGCH
557"RTN","TMGHRPC2",159,0)
558 NEW TMGOUT,TMGMSG
559"RTN","TMGHRPC2",160,0)
560 DO FIND^DIC(2,,"@;.01","PBC",TMGSRCH,"*",,,,"TMGOUT","TMGMSG")
561"RTN","TMGHRPC2",161,0)
562 KILL OUT
563"RTN","TMGHRPC2",162,0)
564 IF +TMGOUT("DILIST",0)'>0 QUIT ;"No matches found.
565"RTN","TMGHRPC2",163,0)
566 ;
567"RTN","TMGHRPC2",164,0)
568 ;"Gather ALL matching patients so can be sorted alphabetically
569"RTN","TMGHRPC2",165,0)
570 NEW TMGBYIEN,TMGTEMP
571"RTN","TMGHRPC2",166,0)
572 NEW TMGIDX SET TMGIDX=0
573"RTN","TMGHRPC2",167,0)
574 FOR SET TMGIDX=$ORDER(TMGOUT("DILIST",TMGIDX)) QUIT:(TMGIDX="") DO
575"RTN","TMGHRPC2",168,0)
576 . SET TMGNAME=$PIECE($GET(TMGOUT("DILIST",TMGIDX,0)),U,2)
577"RTN","TMGHRPC2",169,0)
578 . SET IEN=+$PIECE($GET(TMGOUT("DILIST",TMGIDX,0)),U,1)
579"RTN","TMGHRPC2",170,0)
580 . NEW TEMP SET TEMP=TMGTRIM_TMGSRCH_" -- "_TMGNAME
581"RTN","TMGHRPC2",171,0)
582 . SET TMGTEMP(TEMP,IEN_U_TEMP_U_U_U_U_TEMP)=""
583"RTN","TMGHRPC2",172,0)
584 . IF FROMIEN>0 SET TMGBYIEN(IEN)=IEN_U_TEMP_U_U_U_U_TEM
585"RTN","TMGHRPC2",173,0)
586 ;
587"RTN","TMGHRPC2",174,0)
588 KILL OUT
589"RTN","TMGHRPC2",175,0)
590 IF $DATA(TMGBYIEN) DO
591"RTN","TMGHRPC2",176,0)
592 . SET IEN=FROMIEN-DIR
593"RTN","TMGHRPC2",177,0)
594 . FOR SET IEN=$ORDER(TMGBYIEN(IEN),DIR) QUIT:(+IEN'>0)!(I=CNT) DO
595"RTN","TMGHRPC2",178,0)
596 . . SET I=I+1
597"RTN","TMGHRPC2",179,0)
598 . . SET OUT(I)=$GET(TMGBYIEN(IEN))
599"RTN","TMGHRPC2",180,0)
600 ELSE DO
601"RTN","TMGHRPC2",181,0)
602 . SET TMGTNAME=TMGTRIM_TMGSRCH_" -- "_TMGSRFROM
603"RTN","TMGHRPC2",182,0)
604 . FOR SET TMGTNAME=$ORDER(TMGTEMP(TMGTNAME),DIR) QUIT:TMGTNAME="" DO QUIT:I=CNT
605"RTN","TMGHRPC2",183,0)
606 . . NEW ENTRY SET ENTRY=""
607"RTN","TMGHRPC2",184,0)
608 . . FOR SET ENTRY=$ORDER(TMGTEMP(TMGTNAME,ENTRY),DIR) QUIT:ENTRY="" DO QUIT:I=CNT
609"RTN","TMGHRPC2",185,0)
610 . . . SET I=I+1
611"RTN","TMGHRPC2",186,0)
612 . . . SET OUT(I)=ENTRY
613"RTN","TMGHRPC2",187,0)
614 QUIT
615"RTN","TMGHRPC2",188,0)
616 ;
617"RTN","TMGHRPC2",189,0)
618HANDLEPHONE(OUT,FROM,DIR)
619"RTN","TMGHRPC2",190,0)
620 ;"PURPOSE: To handle patient lookup by telephone
621"RTN","TMGHRPC2",191,0)
622 ;"Gather ALL patients with specified DOB, so can be sorted alphabetically
623"RTN","TMGHRPC2",192,0)
624 ;"Results: 1 if handled, 0 if not handled.
625"RTN","TMGHRPC2",193,0)
626 NEW TEMP1,TEMP2,TEMP3,TEMPNUM,IEN,TMGNAME,TMGTNAME,TMGCH
627"RTN","TMGHRPC2",194,0)
628 SET FROM=$TRANSLATE(FROM,"~","")
629"RTN","TMGHRPC2",195,0)
630 IF (DIR=1) DO ;"Reverse CPRS's inc/dec of terminal digit if isolated date
631"RTN","TMGHRPC2",196,0)
632 . SET TMGCH=$E(FROM,$L(FROM))
633"RTN","TMGHRPC2",197,0)
634 . SET TMGCH=$CHAR($ASCII(TMGCH)+DIR)
635"RTN","TMGHRPC2",198,0)
636 . SET FROM=$E(FROM,1,$L(FROM)-1)_TMGCH
637"RTN","TMGHRPC2",199,0)
638 SET TEMPNUM=$TR(FROM,"(")
639"RTN","TMGHRPC2",200,0)
640 SET TEMPNUM=$TR(TEMPNUM," ")
641"RTN","TMGHRPC2",201,0)
642 SET TEMPNUM=$TR(TEMPNUM,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%^&*)-_=+[]{}<>,./?:;'\|")
643"RTN","TMGHRPC2",202,0)
644 SET TEMP1=$EXTRACT(TEMPNUM,1,3)
645"RTN","TMGHRPC2",203,0)
646 SET TEMP2=$EXTRACT(TEMPNUM,4,6)
647"RTN","TMGHRPC2",204,0)
648 SET TEMP3=$EXTRACT(TEMPNUM,7,99)
649"RTN","TMGHRPC2",205,0)
650 ;
651"RTN","TMGHRPC2",206,0)
652 NEW TMGIDX
653"RTN","TMGHRPC2",207,0)
654 FOR TMGIDX="AZVWVOE","ATMGPHONEWORK","ATMGPHONETEMP","ATMGPHONECELL" DO
655"RTN","TMGHRPC2",208,0)
656 . SET TEMPNUM=TEMP1_TEMP2_TEMP3
657"RTN","TMGHRPC2",209,0)
658 . DO DOLOOKUP(.TMGTEMP,TMGIDX,TEMPNUM,FROM)
659"RTN","TMGHRPC2",210,0)
660 . SET TEMPNUM=TEMP1_" "_TEMP2_" "_TEMP3
661"RTN","TMGHRPC2",211,0)
662 . DO DOLOOKUP(.TMGTEMP,TMGIDX,TEMPNUM,FROM)
663"RTN","TMGHRPC2",212,0)
664 . SET TEMPNUM=TEMP1_" "_TEMP2_TEMP3
665"RTN","TMGHRPC2",213,0)
666 . DO DOLOOKUP(.TMGTEMP,TMGIDX,TEMPNUM,FROM)
667"RTN","TMGHRPC2",214,0)
668 . SET TEMPNUM=TEMP1_TEMP2_" "_TEMP3
669"RTN","TMGHRPC2",215,0)
670 . DO DOLOOKUP(.TMGTEMP,TMGIDX,TEMPNUM,FROM)
671"RTN","TMGHRPC2",216,0)
672 ;
673"RTN","TMGHRPC2",217,0)
674 KILL OUT
675"RTN","TMGHRPC2",218,0)
676 SET TMGTNAME=FROM_" "_$$UP^XLFSTR($TRANSLATE(FROM,"~",""))
677"RTN","TMGHRPC2",219,0)
678 ;"Get sublist of patients starting at specified last name etc.
679"RTN","TMGHRPC2",220,0)
680 FOR SET TMGTNAME=$ORDER(TMGTEMP(TMGTNAME),DIR) QUIT:TMGTNAME="" DO QUIT:I=CNT
681"RTN","TMGHRPC2",221,0)
682 . NEW ENTRY SET ENTRY=""
683"RTN","TMGHRPC2",222,0)
684 . FOR SET ENTRY=$O(TMGTEMP(TMGTNAME,ENTRY),DIR) QUIT:ENTRY="" DO QUIT:I=CNT
685"RTN","TMGHRPC2",223,0)
686 . . SET I=I+1
687"RTN","TMGHRPC2",224,0)
688 . . SET OUT(I)=ENTRY
689"RTN","TMGHRPC2",225,0)
690 QUIT 1
691"RTN","TMGHRPC2",226,0)
692 ;
693"RTN","TMGHRPC2",227,0)
694DOLOOKUP(TMGTEMP,INDEX,ITEM,FROM)
695"RTN","TMGHRPC2",228,0)
696 NEW TMGNAME,IEN
697"RTN","TMGHRPC2",229,0)
698 SET IEN=0
699"RTN","TMGHRPC2",230,0)
700 FOR SET IEN=$ORDER(^DPT(INDEX,ITEM,IEN)) QUIT:'IEN DO
701"RTN","TMGHRPC2",231,0)
702 . SET TMGNAME=$P($G(^DPT(IEN,0)),U,1) ; Get zero node name.
703"RTN","TMGHRPC2",232,0)
704 . NEW TEMP SET TEMP=FROM_" "_TMGNAME
705"RTN","TMGHRPC2",233,0)
706 . SET TMGTEMP(TEMP,IEN_U_TEMP_U_U_U_U_TEMP)=""
707"RTN","TMGHRPC2",234,0)
708 . SET TMGSUBIEN=0
709"RTN","TMGHRPC2",235,0)
710 QUIT
711"RTN","TMGHRPC2",236,0)
712FIXINDEX ;
713"RTN","TMGHRPC2",237,0)
714 ;Check date of last run
715"RTN","TMGHRPC2",238,0)
716 ;if < 5 mins exit
717"RTN","TMGHRPC2",239,0)
718 ;loop through entry in Index
719"RTN","TMGHRPC2",240,0)
720 ;check entry for proper format
721"RTN","TMGHRPC2",241,0)
722 ;if improper format, then have fileman store new properly formatted number
723"RTN","TMGHRPC2",242,0)
724 ;store date of last run
725"RTN","TMGHRPC2",243,0)
726 ;
727"RTN","TMGHRPC2",244,0)
728SETRPC(TMGMODULE) ;
729"RTN","TMGHRPC2",245,0)
730 ;"Purpose: Set module for RPC call.
731"RTN","TMGHRPC2",246,0)
732 IF $GET(TMGMODULE)="" QUIT
733"RTN","TMGHRPC2",247,0)
734 NEW TMGDATA,TMGMSG
735"RTN","TMGHRPC2",248,0)
736 SET DIC(0)="B"
737"RTN","TMGHRPC2",249,0)
738 SET DIC=8994
739"RTN","TMGHRPC2",250,0)
740 SET X="ORWPT LIST ALL"
741"RTN","TMGHRPC2",251,0)
742 DO ^DIC
743"RTN","TMGHRPC2",252,0)
744 IF Y=-1 QUIT
745"RTN","TMGHRPC2",253,0)
746 SET TMGDATA(8994,$P(Y,U,1)_",",".03")=TMGMODULE
747"RTN","TMGHRPC2",254,0)
748 DO FILE^DIE("K","TMGDATA","TMGMSG")
749"RTN","TMGHRPC2",255,0)
750 QUIT
751"RTN","TMGHRPC2",256,0)
752 ;
753"RTN","TMGHRPC2",257,0)
754INSTWEDG ;
755"RTN","TMGHRPC2",258,0)
756 ;"Purpose: ROUTES RPC FOR CPRS PATIENT LOOKUP FROM ORWPT TO TMGHRPC2, IF IT EXISTS
757"RTN","TMGHRPC2",259,0)
758 DO SETRPC("TMGHRPC2") ;
759"RTN","TMGHRPC2",260,0)
760 QUIT
761"RTN","TMGHRPC2",261,0)
762 ;
763"RTN","TMGHRPC2",262,0)
764DELWEDG ;
765"RTN","TMGHRPC2",263,0)
766 ;"Purpose: ROUTES RPC FOR CPRS PATIENT LOOKUP FROM ORWPT TO TMGHRPC2, IF IT EXISTS
767"RTN","TMGHRPC2",264,0)
768 DO SETRPC("ORWPT") ;
769"RTN","TMGHRPC2",265,0)
770 QUIT
771"RTN","TMGHRPC2",266,0)
772
773"VER")
7748.0^22.0
775"^DD",2,2,.1219,0)
776TEMPORARY PHONE NUMBER^FX^^.121;10^K:$L(X)>20!($L(X)<4) X I $D(X) S DFN=DA D TAD^DGLOCK
777"^DD",2,2,.1219,.1)
778
779"^DD",2,2,.1219,1,0)
780^.1
781"^DD",2,2,.1219,1,22700,0)
7822^ATMGPHONETEMP
783"^DD",2,2,.1219,1,22700,1)
784N % S %=$E($TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%^&*()-_=+[]{}<>,./?:;'\|"),1,30) S:%'="" ^DPT("ATMGPHONETEMP",%,DA)=""
785"^DD",2,2,.1219,1,22700,2)
786N % S %=$E($TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%^&*()-_=+[]{}<>,./?:;'\|"),1,30) K:%'="" ^DPT("ATMGPHONETEMP",%,DA)
787"^DD",2,2,.1219,1,22700,"%D",0)
788^^2^2^3091106^^
789"^DD",2,2,.1219,1,22700,"%D",1,0)
790Created by K. Toppenberg (TMG) for lookup
791"^DD",2,2,.1219,1,22700,"%D",2,0)
792based on temp phone number
793"^DD",2,2,.1219,1,22700,"DT")
7943091106
795"^DD",2,2,.1219,3)
796Enter the telephone number of the temporary address at which the patient is located [4-20 characters].
797"^DD",2,2,.1219,20,0)
798^.3LA^1^1
799"^DD",2,2,.1219,20,1,0)
800TAD
801"^DD",2,2,.1219,21,0)
802^^5^5^2861007^^
803"^DD",2,2,.1219,21,1,0)
804If the WANT TO ENTER A TEMPORARY ADDRESS prompt is answered YES
805"^DD",2,2,.1219,21,2,0)
806enter the telephone number at which the applicant can be
807"^DD",2,2,.1219,21,3,0)
808contacted [4-20 characters] during his/her absence from permanent
809"^DD",2,2,.1219,21,4,0)
810residence, otherwise nothing may be entered. This field may not
811"^DD",2,2,.1219,21,5,0)
812be deleted as long as the need for a temporary address is indicated.
813"^DD",2,2,.1219,"DT")
8143091106
815"^DD",2,2,.131,0)
816PHONE NUMBER [RESIDENCE]^Fa^^.13;1^K:$L(X)>20!($L(X)<4) X
817"^DD",2,2,.131,.1)
818
819"^DD",2,2,.131,1,0)
820^.1^^-1
821"^DD",2,2,.131,1,1,0)
8222^AENR131^MUMPS
823"^DD",2,2,.131,1,1,1)
824D EVENT^IVMPLOG(DA)
825"^DD",2,2,.131,1,1,2)
826D EVENT^IVMPLOG(DA)
827"^DD",2,2,.131,1,1,3)
828DO NOT DELETE
829"^DD",2,2,.131,1,1,"%D",0)
830^^2^2^2971007^^^
831"^DD",2,2,.131,1,1,"%D",1,0)
832This cross-reference is used to notify HEC of changes that may affect
833"^DD",2,2,.131,1,1,"%D",2,0)
834enrollment.
835"^DD",2,2,.131,1,1,"DT")
8362971007
837"^DD",2,2,.131,1,301,0)
8382^IVM131^MUMPS
839"^DD",2,2,.131,1,301,1)
840S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
841"^DD",2,2,.131,1,301,2)
842S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
843"^DD",2,2,.131,1,301,"%D",0)
844^^5^5^2930605^
845"^DD",2,2,.131,1,301,"%D",1,0)
846This cross-reference will check the IVM PATIENT file to see if a change
847"^DD",2,2,.131,1,301,"%D",2,0)
848to this field will require transmission to the IVM Center. If it does,
849"^DD",2,2,.131,1,301,"%D",3,0)
850the IVM PATIENT file entry's TRANSMISSION STATUS will be set to 0 and
851"^DD",2,2,.131,1,301,"%D",4,0)
852the nightly background job will transmit the updated information.
853"^DD",2,2,.131,1,301,"DT")
8542930605
855"^DD",2,2,.131,1,991,0)
8562^AVAFC131^MUMPS
857"^DD",2,2,.131,1,991,1)
858I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".131;" D AVAFC^VAFCDD01(DA)
859"^DD",2,2,.131,1,991,2)
860I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".131;" D AVAFC^VAFCDD01(DA)
861"^DD",2,2,.131,1,991,"%D",0)
862^^15^15^2990204^^^^
863"^DD",2,2,.131,1,991,"%D",1,0)
864This cross reference is used to remember that changes were made to the
865"^DD",2,2,.131,1,991,"%D",2,0)
866PATIENT file (#2) outside of the Registration process. Execution of this
867"^DD",2,2,.131,1,991,"%D",3,0)
868cross reference will create an entry in the ADT/HL7 PIVOT file (#391.71)
869"^DD",2,2,.131,1,991,"%D",4,0)
870and mark it as requiring transmission of an HL7 ADT-A08 message.
871"^DD",2,2,.131,1,991,"%D",5,0)
872
873"^DD",2,2,.131,1,991,"%D",6,0)
874The local variable VAFCFLG will be set to 1 if the cross reference is
875"^DD",2,2,.131,1,991,"%D",7,0)
876not executed because the change is being made from within the Registration
877"^DD",2,2,.131,1,991,"%D",8,0)
878process.
879"^DD",2,2,.131,1,991,"%D",9,0)
880
881"^DD",2,2,.131,1,991,"%D",10,0)
882Execution of this cross reference can be prevented by setting the local
883"^DD",2,2,.131,1,991,"%D",11,0)
884variable VAFCA08 equal to 1.
885"^DD",2,2,.131,1,991,"%D",12,0)
886
887"^DD",2,2,.131,1,991,"%D",13,0)
888The local variable VAFCF is used to identify the field edited.
889"^DD",2,2,.131,1,991,"%D",14,0)
890This data is stored in the FIELD(S) EDITED (#2.1) field in the
891"^DD",2,2,.131,1,991,"%D",15,0)
892ADT/HL7 PIVOT file (#391.71).
893"^DD",2,2,.131,1,991,"DT")
8942970825
895"^DD",2,2,.131,1,992,0)
8962^ADGRU131^MUMPS
897"^DD",2,2,.131,1,992,1)
898D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
899"^DD",2,2,.131,1,992,2)
900D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
901"^DD",2,2,.131,1,992,"%D",0)
902^^9^9^2990920^
903"^DD",2,2,.131,1,992,"%D",1,0)
904This cross reference is used to remember that changes were made to a
905"^DD",2,2,.131,1,992,"%D",2,0)
906monitored data field in the PATIENT File (#2) required for a vendor
907"^DD",2,2,.131,1,992,"%D",3,0)
908RAI/MDS COTS system. Execution of this cross reference will create
909"^DD",2,2,.131,1,992,"%D",4,0)
910an entry in the ADT/HL7 PIVOT file (#391.71) and mark it as requiring
911"^DD",2,2,.131,1,992,"%D",5,0)
912transmission of an HL7 demographic A08 update message to the COTS
913"^DD",2,2,.131,1,992,"%D",6,0)
914interface.
915"^DD",2,2,.131,1,992,"%D",7,0)
916
917"^DD",2,2,.131,1,992,"%D",8,0)
918The local variable DGRUGA08 will be set to 1 if the cross reference is
919"^DD",2,2,.131,1,992,"%D",9,0)
920not to be executed as part of a re-indexing.
921"^DD",2,2,.131,1,992,"DT")
9222990920
923"^DD",2,2,.131,1,251000,0)
9242^AZVWVOE^MUMPS
925"^DD",2,2,.131,1,251000,1)
926N % S %=$E($TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%^&*()-_=+[]{}<>,./?:;'\|"),1,30) S:%'="" ^DPT("AZVWVOE",%,DA)=""
927"^DD",2,2,.131,1,251000,2)
928N % S %=$E($TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%^&*()-_=+[]{}<>,./?:;'\|"),1,30) K:%'="" ^DPT("AZVWVOE",%,DA)
929"^DD",2,2,.131,1,251000,"%D",0)
930^^1^1^3061220^
931"^DD",2,2,.131,1,251000,"%D",1,0)
932CREATED BY TIMSON FOR PATIENT LOOKUP BY PHONE NUMBER
933"^DD",2,2,.131,1,251000,"DT")
9343061220
935"^DD",2,2,.131,3)
936Enter the patients home telephone number [4-20 characters].
937"^DD",2,2,.131,20,0)
938^.3LA^1^1
939"^DD",2,2,.131,20,1,0)
940DEMOG
941"^DD",2,2,.131,21,0)
942^^2^2^2861007^
943"^DD",2,2,.131,21,1,0)
944Enter the telephone number [4-20 characters] to this applicant's
945"^DD",2,2,.131,21,2,0)
946place of residence.
947"^DD",2,2,.131,"AUDIT")
948y
949"^DD",2,2,.131,"DT")
9502980520
951"^DD",2,2,.132,0)
952PHONE NUMBER [WORK]^Fa^^.13;2^K:$L(X)>20!($L(X)<4) X
953"^DD",2,2,.132,.1)
954OFFICE PHONE
955"^DD",2,2,.132,1,0)
956^.1
957"^DD",2,2,.132,1,1,0)
9582^AENR132^MUMPS
959"^DD",2,2,.132,1,1,1)
960D EVENT^IVMPLOG(DA)
961"^DD",2,2,.132,1,1,2)
962D EVENT^IVMPLOG(DA)
963"^DD",2,2,.132,1,1,3)
964DO NOT DELETE
965"^DD",2,2,.132,1,1,"%D",0)
966^^2^2^2971007^^^
967"^DD",2,2,.132,1,1,"%D",1,0)
968This cross-reference is used to notify HEC of changes that may affect
969"^DD",2,2,.132,1,1,"%D",2,0)
970enrollment.
971"^DD",2,2,.132,1,1,"DT")
9722971007
973"^DD",2,2,.132,1,301,0)
9742^IVM132^MUMPS
975"^DD",2,2,.132,1,301,1)
976S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
977"^DD",2,2,.132,1,301,2)
978S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX K IVMX
979"^DD",2,2,.132,1,301,"%D",0)
980^^5^5^2930605^
981"^DD",2,2,.132,1,301,"%D",1,0)
982This cross-reference will check the IVM PATIENT file to see if a change
983"^DD",2,2,.132,1,301,"%D",2,0)
984to this field will require transmission to the IVM Center. If it does,
985"^DD",2,2,.132,1,301,"%D",3,0)
986the IVM PATIENT file entry's TRANSMISSION STATUS will be set to 0 and
987"^DD",2,2,.132,1,301,"%D",4,0)
988the nightly background job will transmit the updated information.
989"^DD",2,2,.132,1,301,"DT")
9902930605
991"^DD",2,2,.132,1,991,0)
9922^AVAFC132^MUMPS
993"^DD",2,2,.132,1,991,1)
994I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".132;" D AVAFC^VAFCDD01(DA)
995"^DD",2,2,.132,1,991,2)
996I ($T(AVAFC^VAFCDD01)'="") S VAFCF=".132;" D AVAFC^VAFCDD01(DA)
997"^DD",2,2,.132,1,991,"%D",0)
998^^15^15^2990204^^^^
999"^DD",2,2,.132,1,991,"%D",1,0)
1000This cross reference is used to remember that changes were made to the
1001"^DD",2,2,.132,1,991,"%D",2,0)
1002PATIENT file (#2) outside of the Registration process. Execution of this
1003"^DD",2,2,.132,1,991,"%D",3,0)
1004cross reference will create an entry in the ADT/HL7 PIVOT file (#391.71)
1005"^DD",2,2,.132,1,991,"%D",4,0)
1006and mark it as requiring transmission of an HL7 ADT-A08 message.
1007"^DD",2,2,.132,1,991,"%D",5,0)
1008
1009"^DD",2,2,.132,1,991,"%D",6,0)
1010The local variable VAFCFLG will be set to 1 if the cross reference is
1011"^DD",2,2,.132,1,991,"%D",7,0)
1012not executed because the change is being made from within the Registration
1013"^DD",2,2,.132,1,991,"%D",8,0)
1014process.
1015"^DD",2,2,.132,1,991,"%D",9,0)
1016
1017"^DD",2,2,.132,1,991,"%D",10,0)
1018Execution of this cross reference can be prevented by setting the local
1019"^DD",2,2,.132,1,991,"%D",11,0)
1020variable VAFCA08 equal to 1.
1021"^DD",2,2,.132,1,991,"%D",12,0)
1022
1023"^DD",2,2,.132,1,991,"%D",13,0)
1024The local variable VAFCF is used to identify the field edited.
1025"^DD",2,2,.132,1,991,"%D",14,0)
1026This data is stored in the FIELD(S) EDITED (#2.1) field in the
1027"^DD",2,2,.132,1,991,"%D",15,0)
1028ADT/HL7 PIVOT file (#391.71).
1029"^DD",2,2,.132,1,991,"DT")
10302970825
1031"^DD",2,2,.132,1,992,0)
10322^ADGRU132^MUMPS
1033"^DD",2,2,.132,1,992,1)
1034D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
1035"^DD",2,2,.132,1,992,2)
1036D:($T(ADGRU^DGRUDD01)'="") ADGRU^DGRUDD01(DA)
1037"^DD",2,2,.132,1,992,"%D",0)
1038^^9^9^2990920^
1039"^DD",2,2,.132,1,992,"%D",1,0)
1040This cross reference is used to remember that changes were made to a
1041"^DD",2,2,.132,1,992,"%D",2,0)
1042monitored data field in the PATIENT File (#2) required for a vendor
1043"^DD",2,2,.132,1,992,"%D",3,0)
1044RAI/MDS COTS system. Execution of this cross reference will create
1045"^DD",2,2,.132,1,992,"%D",4,0)
1046an entry in the ADT/HL7 PIVOT file (#391.71) and mark it as requiring
1047"^DD",2,2,.132,1,992,"%D",5,0)
1048transmission of an HL7 demographic A08 update message to the COTS
1049"^DD",2,2,.132,1,992,"%D",6,0)
1050interface.
1051"^DD",2,2,.132,1,992,"%D",7,0)
1052
1053"^DD",2,2,.132,1,992,"%D",8,0)
1054The local variable DGRUGA08 will be set to 1 if the cross reference is
1055"^DD",2,2,.132,1,992,"%D",9,0)
1056not to be executed as part of a re-indexing.
1057"^DD",2,2,.132,1,992,"DT")
10582990920
1059"^DD",2,2,.132,1,22700,0)
10602^ATMGPHONEWORK
1061"^DD",2,2,.132,1,22700,1)
1062N % S %=$E($TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%^&*()-_=+[]{}<>,./?:;'\|"),1,30) S:%'="" ^DPT("ATMGPHONEWORK",%,DA)=""
1063"^DD",2,2,.132,1,22700,2)
1064N % S %=$E($TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%^&*()-_=+[]{}<>,./?:;'\|"),1,30) K:%'="" ^DPT("ATMGPHONEWORK",%,DA)
1065"^DD",2,2,.132,1,22700,"%D",0)
1066^^2^2^3091106^^
1067"^DD",2,2,.132,1,22700,"%D",1,0)
1068Created by K. Toppenberg (TMG) for lookup
1069"^DD",2,2,.132,1,22700,"%D",2,0)
1070based on work phone.
1071"^DD",2,2,.132,1,22700,"DT")
10723091106
1073"^DD",2,2,.132,3)
1074If employed, enter the telephone number of this applicants place of employment [4-20 characters].
1075"^DD",2,2,.132,20,0)
1076^.3LA^1^1
1077"^DD",2,2,.132,20,1,0)
1078PEMP
1079"^DD",2,2,.132,21,0)
1080^^2^2^2861007^
1081"^DD",2,2,.132,21,1,0)
1082Enter the office phone number [4-20 characters] where this applicant
1083"^DD",2,2,.132,21,2,0)
1084can be reached while employed, if employed.
1085"^DD",2,2,.132,"AUDIT")
1086y
1087"^DD",2,2,.132,"DT")
10883091106
1089"^DD",2,2,.134,0)
1090PHONE NUMBER [CELLULAR]^FX^^.13;4^K:$L(X)>20!($L(X)<4) X I $D(X) N CTR,CHR,VAR S VAR=X F CTR=1:1:20 S CHR=$E(VAR,CTR) K:("1234567890 -()."'[CHR) X
1091"^DD",2,2,.134,.1)
1092Cell Phone
1093"^DD",2,2,.134,1,0)
1094^.1
1095"^DD",2,2,.134,1,22700,0)
10962^ATMGPHONECELL
1097"^DD",2,2,.134,1,22700,1)
1098N % S %=$E($TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%^&*()-_=+[]{}<>,./?:;'\|"),1,30) S:%'="" ^DPT("ATMGPHONECELL",%,DA)=""
1099"^DD",2,2,.134,1,22700,2)
1100N % S %=$E($TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%^&*()-_=+[]{}<>,./?:;'\|"),1,30) K:%'="" ^DPT("ATMGPHONECELL",%,DA)
1101"^DD",2,2,.134,1,22700,"%D",0)
1102^^2^2^3091106^^
1103"^DD",2,2,.134,1,22700,"%D",1,0)
1104Created by K. Toppenberg (TMG) for lookup
1105"^DD",2,2,.134,1,22700,"%D",2,0)
1106based on cell phone.
1107"^DD",2,2,.134,1,22700,"DT")
11083091106
1109"^DD",2,2,.134,3)
1110Answer must be 4-20 characters in length, be numeric with only spaces, parenthesis, periods, and dashes for separators.
1111"^DD",2,2,.134,21,0)
1112^^2^2^3050111^
1113"^DD",2,2,.134,21,1,0)
1114Enter the telephone number [4-20 characters] to the applicant's
1115"^DD",2,2,.134,21,2,0)
1116mobile phone.
1117"^DD",2,2,.134,"DT")
11183091106
1119**END**
1120**END**
Note: See TracBrowser for help on using the repository browser.