76 lines
2.5 KiB
Mathematica
76 lines
2.5 KiB
Mathematica
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
|
|
;
|