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
 ;