- 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 Mar 13, 2025@20:43:43 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 ;
