1 | USRPS23 ; SLC/MAM - After installing TIU*1.0*137;6/16/03
|
---|
2 | ;;1.0;AUTHORIZATION/SUBSCRIPTION;**23**;Jun 20, 1997
|
---|
3 | ; Run this after installing patch 137.
|
---|
4 | ;Use option: TIU137 DDEFS Rules, Anat Path
|
---|
5 | MAIN ; Create new User Class & new Business Rules
|
---|
6 | ; -- Check for potential dup User Class created after install
|
---|
7 | ; but before option:
|
---|
8 | K ^TMP("USR23",$J)
|
---|
9 | D SETXTMP^USREN23
|
---|
10 | N USRDUPS,TMPCNT,SILENT
|
---|
11 | S TMPCNT=0
|
---|
12 | S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)=""
|
---|
13 | S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)=" ***** User Class and Rules for LABORATORY REPORTS *****"
|
---|
14 | S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)=""
|
---|
15 | S SILENT=1
|
---|
16 | S USRDUPS=$$USRDUPS^USREN23(SILENT)
|
---|
17 | I $G(USRDUPS) D G MAINX
|
---|
18 | . S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)="Duplicate problem. See description for patch TIU*1*137,"
|
---|
19 | . S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)="in the National Patch Module."
|
---|
20 | N DONE,SUCCESS
|
---|
21 | ; -- If User Class previously created by this patch,
|
---|
22 | ; say so and quit:
|
---|
23 | S DONE=+$G(^XTMP("USR23","DONE"))
|
---|
24 | I DONE>0 D G MAINX
|
---|
25 | . S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)="User Class and, presumably, Business Rules"
|
---|
26 | . S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)=" were already created in a previous install."
|
---|
27 | ; -- Create new User Class:
|
---|
28 | D NEWCLASS(.SUCCESS,.TMPCNT)
|
---|
29 | ; -- Create new Business Rules:
|
---|
30 | I SUCCESS D NEWRULES(.TMPCNT)
|
---|
31 | MAINX ; Exit
|
---|
32 | S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)=""
|
---|
33 | S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)=" *********"
|
---|
34 | Q
|
---|
35 | ;
|
---|
36 | NEWCLASS(SUCCESS,TMPCNT) ; Create one new User Class in file 8930
|
---|
37 | N FDA,USRIEN,CLASSDA
|
---|
38 | S SUCCESS=1
|
---|
39 | ; -- Create new User Class:
|
---|
40 | M FDA(8930,"+1,")=^XTMP("USR23","USRCLAS")
|
---|
41 | D UPDATE^DIE("E","FDA","USRIEN")
|
---|
42 | S CLASSDA=+$G(USRIEN(1))
|
---|
43 | I CLASSDA'>0 D Q
|
---|
44 | . S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)="Couldn't create a User Class named "_^XTMP("USR23","USRCLAS",.01)_"."
|
---|
45 | . S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)=" Please contact National VistA Support."
|
---|
46 | . S SUCCESS=0
|
---|
47 | S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)="User Class named "_^XTMP("USR23","USRCLAS",.01)
|
---|
48 | S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)=" created successfully."
|
---|
49 | ; -- Set "DONE" node to IEN:
|
---|
50 | S ^XTMP("USR23","DONE")=CLASSDA
|
---|
51 | Q
|
---|
52 | ;
|
---|
53 | NEWRULES(TMPCNT) ; Create new Business Rules
|
---|
54 | ; Create rules for ONE User Class & ONE DDEF
|
---|
55 | ; -- Set data for rules:
|
---|
56 | D SETDATA(.TMPCNT)
|
---|
57 | N NUM,SUCCESS
|
---|
58 | S SUCCESS=1,NUM=0
|
---|
59 | ; -- Loop through numbered list of rules:
|
---|
60 | I '$O(^XTMP("USR23","RULES",0)) S SUCCESS=0 Q
|
---|
61 | F S NUM=$O(^XTMP("USR23","RULES",NUM)) Q:'NUM D
|
---|
62 | . N USRERR,FDA,DESC
|
---|
63 | . M FDA(8930.1,"+1,")=^XTMP("USR23","RULES",NUM)
|
---|
64 | . M DESC=^XTMP("USR23","RULESDESC")
|
---|
65 | . S FDA(8930.1,"+1,",1)="DESC"
|
---|
66 | . D UPDATE^DIE("","FDA","","USRERR")
|
---|
67 | . I $D(USRERR) S SUCCESS=0 Q
|
---|
68 | . K ^XTMP("USR23","RULES",NUM)
|
---|
69 | K ^XTMP("USR23","RULESDESC")
|
---|
70 | I '$G(SUCCESS) D Q
|
---|
71 | . S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)=""
|
---|
72 | . S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)="Problem creating Business Rules. Please contact National VistA Support."
|
---|
73 | S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)=""
|
---|
74 | S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)="Business Rules created successfully."
|
---|
75 | Q
|
---|
76 | ;
|
---|
77 | SETDATA(TMPCNT) ; Set data for rules
|
---|
78 | ; -- Set data for exported Rules into Rule nodes of ^XTMP.
|
---|
79 | ; Use interior data since there may be dup DDEF names.
|
---|
80 | ; Must set AFTER User Class is created:
|
---|
81 | N DDEFIEN,USRCLASS,RULENUM,EXACTION
|
---|
82 | ; -- Get IEN of DDEF Number 2. (DDEF Number 2 is DC,
|
---|
83 | ; LR ANATOMIC PATHOLOGY. See ^TIUEN137.)
|
---|
84 | S DDEFIEN=$G(^XTMP("TIU137","BASICS",2,"DONE"))
|
---|
85 | I DDEFIEN'>0 D G SETX
|
---|
86 | . S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)=""
|
---|
87 | . S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)="Can't find Document Definition for rules. Contact National VistA Support."
|
---|
88 | ; -- Get IEN of User Class created earlier:
|
---|
89 | S USRCLASS=+$G(^XTMP("USR23","DONE"))
|
---|
90 | ; -- Set data for flds .01 (DDEF) and .04 (User Class) for all rules:
|
---|
91 | F RULENUM=1:1:9 D
|
---|
92 | . S ^XTMP("USR23","RULES",RULENUM,.01)=DDEFIEN
|
---|
93 | . S ^XTMP("USR23","RULES",RULENUM,.04)=USRCLASS
|
---|
94 | ; -- Set rule desc data (same for all rules):
|
---|
95 | S ^XTMP("USR23","RULESDESC",1)="Using this empty class to prevent this action on Anatomic Pathology documents."
|
---|
96 | S ^XTMP("USR23","RULESDESC",2)="These documents should be managed from the Anatomic Pathology menu only."
|
---|
97 | S ^XTMP("USR23","RULESDESC",3)="Rule created by patch USR*1*23."
|
---|
98 | ; -- Set action data for each rule; set status data according
|
---|
99 | ; to action:
|
---|
100 | S RULENUM=0
|
---|
101 | F EXACTION="AMENDMENT","CHANGE TITLE","COPY RECORD","DELETE RECORD","ENTRY","IDENTIFY SIGNERS","MAKE ADDENDUM","PRINT RECORD","REASSIGN" D
|
---|
102 | . N INACTION,EXSTATUS,INSTATUS
|
---|
103 | . S RULENUM=RULENUM+1
|
---|
104 | . S INACTION=$O(^USR(8930.8,"B",EXACTION,0))
|
---|
105 | . S ^XTMP("USR23","RULES",RULENUM,.03)=INACTION
|
---|
106 | . ; -- For action ENTRY, status is untranscribed:
|
---|
107 | . I EXACTION="ENTRY" D Q
|
---|
108 | . . S EXSTATUS="UNTRANSCRIBED"
|
---|
109 | . . S INSTATUS=$O(^USR(8930.6,"B",EXSTATUS,0))
|
---|
110 | . . S ^XTMP("USR23","RULES",RULENUM,.02)=INSTATUS
|
---|
111 | . ; -- For all others, status is completed:
|
---|
112 | . S EXSTATUS="COMPLETED"
|
---|
113 | . S INSTATUS=$O(^USR(8930.6,"B",EXSTATUS,0))
|
---|
114 | . S ^XTMP("USR23","RULES",RULENUM,.02)=INSTATUS
|
---|
115 | SETX ;
|
---|
116 | Q
|
---|