source: WorldVistAEHR/trunk/r/AUTHORIZATION_SUBSCRIPTION-USR/USRPS23.m@ 702

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

initial load of WorldVistAEHR
File size: 4.9 KB
Line 
1USRPS23 ; 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
5MAIN ; 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)
31MAINX ; Exit
32 S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)=""
33 S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)=" *********"
34 Q
35 ;
36NEWCLASS(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 ;
53NEWRULES(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 ;
77SETDATA(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
115SETX ;
116 Q
Note: See TracBrowser for help on using the repository browser.