source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUINP313.m@ 1141

Last change on this file since 1141 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1XUINP313 ;ISF/RWF - Post-init for patch XU*8*313 ;07/14/2003 14:41
2 ;;8.0;KERNEL;**313**;Jul 10, 1995
3 ;
4POST ;Run Terminate event for users after 6/10/2003
5 N Y,DATE,DT
6 S Y=$G(XPDQUES("POS001")) Q:Y'=1
7 S DT=$$DT^XLFDT
8 S DATE=$G(XPDQUES("POS002")) Q:DATE'>3030101
9 D PROC
10 Q
11 ;
12TEST ;Test Terminate event
13 N Y,DIR,DUOUT,DTOUT,DATE
14 S DIR(0)="Y",DIR("A")="Run Terminate events",DIR("B")="NO"
15 S DIR("A",1)="If you installed patch XU*8*290 you should answer Yes"
16 S DIR("A",2)="(If you installed XU*8*313 V3, this has already been done)"
17 S DIR("A",3)=""
18 S DIR("A",4)="A Yes answer will cause all users Terminated after a date you"
19 S DIR("A",5)="choose to have the XU USER TERMINATE protocol run on them."
20 D ^DIR
21 Q:Y'=1
22 K DIR
23 S DIR(0)="D^3030101:3030701"
24 S DIR("A")="Date of patch XU*8*290 install",DIR("B")="06/10/2003"
25 D ^DIR
26 S DATE=Y Q:DATE'>3030101
27 S DT=$$DT^XLFDT
28 D PROC
29 Q
30 ;
31PROC ;Process
32 N XUDA,XUIEN,XUIFN,D
33 S XUDA=.5
34 F S XUDA=$O(^VA(200,XUDA)) Q:XUDA'>0 S X=$G(^VA(200,XUDA,0)),D=$P(X,"^",11) I D>DATE,D<DT D
35 . D DEQUE^XUSERP(XUDA,3)
36 . Q
37 Q
38 ;
39LK(X) ;Lookup Option Name
40 Q $O(^DIC(19,"B",X,0))
41 ;
42PRETEST ;Test the pre-init
43 N DIR
44 S DIR(0)="Y",DIR("A")="Add national items to the XU USER TERMINATE option",DIR("B")="Yes"
45 D ^DIR Q:Y'=1
46 S XPDQUES("PRE001")=Y
47 D PRE
48 Q
49PRE ;Check if OK for pre-init to add national items back
50 N OPT,I,X,LIST,MENU,MSG
51 Q:'$G(XPDQUES("PRE001")) ;Check Pre-init answer
52 S LIST="USR USER TERMINATE^GMRC TERMINATE CLEANUP^OR TERMINATE CLEANUP^PRCS TERMINATE^TIU TEMPLATE USER DELETE"
53 S MENU=$$LK("XU USER TERMINATE")
54 F I=1:1:5 S OPT=$P(LIST,"^",I) S MSG=OPT D D MES^XPDUTL(MSG)
55 . S X=$$LK(OPT) I X'>0 S MSG=MSG_" not on system" Q
56 . I $D(^DIC(19,MENU,10,"B",X)) S MSG=MSG_" already on menu." Q
57 . S X=$$ADD("XU USER TERMINATE",OPT) S MSG=MSG_" "_$S(X>0:"",1:"NOT ")_"Added"
58 Q
59 ;
60ADD(MENU,OPT,SYN,ORD) ;EF. Add options to a menu
61 Q:$G(MENU)']"" 0 Q:$G(OPT)']"" 0
62 N X,XPD1,XPD2,XPD3,DIC,DA,D0,DR,DLAYGO
63 S XPD1=$$LK(MENU) Q:XPD1'>0 -1
64 ;quit if type is not extended action
65 I $$TYPE(XPD1)'["X" Q -2
66 S XPD2=$$LK(OPT) Q:XPD2'>0 -3
67 ;if OPTion is not in menu, add it
68 I '$D(^DIC(19,XPD1,10,"B",XPD2)) D
69 .S X=XPD2,(D0,DA(1))=XPD1,DIC(0)="MLF",DIC("P")=$P(^DD(19,10,0),"^",2),DLAYGO=19,DIC="^DIC(19,"_XPD1_",10,"
70 .D FILE^DICN
71 S XPD3=$O(^DIC(19,XPD1,10,"B",XPD2,0))
72 Q XPD3>0
73 ;
74TYPE(X) ;EF. Return option type, Pass IFN.
75 Q:X'>0 "" Q $P($G(^DIC(19,X,0)),"^",4)
Note: See TracBrowser for help on using the repository browser.