USRRUL ; SLC/JER - Business Rule Browser ; 5/11/1998
;;1.0;AUTHORIZATION/SUBSCRIPTION;**3,7**;Jun 20, 1997
EN ; -- main entry point for USR RULE BROWSER
D EN^VALM("USR RULE BROWSER")
Q
;
HDR ; -- header code
N USRCNT S USRCNT=$P(@VALMAR@(0),U,5)_" Rule"
S:+USRCNT'=1 USRCNT=USRCNT_"s"
S VALMHDR(1)=$$CENTER^USRLS("List Business Rules by "_$P(@VALMAR@(0),U,3))
S VALMHDR(1)=$$SETSTR^VALM1(USRCNT,VALMHDR(1),(IOM-$L(USRCNT)),$L(USRCNT))
S VALMHDR(2)=$$CENTER^USRLS("for "_$P(@VALMAR@(0),U,4))
Q
;
INIT ; -- init variables and list array
N USRDA,USRCAT,USRXREF,USRVAL,USRCNT,USRPICK
D CLEAN^VALM10
S USRPICK=+$O(^ORD(101,"B","USR ACTION SELECT LIST ELEMENT",0))
S (USRDA,USRCNT,VALMCNT)=0,USRCAT=$G(USRRBLD) K USRRBLD
S:'+$G(USRCAT) USRCAT=$$SELCAT
I +USRCAT'>0 S VALMQUIT=1 Q
S USRVAL=$P(USRCAT,U),USRXREF=$P(USRCAT,U,2)
F S USRDA=$O(^USR(8930.1,USRXREF,USRVAL,USRDA)) Q:+USRDA'>0 D ADD(USRDA)
I 'VALMCNT D
. S @VALMAR@(1,0)=" "
. S @VALMAR@(2,0)="No Business Rules currently exist for "_$S($P(USRCAT,U,3)'["DOCUMENT":$P(USRCAT,U,3)_" ",1:"")_$P(USRCAT,U,4),VALMCNT=2
S @VALMAR@(0)=USRCAT_U_USRCNT
S @VALMAR@("#")=USRPICK_U_"1:"_USRCNT
Q
ADD(USRDA) ; -- add an element to the list
N USRRULE,USRPAD
S VALMCNT=+$G(VALMCNT)+1,USRCNT=+$G(USRCNT)+1
D XLATE^USRAEDT(.USRRULE,+USRDA)
S $P(USRPAD," ",6-$L(USRCNT))=""
D SET^VALM10(VALMCNT,USRCNT_USRPAD_$P(USRRULE,"|"),USRCNT)
S @VALMAR@("IDX",USRCNT,VALMCNT)=""
S @VALMAR@("INDEX",USRCNT,USRDA)=""
I $L(USRRULE,"|")>1 D
. N USRI,USRX
. F USRI=2:1:$L(USRRULE,"|") D
. . S USRX=$P(USRRULE,"|",USRI),VALMCNT=VALMCNT+1
. . D SET^VALM10(VALMCNT," "_USRX,USRCNT)
. . ;S @VALMAR@("PICK",USRCNT,VALMCNT)=""
Q
;
SELCAT() ; Select search category
N DIC,X,Y,USRY
S DIC=8930.4,DIC(0)="AEMQZ",DIC("A")="Select SEARCH CATEGORY: "
S DIC("B")="DOCUMENT"
D ^DIC K DIC
I +Y'>0 S USRY=Y G SELX
I $G(Y(0))]"" S USRY=$$ASKCAT(+Y,Y(0))
SELX Q USRY
ASKCAT(USRCAT,USRX) ; Given a search category, ask its value
N DIC,X,Y,USRY
S DIC=$P(USRX,U,2),DIC("A")="Select "_$P(USRX,U)_": "
I $G(^USR(8930.4,+USRCAT,1))]"" X ^USR(8930.4,+USRCAT,1)
S DIC(0)="AEMQZ" D ^DIC K DIC I +Y'>0 S USRY=Y G ASKX
S USRY=+Y_U_$P(USRX,U,3)_U_$P(USRX,U)_U_$S($P(USRX,U,2)=8925.1:$$DDHLEV($P(Y(0),U,4)),1:"")_$P(Y,U,2)
ASKX Q USRY
DDHLEV(USRDTYP) ; External value of Document Definition Type
N USRY
S USRY=$S(USRDTYP="CL":"CLASS ",USRDTYP="DC":"DOCUMENT CLASS ",USRDTYP="DOC":"TITLE ",1:"")
Q $G(USRY)
HELP ; -- help code
D PROTOCOL^USRHELP
Q
;
EXIT ; -- exit code
D CLEAN^VALM10
Q
;
EXPND ; -- expand code
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HUSRRUL 2645 printed Dec 13, 2024@01:39:03 Page 2
USRRUL ; SLC/JER - Business Rule Browser ; 5/11/1998
+1 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3,7**;Jun 20, 1997
EN ; -- main entry point for USR RULE BROWSER
+1 DO EN^VALM("USR RULE BROWSER")
+2 QUIT
+3 ;
HDR ; -- header code
+1 NEW USRCNT
SET USRCNT=$PIECE(@VALMAR@(0),U,5)_" Rule"
+2 if +USRCNT'=1
SET USRCNT=USRCNT_"s"
+3 SET VALMHDR(1)=$$CENTER^USRLS("List Business Rules by "_$PIECE(@VALMAR@(0),U,3))
+4 SET VALMHDR(1)=$$SETSTR^VALM1(USRCNT,VALMHDR(1),(IOM-$LENGTH(USRCNT)),$LENGTH(USRCNT))
+5 SET VALMHDR(2)=$$CENTER^USRLS("for "_$PIECE(@VALMAR@(0),U,4))
+6 QUIT
+7 ;
INIT ; -- init variables and list array
+1 NEW USRDA,USRCAT,USRXREF,USRVAL,USRCNT,USRPICK
+2 DO CLEAN^VALM10
+3 SET USRPICK=+$ORDER(^ORD(101,"B","USR ACTION SELECT LIST ELEMENT",0))
+4 SET (USRDA,USRCNT,VALMCNT)=0
SET USRCAT=$GET(USRRBLD)
KILL USRRBLD
+5 if '+$GET(USRCAT)
SET USRCAT=$$SELCAT
+6 IF +USRCAT'>0
SET VALMQUIT=1
QUIT
+7 SET USRVAL=$PIECE(USRCAT,U)
SET USRXREF=$PIECE(USRCAT,U,2)
+8 FOR
SET USRDA=$ORDER(^USR(8930.1,USRXREF,USRVAL,USRDA))
if +USRDA'>0
QUIT
DO ADD(USRDA)
+9 IF 'VALMCNT
Begin DoDot:1
+10 SET @VALMAR@(1,0)=" "
+11 SET @VALMAR@(2,0)="No Business Rules currently exist for "_$SELECT($PIECE(USRCAT,U,3)'["DOCUMENT":$PIECE(USRCAT,U,3)_" ",1:"")_$PIECE(USRCAT,U,4)
SET VALMCNT=2
End DoDot:1
+12 SET @VALMAR@(0)=USRCAT_U_USRCNT
+13 SET @VALMAR@("#")=USRPICK_U_"1:"_USRCNT
+14 QUIT
ADD(USRDA) ; -- add an element to the list
+1 NEW USRRULE,USRPAD
+2 SET VALMCNT=+$GET(VALMCNT)+1
SET USRCNT=+$GET(USRCNT)+1
+3 DO XLATE^USRAEDT(.USRRULE,+USRDA)
+4 SET $PIECE(USRPAD," ",6-$LENGTH(USRCNT))=""
+5 DO SET^VALM10(VALMCNT,USRCNT_USRPAD_$PIECE(USRRULE,"|"),USRCNT)
+6 SET @VALMAR@("IDX",USRCNT,VALMCNT)=""
+7 SET @VALMAR@("INDEX",USRCNT,USRDA)=""
+8 IF $LENGTH(USRRULE,"|")>1
Begin DoDot:1
+9 NEW USRI,USRX
+10 FOR USRI=2:1:$LENGTH(USRRULE,"|")
Begin DoDot:2
+11 SET USRX=$PIECE(USRRULE,"|",USRI)
SET VALMCNT=VALMCNT+1
+12 DO SET^VALM10(VALMCNT," "_USRX,USRCNT)
+13 ;S @VALMAR@("PICK",USRCNT,VALMCNT)=""
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
SELCAT() ; Select search category
+1 NEW DIC,X,Y,USRY
+2 SET DIC=8930.4
SET DIC(0)="AEMQZ"
SET DIC("A")="Select SEARCH CATEGORY: "
+3 SET DIC("B")="DOCUMENT"
+4 DO ^DIC
KILL DIC
+5 IF +Y'>0
SET USRY=Y
GOTO SELX
+6 IF $GET(Y(0))]""
SET USRY=$$ASKCAT(+Y,Y(0))
SELX QUIT USRY
ASKCAT(USRCAT,USRX) ; Given a search category, ask its value
+1 NEW DIC,X,Y,USRY
+2 SET DIC=$PIECE(USRX,U,2)
SET DIC("A")="Select "_$PIECE(USRX,U)_": "
+3 IF $GET(^USR(8930.4,+USRCAT,1))]""
XECUTE ^USR(8930.4,+USRCAT,1)
+4 SET DIC(0)="AEMQZ"
DO ^DIC
KILL DIC
IF +Y'>0
SET USRY=Y
GOTO ASKX
+5 SET USRY=+Y_U_$PIECE(USRX,U,3)_U_$PIECE(USRX,U)_U_$SELECT($PIECE(USRX,U,2)=8925.1:$$DDHLEV($PIECE(Y(0),U,4)),1:"")_$PIECE(Y,U,2)
ASKX QUIT USRY
DDHLEV(USRDTYP) ; External value of Document Definition Type
+1 NEW USRY
+2 SET USRY=$SELECT(USRDTYP="CL":"CLASS ",USRDTYP="DC":"DOCUMENT CLASS ",USRDTYP="DOC":"TITLE ",1:"")
+3 QUIT $GET(USRY)
HELP ; -- help code
+1 DO PROTOCOL^USRHELP
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 DO CLEAN^VALM10
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
