Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: USRPS24

USRPS24.m

Go to the documentation of this file.
  1. USRPS24 ; SLC/MAM - After installing TIU*1.0*165;6/18/03
  1. ;;1.0;AUTHORIZATION/SUBSCRIPTION;**24**;Jun 20, 1997
  1. ; Run this after installing patch 165.
  1. ;Use option: TIU165 DDEFS & RULES, PRF
  1. ;
  1. MAIN ; Create new User Class & new Business Rules
  1. ; -- Check for potential dup User Class created after install
  1. ; but before option:
  1. K ^TMP("USR24",$J)
  1. D SETXTMP^USREN24
  1. N USRDUPS,TMPCNT,SILENT
  1. S TMPCNT=0
  1. S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)=""
  1. S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)=" ***** User Class and Rules for PATIENT RECORD FLAGS *****"
  1. S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)=""
  1. S SILENT=1
  1. S USRDUPS=$$USRDUPS^USREN24(SILENT)
  1. I $G(USRDUPS) D G MAINX
  1. . S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)="Duplicate problem. See description for patch TIU*1*165,"
  1. . S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)="in the National Patch Module."
  1. N DONE,SUCCESS
  1. ; -- If User Class previously created by this patch,
  1. ; say so and quit:
  1. S DONE=+$G(^XTMP("USR24","DONE"))
  1. I DONE>0 D G MAINX
  1. . S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)="User Class and, presumably, Business Rules"
  1. . S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)=" were already created in a previous install."
  1. ; -- Create new User Class:
  1. D NEWCLASS(.SUCCESS,.TMPCNT)
  1. ; -- Create new Business Rules:
  1. I SUCCESS D NEWRULES(.TMPCNT)
  1. MAINX ; Exit
  1. S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)=""
  1. S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)=" *********"
  1. Q
  1. ;
  1. NEWCLASS(SUCCESS,TMPCNT) ; Create one new User Class in file 8930
  1. N FDA,USRIEN,CLASSDA
  1. S SUCCESS=1
  1. ; -- Create new User Class:
  1. M FDA(8930,"+1,")=^XTMP("USR24","USRCLAS")
  1. D UPDATE^DIE("E","FDA","USRIEN")
  1. S CLASSDA=+$G(USRIEN(1))
  1. I CLASSDA'>0 D Q
  1. . S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)="Couldn't create a User Class named "_^XTMP("USR24","USRCLAS",.01)_"."
  1. . S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)=" Please contact National VistA Support."
  1. . S SUCCESS=0
  1. S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)="User Class named "_^XTMP("USR24","USRCLAS",.01)
  1. S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)=" created successfully."
  1. ; -- Set "DONE" node to IEN:
  1. S ^XTMP("USR24","DONE")=CLASSDA
  1. Q
  1. ;
  1. NEWRULES(TMPCNT) ; Create new Business Rule
  1. ; Create rule for ONE User Class & ONE DDEF
  1. ; -- Set data for rule:
  1. D SETDATA(.TMPCNT)
  1. N NUM,SUCCESS
  1. S SUCCESS=1,NUM=0
  1. ; -- Loop through numbered list of rules (one, in this case):
  1. I '$O(^XTMP("USR24","RULES",0)) S SUCCESS=0 Q
  1. F S NUM=$O(^XTMP("USR24","RULES",NUM)) Q:'NUM D
  1. . N USRERR,FDA,DESC
  1. . M FDA(8930.1,"+1,")=^XTMP("USR24","RULES",NUM)
  1. . M DESC=^XTMP("USR24","RULESDESC")
  1. . S FDA(8930.1,"+1,",1)="DESC"
  1. . D UPDATE^DIE("","FDA","","USRERR")
  1. . I $D(USRERR) S SUCCESS=0 Q
  1. . K ^XTMP("USR24","RULES",NUM)
  1. K ^XTMP("USR24","RULESDESC")
  1. I '$G(SUCCESS) D Q
  1. . S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)=""
  1. . S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)="Problem creating Business Rule. Please contact National VistA Support."
  1. S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)=""
  1. S TMPCNT=TMPCNT+1,^TMP("USR24",$J,TMPCNT)="Business Rule created successfully."
  1. Q
  1. ;
  1. SETDATA(TMPCNT) ; Set data for rule
  1. ; -- Set data for exported Rule into Rule node of ^XTMP.
  1. ; Use interior data since there may be dup DDEF names.
  1. ; Must set AFTER User Class is created:
  1. N DDEFIEN,USRCLASS,EXACTION,INACTION,EXSTATUS,INSTATUS
  1. ; -- Get IEN of DDEF Number 1. (DDEF Number 1 is DC,
  1. ; PATIENT RECORD FLAG CAT I. See ^TIUEN165.)
  1. S DDEFIEN=$G(^XTMP("TIU165","BASICS",1,"DONE"))
  1. I DDEFIEN'>0 D G SETX
  1. . S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)=""
  1. . S TMPCNT=TMPCNT+1,^TMP("USR23",$J,TMPCNT)="Can't find Document Definition for rules. Contact National VistA Support."
  1. ; -- Get IEN of User Class created earlier:
  1. S USRCLASS=+$G(^XTMP("USR24","DONE"))
  1. ; -- Set data for flds .01 (DDEF) and .04 (User Class) for rule:
  1. S ^XTMP("USR24","RULES",1,.01)=DDEFIEN
  1. S ^XTMP("USR24","RULES",1,.04)=USRCLASS
  1. ; -- Set rule desc data:
  1. S ^XTMP("USR24","RULESDESC",1)="This rule limits note entry to persons specially trained to assign and"
  1. S ^XTMP("USR24","RULESDESC",2)="document the assignment of Category I Patient Record Flags."
  1. S ^XTMP("USR24","RULESDESC",3)="Sites must not alter or delete this User Class."
  1. S ^XTMP("USR24","RULESDESC",4)="Sites must not alter, delete, or override this rule."
  1. S ^XTMP("USR24","RULESDESC",5)="Rule created by patch USR*1*24."
  1. ; -- Set action and status data for rule:
  1. S EXACTION="ENTRY"
  1. S INACTION=$O(^USR(8930.8,"B",EXACTION,0))
  1. S ^XTMP("USR24","RULES",1,.03)=INACTION
  1. S EXSTATUS="UNTRANSCRIBED"
  1. S INSTATUS=$O(^USR(8930.6,"B",EXSTATUS,0))
  1. S ^XTMP("USR24","RULES",1,.02)=INSTATUS
  1. SETX ;
  1. Q