| 1 | XUINP313 ;ISF/RWF - Post-init for patch XU*8*313 ;07/14/2003 14:41
|
|---|
| 2 | ;;8.0;KERNEL;**313**;Jul 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | POST ;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 | ;
|
|---|
| 12 | TEST ;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 | ;
|
|---|
| 31 | PROC ;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 | ;
|
|---|
| 39 | LK(X) ;Lookup Option Name
|
|---|
| 40 | Q $O(^DIC(19,"B",X,0))
|
|---|
| 41 | ;
|
|---|
| 42 | PRETEST ;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
|
|---|
| 49 | PRE ;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 | ;
|
|---|
| 60 | ADD(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 | ;
|
|---|
| 74 | TYPE(X) ;EF. Return option type, Pass IFN.
|
|---|
| 75 | Q:X'>0 "" Q $P($G(^DIC(19,X,0)),"^",4)
|
|---|
