source: FOIAVistA/trunk/r/AUTHORIZATION_SUBSCRIPTION-USR/USRPS24.m@ 794

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

initial load of FOIAVistA 6/30/08 version
File size: 4.6 KB
Line 
1USRPS24 ; SLC/MAM - After installing TIU*1.0*165;6/18/03
2 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**24**;Jun 20, 1997
3 ; Run this after installing patch 165.
4 ;Use option: TIU165 DDEFS & RULES, PRF
5 ;
6MAIN ; Create new User Class & new Business Rules
7 ; -- Check for potential dup User Class created after install
8 ; but before option:
9 K ^TMP("USR24",$J)
10 D SETXTMP^USREN24
11 N USRDUPS,TMPCNT,SILENT
12 S TMPCNT=0
13 S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)=""
14 S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)=" ***** User Class and Rules for PATIENT RECORD FLAGS *****"
15 S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)=""
16 S SILENT=1
17 S USRDUPS=$$USRDUPS^USREN24(SILENT)
18 I $G(USRDUPS) D G MAINX
19 . S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)="Duplicate problem. See description for patch TIU*1*165,"
20 . S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)="in the National Patch Module."
21 N DONE,SUCCESS
22 ; -- If User Class previously created by this patch,
23 ; say so and quit:
24 S DONE=+$G(^XTMP("USR24","DONE"))
25 I DONE>0 D G MAINX
26 . S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)="User Class and, presumably, Business Rules"
27 . S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)=" were already created in a previous install."
28 ; -- Create new User Class:
29 D NEWCLASS(.SUCCESS,.TMPCNT)
30 ; -- Create new Business Rules:
31 I SUCCESS D NEWRULES(.TMPCNT)
32MAINX ; Exit
33 S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)=""
34 S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)=" *********"
35 Q
36 ;
37NEWCLASS(SUCCESS,TMPCNT) ; Create one new User Class in file 8930
38 N FDA,USRIEN,CLASSDA
39 S SUCCESS=1
40 ; -- Create new User Class:
41 M FDA(8930,"+1,")=^XTMP("USR24","USRCLAS")
42 D UPDATE^DIE("E","FDA","USRIEN")
43 S CLASSDA=+$G(USRIEN(1))
44 I CLASSDA'>0 D Q
45 . S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)="Couldn't create a User Class named "_^XTMP("USR24","USRCLAS",.01)_"."
46 . S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)=" Please contact National VistA Support."
47 . S SUCCESS=0
48 S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)="User Class named "_^XTMP("USR24","USRCLAS",.01)
49 S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)=" created successfully."
50 ; -- Set "DONE" node to IEN:
51 S ^XTMP("USR24","DONE")=CLASSDA
52 Q
53 ;
54NEWRULES(TMPCNT) ; Create new Business Rule
55 ; Create rule for ONE User Class & ONE DDEF
56 ; -- Set data for rule:
57 D SETDATA(.TMPCNT)
58 N NUM,SUCCESS
59 S SUCCESS=1,NUM=0
60 ; -- Loop through numbered list of rules (one, in this case):
61 I '$O(^XTMP("USR24","RULES",0)) S SUCCESS=0 Q
62 F S NUM=$O(^XTMP("USR24","RULES",NUM)) Q:'NUM D
63 . N USRERR,FDA,DESC
64 . M FDA(8930.1,"+1,")=^XTMP("USR24","RULES",NUM)
65 . M DESC=^XTMP("USR24","RULESDESC")
66 . S FDA(8930.1,"+1,",1)="DESC"
67 . D UPDATE^DIE("","FDA","","USRERR")
68 . I $D(USRERR) S SUCCESS=0 Q
69 . K ^XTMP("USR24","RULES",NUM)
70 K ^XTMP("USR24","RULESDESC")
71 I '$G(SUCCESS) D Q
72 . S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)=""
73 . S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)="Problem creating Business Rule. Please contact National VistA Support."
74 S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)=""
75 S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)="Business Rule created successfully."
76 Q
77 ;
78SETDATA(TMPCNT) ; Set data for rule
79 ; -- Set data for exported Rule into Rule node of ^XTMP.
80 ; Use interior data since there may be dup DDEF names.
81 ; Must set AFTER User Class is created:
82 N DDEFIEN,USRCLASS,EXACTION,INACTION,EXSTATUS,INSTATUS
83 ; -- Get IEN of DDEF Number 1. (DDEF Number 1 is DC,
84 ; PATIENT RECORD FLAG CAT I. See ^TIUEN165.)
85 S DDEFIEN=$G(^XTMP("TIU165","BASICS",1,"DONE"))
86 I DDEFIEN'>0 D G SETX
87 . S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)=""
88 . S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)="Can't find Document Definition for rules. Contact National VistA Support."
89 ; -- Get IEN of User Class created earlier:
90 S USRCLASS=+$G(^XTMP("USR24","DONE"))
91 ; -- Set data for flds .01 (DDEF) and .04 (User Class) for rule:
92 S ^XTMP("USR24","RULES",1,.01)=DDEFIEN
93 S ^XTMP("USR24","RULES",1,.04)=USRCLASS
94 ; -- Set rule desc data:
95 S ^XTMP("USR24","RULESDESC",1)="This rule limits note entry to persons specially trained to assign and"
96 S ^XTMP("USR24","RULESDESC",2)="document the assignment of Category I Patient Record Flags."
97 S ^XTMP("USR24","RULESDESC",3)="Sites must not alter or delete this User Class."
98 S ^XTMP("USR24","RULESDESC",4)="Sites must not alter, delete, or override this rule."
99 S ^XTMP("USR24","RULESDESC",5)="Rule created by patch USR*1*24."
100 ; -- Set action and status data for rule:
101 S EXACTION="ENTRY"
102 S INACTION=$O(^USR(8930.8,"B",EXACTION,0))
103 S ^XTMP("USR24","RULES",1,.03)=INACTION
104 S EXSTATUS="UNTRANSCRIBED"
105 S INSTATUS=$O(^USR(8930.6,"B",EXSTATUS,0))
106 S ^XTMP("USR24","RULES",1,.02)=INSTATUS
107SETX ;
108 Q
Note: See TracBrowser for help on using the repository browser.