USRP1001 ; SLC/MAM - After installing TIU*1.0*137;28-Feb-2006 16:13;MGH
;;1.0;AUTHORIZATION/SUBSCRIPTION;**1001**;Jun 20, 1997
; Run this after installing patch 137.
;Use option: TIU137 DDEFS Rules, Anat Path
;
ENV N PATCH
S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
;
S PATCH="USR*1.0*23"
I '$$PATCH(PATCH) D Q
. W !,"You must first install "_PATCH_"." S XPDQUIT=2
Q
PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnnn
;copy of code from XPDUTL but modified to handle 4 digit IHS patch numb
Q:X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N 0
NEW NUM,I,J
S I=$O(^DIC(9.4,"C",$P(X,"*"),0)) Q:'I 0
S J=$O(^DIC(9.4,I,22,"B",$P(X,"*",2),0)),X=$P(X,"*",3) Q:'J 0
;check if patch is just a number
Q:$O(^DIC(9.4,I,22,J,"PAH","B",X,0)) 1
S NUM=$O(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
Q (X=+NUM)
;
POST ; Create new Business Rules
; Create rules for ONE User Class & ONE DDEF
; -- Set data for rules:
;If rules already exist, quit
N CL,ST,ACTION,MSG,RULENUM,VIEW,PRINT,IEN,USR
S RULENUM=0
S CL=$$FIND1^DIC(8925.1,,,"CLINICAL DOCUMENTS",,,"MSG")
I $D(MSG) D Q
.W !!,"Unable to find the class clinical documents. Rules cannot be added"
S ST=$$FIND1^DIC(8930.6,,,"RETRACTED",,,"MSG")
I $D(MSG) D Q
.W !!,"Unable to find the status RETRACTED. Rules cannot be added"
S USR=$$FIND1^DIC(8930,,,"CHIEF, MIS",,,"MSG")
I $D(MSG) D Q
.W !!,"Unable to find the user class CHIEF, MIS. Rules cannot be added."
S VIEW=$$FIND1^DIC(8930.8,,,"VIEW",,,"MSG")
I $D(MSG) D Q
.W !!,"Unable to find the action, VIEW. Rules cannot be added."
S PRINT=$$FIND1^DIC(8930.8,,,"PRINT RECORD",,,"MSG")
I $D(MSG) D Q
.W !!,"Unable to find the action PRINT RECORD. Rules cannot be added."
S IEN="" S IEN=$O(^USR(8930.1,"AC",CL,ST,VIEW,USR,IEN))
;Only add if this rule does not exist
I IEN="" D
. S RULENUM=RULENUM+1
. D SETDATA(RULENUM,VIEW)
;Only add the print rule if its not there
S IEN="" S IEN=$O(^USR(8930.1,"AC",CL,ST,PRINT,USR,IEN))
I IEN="" D
. S RULENUM=RULENUM+1
. D SETDATA(RULENUM,PRINT)
N NUM,SUCCESS
S SUCCESS=1,NUM=0
; -- Loop through numbered list of rules:
I '$O(^TMP("USR1001",$J,"RULES",0)) S SUCCESS=0 W "Business rules already exist" Q
F S NUM=$O(^TMP("USR1001",$J,"RULES",NUM)) Q:'NUM D
.N USRERR,FDA,DESC
.M FDA(8930.1,"+1,")=^TMP("USR1001",$J,"RULES",NUM)
.M DESC=^TMP("USR1001",$J,"RULESDESC")
.S FDA(8930.1,"+1,",1)="DESC"
.D UPDATE^DIE("","FDA","","USRERR")
.I $D(USRERR) S SUCCESS=0 Q
.K ^TMP("USR1001",$J,"RULES",NUM)
K ^TMP("USR1001",$J,"RULESDESC")
I '$G(SUCCESS) D Q
. W "Problem creating Business Rules. Please contact National VistA Support."
W "Business Rules created successfully."
Q
;
SETDATA(RULENUM,ACTION) ; Set data for rules
; -- Set data for exported Rules into Rule nodes of ^TMP.
; Use interior data since there may be dup DDEF names.
; Must set AFTER User Class is created:
N DDEFIEN,USRCLASS,EXACTION
S ^TMP("USR1001",$J,"RULES",RULENUM,.01)=CL
S ^TMP("USR1001",$J,"RULES",RULENUM,.04)=USR
S ^TMP("USR1001",$J,"RULES",RULENUM,.02)=ST
S ^TMP("USR1001",$J,"RULES",RULENUM,.03)=ACTION
S ^TMP("USR1001",$J,"RULESDESC",1)="Rule created by patch USR*1*1001."
S ^TMP("USR1001",$J,"RULESDESC",2)="Rules allowing retracted documents to be used by only medical records."
Q
SETX ;
Q
USRP1001 ; SLC/MAM - After installing TIU*1.0*137;28-Feb-2006 16:13;MGH
+1 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**1001**;Jun 20, 1997
+2 ; Run this after installing patch 137.
+3 ;Use option: TIU137 DDEFS Rules, Anat Path
+4 ;
ENV NEW PATCH
+1 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+2 ;
+3 SET PATCH="USR*1.0*23"
+4 IF '$$PATCH(PATCH)
Begin DoDot:1
+5 WRITE !,"You must first install "_PATCH_"."
SET XPDQUIT=2
End DoDot:1
QUIT
+6 QUIT
PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnnn
+1 ;copy of code from XPDUTL but modified to handle 4 digit IHS patch numb
+2 IF X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N
QUIT 0
+3 NEW NUM,I,J
+4 SET I=$ORDER(^DIC(9.4,"C",$PIECE(X,"*"),0))
IF 'I
QUIT 0
+5 SET J=$ORDER(^DIC(9.4,I,22,"B",$PIECE(X,"*",2),0))
SET X=$PIECE(X,"*",3)
IF 'J
QUIT 0
+6 ;check if patch is just a number
+7 IF $ORDER(^DIC(9.4,I,22,J,"PAH","B",X,0))
QUIT 1
+8 SET NUM=$ORDER(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
+9 QUIT (X=+NUM)
+10 ;
POST ; Create new Business Rules
+1 ; Create rules for ONE User Class & ONE DDEF
+2 ; -- Set data for rules:
+3 ;If rules already exist, quit
+4 NEW CL,ST,ACTION,MSG,RULENUM,VIEW,PRINT,IEN,USR
+5 SET RULENUM=0
+6 SET CL=$$FIND1^DIC(8925.1,,,"CLINICAL DOCUMENTS",,,"MSG")
+7 IF $DATA(MSG)
Begin DoDot:1
+8 WRITE !!,"Unable to find the class clinical documents. Rules cannot be added"
End DoDot:1
QUIT
+9 SET ST=$$FIND1^DIC(8930.6,,,"RETRACTED",,,"MSG")
+10 IF $DATA(MSG)
Begin DoDot:1
+11 WRITE !!,"Unable to find the status RETRACTED. Rules cannot be added"
End DoDot:1
QUIT
+12 SET USR=$$FIND1^DIC(8930,,,"CHIEF, MIS",,,"MSG")
+13 IF $DATA(MSG)
Begin DoDot:1
+14 WRITE !!,"Unable to find the user class CHIEF, MIS. Rules cannot be added."
End DoDot:1
QUIT
+15 SET VIEW=$$FIND1^DIC(8930.8,,,"VIEW",,,"MSG")
+16 IF $DATA(MSG)
Begin DoDot:1
+17 WRITE !!,"Unable to find the action, VIEW. Rules cannot be added."
End DoDot:1
QUIT
+18 SET PRINT=$$FIND1^DIC(8930.8,,,"PRINT RECORD",,,"MSG")
+19 IF $DATA(MSG)
Begin DoDot:1
+20 WRITE !!,"Unable to find the action PRINT RECORD. Rules cannot be added."
End DoDot:1
QUIT
+21 SET IEN=""
SET IEN=$ORDER(^USR(8930.1,"AC",CL,ST,VIEW,USR,IEN))
+22 ;Only add if this rule does not exist
+23 IF IEN=""
Begin DoDot:1
+24 SET RULENUM=RULENUM+1
+25 DO SETDATA(RULENUM,VIEW)
End DoDot:1
+26 ;Only add the print rule if its not there
+27 SET IEN=""
SET IEN=$ORDER(^USR(8930.1,"AC",CL,ST,PRINT,USR,IEN))
+28 IF IEN=""
Begin DoDot:1
+29 SET RULENUM=RULENUM+1
+30 DO SETDATA(RULENUM,PRINT)
End DoDot:1
+31 NEW NUM,SUCCESS
+32 SET SUCCESS=1
SET NUM=0
+33 ; -- Loop through numbered list of rules:
+34 IF '$ORDER(^TMP("USR1001",$JOB,"RULES",0))
SET SUCCESS=0
WRITE "Business rules already exist"
QUIT
+35 FOR
SET NUM=$ORDER(^TMP("USR1001",$JOB,"RULES",NUM))
IF 'NUM
QUIT
Begin DoDot:1
+36 NEW USRERR,FDA,DESC
+37 MERGE FDA(8930.1,"+1,")=^TMP("USR1001",$JOB,"RULES",NUM)
+38 MERGE DESC=^TMP("USR1001",$JOB,"RULESDESC")
+39 SET FDA(8930.1,"+1,",1)="DESC"
+40 DO UPDATE^DIE("","FDA","","USRERR")
+41 IF $DATA(USRERR)
SET SUCCESS=0
QUIT
+42 KILL ^TMP("USR1001",$JOB,"RULES",NUM)
End DoDot:1
+43 KILL ^TMP("USR1001",$JOB,"RULESDESC")
+44 IF '$GET(SUCCESS)
Begin DoDot:1
+45 WRITE "Problem creating Business Rules. Please contact National VistA Support."
End DoDot:1
QUIT
+46 WRITE "Business Rules created successfully."
+47 QUIT
+48 ;
SETDATA(RULENUM,ACTION) ; Set data for rules
+1 ; -- Set data for exported Rules into Rule nodes of ^TMP.
+2 ; Use interior data since there may be dup DDEF names.
+3 ; Must set AFTER User Class is created:
+4 NEW DDEFIEN,USRCLASS,EXACTION
+5 SET ^TMP("USR1001",$JOB,"RULES",RULENUM,.01)=CL
+6 SET ^TMP("USR1001",$JOB,"RULES",RULENUM,.04)=USR
+7 SET ^TMP("USR1001",$JOB,"RULES",RULENUM,.02)=ST
+8 SET ^TMP("USR1001",$JOB,"RULES",RULENUM,.03)=ACTION
+9 SET ^TMP("USR1001",$JOB,"RULESDESC",1)="Rule created by patch USR*1*1001."
+10 SET ^TMP("USR1001",$JOB,"RULESDESC",2)="Rules allowing retracted documents to be used by only medical records."
+11 QUIT
SETX ;
+1 QUIT
