source: VWGUIRegistration/tag/2.0/VWREG_03182017_P4T4_0.KID

Last change on this file was 1794, checked in by Jim B., 7 years ago
File size: 16.0 KB
RevLine 
[1794]1KIDS Distribution saved on Mar 19, 2017@10:24
2Minor updates: VWREGITT, Patient field .363, help
3**KIDS**:VWREG_03182017*2.04T4*0^
4
5**INSTALL NAME**
6VWREG_03182017*2.04T4*0
7"BLD",633,0)
8VWREG_03182017*2.04T4*0^^0^3170319^n
9"BLD",633,1,0)
10^^8^8^3170319^^
11"BLD",633,1,1,0)
12Minor corrections:
13"BLD",633,1,2,0)
141 The executable - linked the Template Management help to the main help
15"BLD",633,1,3,0)
162 Completed the delete template from the regit.txt file.
17"BLD",633,1,4,0)
18 NOTE: Does NOT delete the template from the Fileman Input Template file
19"BLD",633,1,5,0)
20 to avoid <UNDEF> consequences
21"BLD",633,1,6,0)
223 Removed security from PATIENT file FIELD .363 PRIMARY LONG ID:
23"BLD",633,1,7,0)
24 Original build did not remove the security, which was at no access
25"BLD",633,1,8,0)
26 (^).
27"BLD",633,4,0)
28^9.64PA^2^1
29"BLD",633,4,2,0)
302
31"BLD",633,4,2,2,0)
32^9.641^2^1
33"BLD",633,4,2,2,2,0)
34PATIENT (File-top level)
35"BLD",633,4,2,2,2,1,0)
36^9.6411^.363^1
37"BLD",633,4,2,2,2,1,.363,0)
38PRIMARY LONG ID
39"BLD",633,4,2,222)
40y^y^p^^^^n^^n
41"BLD",633,4,2,224)
42
43"BLD",633,4,"APDD",2,2)
44
45"BLD",633,4,"APDD",2,2,.363)
46
47"BLD",633,4,"B",2,2)
48
49"BLD",633,6.3)
501
51"BLD",633,"KRN",0)
52^9.67PA^779.2^20
53"BLD",633,"KRN",.4,0)
54.4
55"BLD",633,"KRN",.401,0)
56.401
57"BLD",633,"KRN",.402,0)
58.402
59"BLD",633,"KRN",.403,0)
60.403
61"BLD",633,"KRN",.5,0)
62.5
63"BLD",633,"KRN",.84,0)
64.84
65"BLD",633,"KRN",3.6,0)
663.6
67"BLD",633,"KRN",3.8,0)
683.8
69"BLD",633,"KRN",9.2,0)
709.2
71"BLD",633,"KRN",9.8,0)
729.8
73"BLD",633,"KRN",9.8,"NM",0)
74^9.68A^1^1
75"BLD",633,"KRN",9.8,"NM",1,0)
76VWREGITT^^0^B38020021
77"BLD",633,"KRN",9.8,"NM","B","VWREGITT",1)
78
79"BLD",633,"KRN",19,0)
8019
81"BLD",633,"KRN",19.1,0)
8219.1
83"BLD",633,"KRN",101,0)
84101
85"BLD",633,"KRN",409.61,0)
86409.61
87"BLD",633,"KRN",771,0)
88771
89"BLD",633,"KRN",779.2,0)
90779.2
91"BLD",633,"KRN",870,0)
92870
93"BLD",633,"KRN",8989.51,0)
948989.51
95"BLD",633,"KRN",8989.52,0)
968989.52
97"BLD",633,"KRN",8994,0)
988994
99"BLD",633,"KRN","B",.4,.4)
100
101"BLD",633,"KRN","B",.401,.401)
102
103"BLD",633,"KRN","B",.402,.402)
104
105"BLD",633,"KRN","B",.403,.403)
106
107"BLD",633,"KRN","B",.5,.5)
108
109"BLD",633,"KRN","B",.84,.84)
110
111"BLD",633,"KRN","B",3.6,3.6)
112
113"BLD",633,"KRN","B",3.8,3.8)
114
115"BLD",633,"KRN","B",9.2,9.2)
116
117"BLD",633,"KRN","B",9.8,9.8)
118
119"BLD",633,"KRN","B",19,19)
120
121"BLD",633,"KRN","B",19.1,19.1)
122
123"BLD",633,"KRN","B",101,101)
124
125"BLD",633,"KRN","B",409.61,409.61)
126
127"BLD",633,"KRN","B",771,771)
128
129"BLD",633,"KRN","B",779.2,779.2)
130
131"BLD",633,"KRN","B",870,870)
132
133"BLD",633,"KRN","B",8989.51,8989.51)
134
135"BLD",633,"KRN","B",8989.52,8989.52)
136
137"BLD",633,"KRN","B",8994,8994)
138
139"BLD",633,"QDEF")
140^^^^NO^^^^NO^^NO
141"BLD",633,"QUES",0)
142^9.62^^
143"BLD",633,"REQB",0)
144^9.611^^
145"FIA",2)
146PATIENT
147"FIA",2,0)
148^DPT(
149"FIA",2,0,0)
1502I
151"FIA",2,0,1)
152y^y^p^^^^n^^n
153"FIA",2,0,10)
154
155"FIA",2,0,11)
156
157"FIA",2,0,"RLRO")
158
159"FIA",2,2)
1601
161"FIA",2,2,.363)
162
163"MBREQ")
1640
165"QUES","XPF1",0)
166Y
167"QUES","XPF1","??")
168^D REP^XPDH
169"QUES","XPF1","A")
170Shall I write over your |FLAG| File
171"QUES","XPF1","B")
172YES
173"QUES","XPF1","M")
174D XPF1^XPDIQ
175"QUES","XPF2",0)
176Y
177"QUES","XPF2","??")
178^D DTA^XPDH
179"QUES","XPF2","A")
180Want my data |FLAG| yours
181"QUES","XPF2","B")
182YES
183"QUES","XPF2","M")
184D XPF2^XPDIQ
185"QUES","XPI1",0)
186YO
187"QUES","XPI1","??")
188^D INHIBIT^XPDH
189"QUES","XPI1","A")
190Want KIDS to INHIBIT LOGONs during the install
191"QUES","XPI1","B")
192NO
193"QUES","XPI1","M")
194D XPI1^XPDIQ
195"QUES","XPM1",0)
196PO^VA(200,:EM
197"QUES","XPM1","??")
198^D MG^XPDH
199"QUES","XPM1","A")
200Enter the Coordinator for Mail Group '|FLAG|'
201"QUES","XPM1","B")
202
203"QUES","XPM1","M")
204D XPM1^XPDIQ
205"QUES","XPO1",0)
206Y
207"QUES","XPO1","??")
208^D MENU^XPDH
209"QUES","XPO1","A")
210Want KIDS to Rebuild Menu Trees Upon Completion of Install
211"QUES","XPO1","B")
212NO
213"QUES","XPO1","M")
214D XPO1^XPDIQ
215"QUES","XPZ1",0)
216Y
217"QUES","XPZ1","??")
218^D OPT^XPDH
219"QUES","XPZ1","A")
220Want to DISABLE Scheduled Options, Menu Options, and Protocols
221"QUES","XPZ1","B")
222NO
223"QUES","XPZ1","M")
224D XPZ1^XPDIQ
225"QUES","XPZ2",0)
226Y
227"QUES","XPZ2","??")
228^D RTN^XPDH
229"QUES","XPZ2","A")
230Want to MOVE routines to other CPUs
231"QUES","XPZ2","B")
232NO
233"QUES","XPZ2","M")
234D XPZ2^XPDIQ
235"RTN")
2361
237"RTN","VWREGITT")
2380^1^B38020021
239"RTN","VWREGITT",1,0)
240VWREGITT ;Portland\Jim Bell, BFP,LLC Input Template Management 2016
241"RTN","VWREGITT",2,0)
242 ;2.0**LOCAL** Copyright April 2016 ad infinitum;;;;;Build 1
243"RTN","VWREGITT",3,0)
244 ;*****************************************************************
245"RTN","VWREGITT",4,0)
246 ;* Licensed under GNU 2.0 or greater - see license.txt file *
247"RTN","VWREGITT",5,0)
248 ;* Program/application is for the management of input templates *
249"RTN","VWREGITT",6,0)
250 ;* owned by the user (DUZ). *
251"RTN","VWREGITT",7,0)
252 ;* REMINDER: All template fields pertain only to the Patient File*
253"RTN","VWREGITT",8,0)
254 ;* (#2)! *
255"RTN","VWREGITT",9,0)
256 ;*****************************************************************
257"RTN","VWREGITT",10,0)
258 Q ;No fall through
259"RTN","VWREGITT",11,0)
260 ;
261"RTN","VWREGITT",12,0)
262AUTH(TUSER,TNUM) ;Can user edit or is IT CONTROL
263"RTN","VWREGITT",13,0)
264 N TMO
265"RTN","VWREGITT",14,0)
266 S TMO=$O(^DIC(19,"B","VW REG IT CONTROL",0)) I $D(^VA(200,TUSER,203,"B",TMO)) Q 1
267"RTN","VWREGITT",15,0)
268 S TMO=$O(^DIC(19,"B","VW PATIENT REGISTRATION",0))
269"RTN","VWREGITT",16,0)
270 I TMO,$P(^DIE(TNUM,0),"^",5)=TUSER Q 1
271"RTN","VWREGITT",17,0)
272 Q 0
273"RTN","VWREGITT",18,0)
274 ;
275"RTN","VWREGITT",19,0)
276INR() Q $O(RESULT(" "),-1)+1
277"RTN","VWREGITT",20,0)
278 ;
279"RTN","VWREGITT",21,0)
280CF(FIELD) ;If a computed field, 0, else 1
281"RTN","VWREGITT",22,0)
282 I $P($G(^DD(2,FIELD,0)),"^",2)["C" Q 0
283"RTN","VWREGITT",23,0)
284 Q 1
285"RTN","VWREGITT",24,0)
286 ;
287"RTN","VWREGITT",25,0)
288EGF(RESULT,TNAME) ;Get fields for client editing via TName
289"RTN","VWREGITT",26,0)
290 ;*************************
291"RTN","VWREGITT",27,0)
292 ;* Incoming___TNAME(IEN) *
293"RTN","VWREGITT",28,0)
294 ;*************************
295"RTN","VWREGITT",29,0)
296 K RESULT ;N TNUM,TNAME,PF,SF
297"RTN","VWREGITT",30,0)
298 S TNUM=+$P(TNAME,"(",2)
299"RTN","VWREGITT",31,0)
300 S TNAME=$P(TNAME,"(")
301"RTN","VWREGITT",32,0)
302 I 'TNUM!('$D(^DIE(TNUM))) S RESULT(0)="Template name or number not found in Template file" Q
303"RTN","VWREGITT",33,0)
304 ;Check for authorization
305"RTN","VWREGITT",34,0)
306 I '$$AUTH(DUZ,TNUM) S RESULT(0)="Sorry, you are not authorized to edit this template." Q
307"RTN","VWREGITT",35,0)
308 S RESULT(0)="Editing "_TNAME_"("_TNUM_")"
309"RTN","VWREGITT",36,0)
310 S PF=$G(^DIE(TNUM,"DR",1,2))
311"RTN","VWREGITT",37,0)
312 F I=1:1:$L(PF,";") D:$P(PF,";",I)
313"RTN","VWREGITT",38,0)
314 . S RESULT($$INR)=$P(^DD(2,$P(PF,";",I),0),"^")_"("_$P(PF,";",I)_")"
315"RTN","VWREGITT",39,0)
316 . S SDD=+$P(^DD(2,$P(PF,";",I),0),"^",2) D:SDD
317"RTN","VWREGITT",40,0)
318 .. S SDN=1 F S SDN=$O(^DIE(TNUM,"DR",SDN)) Q:'SDN S:$O(^(SDN,0))=SDD SF=^(SDD) D
319"RTN","VWREGITT",41,0)
320 ... F J=1:1:$L(SF,";") D:$P(SF,";",J)
321"RTN","VWREGITT",42,0)
322 .... S SFF=$P(^DIE(TNUM,"DR",SDN,SDD),";",J)
323"RTN","VWREGITT",43,0)
324 .... S RESULT($$INR)=" SF "_$P(^DD(SDD,SFF,0),"^")_"("_SFF_";"_SDD_")"
325"RTN","VWREGITT",44,0)
326 Q
327"RTN","VWREGITT",45,0)
328 ;
329"RTN","VWREGITT",46,0)
330SFLDS ;Get sub-fields and dics
331"RTN","VWREGITT",47,0)
332 K MULT N N,X,I,Y
333"RTN","VWREGITT",48,0)
334 S Y="",N=0 F S N=$O(TDATA(N)) Q:'+N D
335"RTN","VWREGITT",49,0)
336 . Q:TDATA(N)'[" SF" ;Still a major field
337"RTN","VWREGITT",50,0)
338 . F I=N:1:$O(TDATA(" "),-1) S X=TDATA(I) Q:X'[" SF" S MULT(+$P(X,";",2),+$P(X,"(",2))=""
339"RTN","VWREGITT",51,0)
340 Q
341"RTN","VWREGITT",52,0)
342 ;
343"RTN","VWREGITT",53,0)
344FIELDS() ;
345"RTN","VWREGITT",54,0)
346 N FLDLIST,N,X,FLD K MULT
347"RTN","VWREGITT",55,0)
348 S FLDLIST=""
349"RTN","VWREGITT",56,0)
350 S N=0 F S N=$O(TDATA(N)) Q:'+N D:TDATA(N)'[" SF"
351"RTN","VWREGITT",57,0)
352 . S FLD=+$P(TDATA(N),"(",2)
353"RTN","VWREGITT",58,0)
354 . Q:'$$CF(+$P(TDATA(N),"(",2)) ;Computed field
355"RTN","VWREGITT",59,0)
356 . S FLDLIST=FLDLIST_FLD_";"
357"RTN","VWREGITT",60,0)
358 ;Collate thru for multiple fields:entry looks like " SF "
359"RTN","VWREGITT",61,0)
360 S N=0 F S N=$O(TDATA(N)) Q:'+N D:TDATA(N)[" SF"
361"RTN","VWREGITT",62,0)
362 . S X=$P(TDATA(N)," ",3)
363"RTN","VWREGITT",63,0)
364 . S SDD=+$P(X,";",2)
365"RTN","VWREGITT",64,0)
366 . S SFL=+$P(X,"(",2)
367"RTN","VWREGITT",65,0)
368 . S MULT(SDD,SFL)=""
369"RTN","VWREGITT",66,0)
370 S N=0 F S N=$O(MULT(N)) Q:'+N D S SUB(N)=MF
371"RTN","VWREGITT",67,0)
372 . S MF="",N2=0 F S N2=$O(MULT(N,N2)) Q:'+N2 S MF=MF_N2_";"
373"RTN","VWREGITT",68,0)
374 K MULT
375"RTN","VWREGITT",69,0)
376 Q FLDLIST
377"RTN","VWREGITT",70,0)
378 ;
379"RTN","VWREGITT",71,0)
380RTF(RESULT) ;Send a refresh of regit.txt to client
381"RTN","VWREGITT",72,0)
382 K AR,RESULT
383"RTN","VWREGITT",73,0)
384 D LTF
385"RTN","VWREGITT",74,0)
386 M RESULT=AR
387"RTN","VWREGITT",75,0)
388 K AR
389"RTN","VWREGITT",76,0)
390 Q
391"RTN","VWREGITT",77,0)
392 ;
393"RTN","VWREGITT",78,0)
394LTF ;Load the regit.txt file into AR()
395"RTN","VWREGITT",79,0)
396 S HD=$$GET^XPAR("ALL","VW GUI REG TEMPLATE DIRECTORY")
397"RTN","VWREGITT",80,0)
398 S FILE="regit.txt"
399"RTN","VWREGITT",81,0)
400 S P4=1
401"RTN","VWREGITT",82,0)
402 S P5=""
403"RTN","VWREGITT",83,0)
404 S X=$$FTG^%ZISH(HD,FILE,$NA(AR(1)),P4,P5)
405"RTN","VWREGITT",84,0)
406 Q
407"RTN","VWREGITT",85,0)
408 ;
409"RTN","VWREGITT",86,0)
410FTF ;File the AR() to regit.txt
411"RTN","VWREGITT",87,0)
412 ZSY "cp "_HD_"regit.txt "_HD_"regitbu.txt"
413"RTN","VWREGITT",88,0)
414 S P4=1,P5="",FILE="regit.txt"
415"RTN","VWREGITT",89,0)
416 S X=$$GTF^%ZISH($NA(AR(1)),1,HD,FILE)
417"RTN","VWREGITT",90,0)
418 Q
419"RTN","VWREGITT",91,0)
420 ;
421"RTN","VWREGITT",92,0)
422ITCNTRL(USER) ;Check for control capability and user authorization
423"RTN","VWREGITT",93,0)
424 N ITCNTRL
425"RTN","VWREGITT",94,0)
426 S ITCNTRL=$O(^DIC(19,"B","VW REG IT CONTROL",0))
427"RTN","VWREGITT",95,0)
428 I 'ITCNTRL D Q 0
429"RTN","VWREGITT",96,0)
430 . S VAL=0
431"RTN","VWREGITT",97,0)
432 . S RESULT(0)="-1^VW REGISTRATION does not appear to be complete."
433"RTN","VWREGITT",98,0)
434 . S RESULT(1)="Please contact your Supervisor or IT support."
435"RTN","VWREGITT",99,0)
436 . S RESULT(2)="Thank you,"
437"RTN","VWREGITT",100,0)
438 . S RESULT(3)="The Management"
439"RTN","VWREGITT",101,0)
440 I '$D(^VA(200,USER,203,"B",ITCNTRL)) D Q 0
441"RTN","VWREGITT",102,0)
442 . S RESULT(0)="-1^User does not have authorization to modify/create"
443"RTN","VWREGITT",103,0)
444 . S RESULT(1)="input templates. Please contact your Supervisor or"
445"RTN","VWREGITT",104,0)
446 . S RESULT(2)="IT support. Or, questions can be referred to Jim"
447"RTN","VWREGITT",105,0)
448 . S RESULT(3)="Bell at jbellco65@gmail.com"
449"RTN","VWREGITT",106,0)
450 . S RESULT(4)="Thank you."
451"RTN","VWREGITT",107,0)
452 Q 1
453"RTN","VWREGITT",108,0)
454 ;
455"RTN","VWREGITT",109,0)
456EN(RESULT,TDATA) ;
457"RTN","VWREGITT",110,0)
458 ;************************************************
459"RTN","VWREGITT",111,0)
460 ;* Call from Client *
461"RTN","VWREGITT",112,0)
462 ;* TDATA Array: *
463"RTN","VWREGITT",113,0)
464 ;* 0____Template Name^DUZ^ACTION^WRITEACCESS *
465"RTN","VWREGITT",114,0)
466 ;* 1-n__Field name(number) *
467"RTN","VWREGITT",115,0)
468 ;************************************************
469"RTN","VWREGITT",116,0)
470 ; -- testing --
471"RTN","VWREGITT",117,0)
472 ;M ^DIZ("TDATA",$J)=TDATA
473"RTN","VWREGITT",118,0)
474 ;Q
475"RTN","VWREGITT",119,0)
476 ; -- end testing --
477"RTN","VWREGITT",120,0)
478 ;
479"RTN","VWREGITT",121,0)
480 N TNAME,TNUM,ITCNTRL,ACTION,FIELDS,CALLER
481"RTN","VWREGITT",122,0)
482 S CALLER=""
483"RTN","VWREGITT",123,0)
484 S X="TDATA" F S X=$Q(@X) Q:X="" S @X=$$UP^XLFSTR(@X) ;Upcase everyTHING
485"RTN","VWREGITT",124,0)
486 I '$L($G(HD)) S HD=$$GET^XPAR("ALL","VW GUI REG TEMPLATE DIRECTORY")
487"RTN","VWREGITT",125,0)
488 S WHO=$P(TDATA(0),"^",2)
489"RTN","VWREGITT",126,0)
490 S ITCNTRL=$$ITCNTRL(WHO) ;1=full action;0=create/edit own template(s)
491"RTN","VWREGITT",127,0)
492 S TNUM=+$P($P(TDATA(0),"^"),"(",2)
493"RTN","VWREGITT",128,0)
494 S TNAME=$P($P(TDATA(0),"^"),"(")
495"RTN","VWREGITT",129,0)
496 I TNAME["Editing" S SPEC("Editing ")="",TNAME=$$REPLACE^XLFSTR(TNAME,.SPEC)
497"RTN","VWREGITT",130,0)
498 S ACTION=$P(TDATA(0),"^",3)
499"RTN","VWREGITT",131,0)
500 S WRITEACC=$S($P(TDATA(0),"^",4)="SELF":$P(^VA(200,DUZ,0),"^",4),1:"")
501"RTN","VWREGITT",132,0)
502 S FIELDS=$$FIELDS
503"RTN","VWREGITT",133,0)
504 I '$L(ACTION) S RESULT(0)="-1^No action sent. I don't know what to do." Q
505"RTN","VWREGITT",134,0)
506 D @ACTION
507"RTN","VWREGITT",135,0)
508 Q
509"RTN","VWREGITT",136,0)
510 ;
511"RTN","VWREGITT",137,0)
512CREATE ;Create a new input template
513"RTN","VWREGITT",138,0)
514 ;******************************
515"RTN","VWREGITT",139,0)
516 ;* Check for computed fields *
517"RTN","VWREGITT",140,0)
518 ;******************************
519"RTN","VWREGITT",141,0)
520 K RESULT N %DT,X,Y
521"RTN","VWREGITT",142,0)
522 S %DT="TS",X="NOW" D ^%DT S FDATE=Y
523"RTN","VWREGITT",143,0)
524 S X=TNAME,DIC="^DIE(",DIC(0)="LZ" D FILE^DICN
525"RTN","VWREGITT",144,0)
526 S $P(^DIE(+Y,0),"^",2)=FDATE,$P(^(0),"^",3)="",$P(^(0),"^",4)=2,$P(^(0),"^",5)=DUZ
527"RTN","VWREGITT",145,0)
528 S $P(^DIE(+Y,0),"^",6)=WRITEACC
529"RTN","VWREGITT",146,0)
530C2 S ^DIE(+Y,"DR",1,2)=FIELDS
531"RTN","VWREGITT",147,0)
532 ;Do mult fields here
533"RTN","VWREGITT",148,0)
534 S N=0 F S N=$O(SUB(N)) Q:'+N D
535"RTN","VWREGITT",149,0)
536 . S UP=^DD(N,0,"UP")
537"RTN","VWREGITT",150,0)
538 . I UP=2 S ^DIE(+Y,"DR",$O(^DIE(+Y,"DR"," "),-1)+1,N)=SUB(N)
539"RTN","VWREGITT",151,0)
540 . E S ^DIE(+Y,"DR",$O(^DIE(+Y,"DR"," "),-1),N)=SUB(N)
541"RTN","VWREGITT",152,0)
542 I $P(^DIE(+Y,0),"^")=$P(TDATA(0),"^") S RESULT(0)=$P(Y,"^",2)_" filed"
543"RTN","VWREGITT",153,0)
544 Q:CALLER="EDIT"
545"RTN","VWREGITT",154,0)
546 S TNUM=+Y,TNAME=$P(Y,"^",2)
547"RTN","VWREGITT",155,0)
548 K AR
549"RTN","VWREGITT",156,0)
550 D LTF ;Get the regit.txt file loaded into AR()
551"RTN","VWREGITT",157,0)
552 S LAST=$O(AR(" "),-1)
553"RTN","VWREGITT",158,0)
554 S AR(LAST)=TNAME_"("_TNUM_")"
555"RTN","VWREGITT",159,0)
556 S AR(LAST+1)="[ID]"
557"RTN","VWREGITT",160,0)
558 ;M ^DIZ("TDATA","AR",$J)=AR ;Testing
559"RTN","VWREGITT",161,0)
560 D FTF ;File AR() to regit.txt
561"RTN","VWREGITT",162,0)
562 K ^DIZ("TDATA",$J)
563"RTN","VWREGITT",163,0)
564 Q
565"RTN","VWREGITT",164,0)
566 ;
567"RTN","VWREGITT",165,0)
568EDIT ;Edit existing. Check for allowability
569"RTN","VWREGITT",166,0)
570 S Y=TNUM_"^"_TNAME
571"RTN","VWREGITT",167,0)
572EL L -^DIE(TNUM):1 G EL:'$T
573"RTN","VWREGITT",168,0)
574 S S=1 F S S=$O(^DIE(TNUM,"DR",S)) Q:'+S D
575"RTN","VWREGITT",169,0)
576 . S SUBD=0 F S SUBD=$O(^DIE(TNUM,"DR",S,SUBD)) Q:'+SUBD K ^DIE(TNUM,"DR",S,SUBD)
577"RTN","VWREGITT",170,0)
578 S CALLER="EDIT"
579"RTN","VWREGITT",171,0)
580 D C2
581"RTN","VWREGITT",172,0)
582 L +^DIE(TNUM)
583"RTN","VWREGITT",173,0)
584 S DA=TNUM,DIK="^DIE(" D IX^DIK ;Re-index record just in case...
585"RTN","VWREGITT",174,0)
586 S RESULT(0)=Y_" modification filed..."
587"RTN","VWREGITT",175,0)
588 Q
589"RTN","VWREGITT",176,0)
590 ;
591"RTN","VWREGITT",177,0)
592DELETE ;********************************************
593"RTN","VWREGITT",178,0)
594 K AR
595"RTN","VWREGITT",179,0)
596 N I,J,X
597"RTN","VWREGITT",180,0)
598 S X="TDATA" F S X=$Q(@X) Q:X="" D
599"RTN","VWREGITT",181,0)
600 . Q:'$L($P(@X,"^",3)) ;No entry
601"RTN","VWREGITT",182,0)
602 . K @X
603"RTN","VWREGITT",183,0)
604 M AR=TDATA K TDATA
605"RTN","VWREGITT",184,0)
606 D FTF
607"RTN","VWREGITT",185,0)
608 I X S RESULT(0)="Template menu list updated."
609"RTN","VWREGITT",186,0)
610 E S RESULT(0)="Template list not updated. Advise Template manager to manually update "_HD_"regit.txt"
611"RTN","VWREGITT",187,0)
612 Q
613"RTN","VWREGITT",188,0)
614
615"SEC","^DD",2,2,.363,9)
616
617"VER")
6188.0^22.2
619"^DD",2,2,.363,0)
620PRIMARY LONG ID^F^^.36;3^K:$L(X)>15!($L(X)<1) X
621"^DD",2,2,.363,1,0)
622^.1
623"^DD",2,2,.363,1,391,0)
6242^AHL7^MUMPS
625"^DD",2,2,.363,1,391,1)
626N NX,REG,VAFHDFN S VAFHDFN=DA,NX=X,X="VAFHDD" X ^%ZOSF("TEST") I $T S REG=$$EN^VAFHREG() D:REG=0 SET^VAFHUTL2 S X=NX,DA=VAFHDFN
627"^DD",2,2,.363,1,391,2)
628N NX,REG,VAFHDFN S VAFHDFN=DA,NX=X,X="VAFHDD" X ^%ZOSF("TEST") I $T S REG=$$EN^VAFHREG() D:REG=0 KILL^VAFHUTL2(DA,NX) S:REG'=0 VAFHMRG="",VAFHBEF=NX S X=NX,DA=VAFHDFN
629"^DD",2,2,.363,1,391,"%D",0)
630^^3^3^2960624^^^
631"^DD",2,2,.363,1,391,"%D",1,0)
632This x-ref is used to catch changes to the Primary Long ID
633"^DD",2,2,.363,1,391,"%D",2,0)
634It will cause an A34 (Merge) HL7 message to be fired.
635"^DD",2,2,.363,1,391,"%D",3,0)
636The A34 message will not be generated during patient registration.
637"^DD",2,2,.363,1,391,"DT")
6382960603
639"^DD",2,2,.363,3)
640Answer must be 1-15 characters in length.
641"^DD",2,2,.363,5,1,0)
6422.0361^.03^3
643"^DD",2,2,.363,21,0)
644^^7^7^2911214^^^^
645"^DD",2,2,.363,21,1,0)
646This field contains the patient's long ID associated with
647"^DD",2,2,.363,21,2,0)
648the patient's PRIMARY ELIGIBILITY CODE. For most patients
649"^DD",2,2,.363,21,3,0)
650this is the Social Security Number.
651"^DD",2,2,.363,21,4,0)
652
653"^DD",2,2,.363,21,5,0)
654No user input is needed for this field. It is automatically
655"^DD",2,2,.363,21,6,0)
656updated when the PRIMARY ELIGIBILITY CODE field is entered
657"^DD",2,2,.363,21,7,0)
658and edited.
659"^DD",2,2,.363,"DT")
6602960603
661**END**
662**END**
Note: See TracBrowser for help on using the repository browser.