| [613] | 1 | USRRUL ; SLC/JER - Business Rule Browser ; 5/11/1998
|
|---|
| 2 | ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3,7**;Jun 20, 1997
|
|---|
| 3 | EN ; -- main entry point for USR RULE BROWSER
|
|---|
| 4 | D EN^VALM("USR RULE BROWSER")
|
|---|
| 5 | Q
|
|---|
| 6 | ;
|
|---|
| 7 | HDR ; -- header code
|
|---|
| 8 | N USRCNT S USRCNT=$P(@VALMAR@(0),U,5)_" Rule"
|
|---|
| 9 | S:+USRCNT'=1 USRCNT=USRCNT_"s"
|
|---|
| 10 | S VALMHDR(1)=$$CENTER^USRLS("List Business Rules by "_$P(@VALMAR@(0),U,3))
|
|---|
| 11 | S VALMHDR(1)=$$SETSTR^VALM1(USRCNT,VALMHDR(1),(IOM-$L(USRCNT)),$L(USRCNT))
|
|---|
| 12 | S VALMHDR(2)=$$CENTER^USRLS("for "_$P(@VALMAR@(0),U,4))
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | INIT ; -- init variables and list array
|
|---|
| 16 | N USRDA,USRCAT,USRXREF,USRVAL,USRCNT,USRPICK
|
|---|
| 17 | D CLEAN^VALM10
|
|---|
| 18 | S USRPICK=+$O(^ORD(101,"B","USR ACTION SELECT LIST ELEMENT",0))
|
|---|
| 19 | S (USRDA,USRCNT,VALMCNT)=0,USRCAT=$G(USRRBLD) K USRRBLD
|
|---|
| 20 | S:'+$G(USRCAT) USRCAT=$$SELCAT
|
|---|
| 21 | I +USRCAT'>0 S VALMQUIT=1 Q
|
|---|
| 22 | S USRVAL=$P(USRCAT,U),USRXREF=$P(USRCAT,U,2)
|
|---|
| 23 | F S USRDA=$O(^USR(8930.1,USRXREF,USRVAL,USRDA)) Q:+USRDA'>0 D ADD(USRDA)
|
|---|
| 24 | I 'VALMCNT D
|
|---|
| 25 | . S @VALMAR@(1,0)=" "
|
|---|
| 26 | . 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
|
|---|
| 27 | S @VALMAR@(0)=USRCAT_U_USRCNT
|
|---|
| 28 | S @VALMAR@("#")=USRPICK_U_"1:"_USRCNT
|
|---|
| 29 | Q
|
|---|
| 30 | ADD(USRDA) ; -- add an element to the list
|
|---|
| 31 | N USRRULE,USRPAD
|
|---|
| 32 | S VALMCNT=+$G(VALMCNT)+1,USRCNT=+$G(USRCNT)+1
|
|---|
| 33 | D XLATE^USRAEDT(.USRRULE,+USRDA)
|
|---|
| 34 | S $P(USRPAD," ",6-$L(USRCNT))=""
|
|---|
| 35 | D SET^VALM10(VALMCNT,USRCNT_USRPAD_$P(USRRULE,"|"),USRCNT)
|
|---|
| 36 | S @VALMAR@("IDX",USRCNT,VALMCNT)=""
|
|---|
| 37 | S @VALMAR@("INDEX",USRCNT,USRDA)=""
|
|---|
| 38 | I $L(USRRULE,"|")>1 D
|
|---|
| 39 | . N USRI,USRX
|
|---|
| 40 | . F USRI=2:1:$L(USRRULE,"|") D
|
|---|
| 41 | . . S USRX=$P(USRRULE,"|",USRI),VALMCNT=VALMCNT+1
|
|---|
| 42 | . . D SET^VALM10(VALMCNT," "_USRX,USRCNT)
|
|---|
| 43 | . . ;S @VALMAR@("PICK",USRCNT,VALMCNT)=""
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | SELCAT() ; Select search category
|
|---|
| 47 | N DIC,X,Y,USRY
|
|---|
| 48 | S DIC=8930.4,DIC(0)="AEMQZ",DIC("A")="Select SEARCH CATEGORY: "
|
|---|
| 49 | S DIC("B")="DOCUMENT"
|
|---|
| 50 | D ^DIC K DIC
|
|---|
| 51 | I +Y'>0 S USRY=Y G SELX
|
|---|
| 52 | I $G(Y(0))]"" S USRY=$$ASKCAT(+Y,Y(0))
|
|---|
| 53 | SELX Q USRY
|
|---|
| 54 | ASKCAT(USRCAT,USRX) ; Given a search category, ask its value
|
|---|
| 55 | N DIC,X,Y,USRY
|
|---|
| 56 | S DIC=$P(USRX,U,2),DIC("A")="Select "_$P(USRX,U)_": "
|
|---|
| 57 | I $G(^USR(8930.4,+USRCAT,1))]"" X ^USR(8930.4,+USRCAT,1)
|
|---|
| 58 | S DIC(0)="AEMQZ" D ^DIC K DIC I +Y'>0 S USRY=Y G ASKX
|
|---|
| 59 | 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)
|
|---|
| 60 | ASKX Q USRY
|
|---|
| 61 | DDHLEV(USRDTYP) ; External value of Document Definition Type
|
|---|
| 62 | N USRY
|
|---|
| 63 | S USRY=$S(USRDTYP="CL":"CLASS ",USRDTYP="DC":"DOCUMENT CLASS ",USRDTYP="DOC":"TITLE ",1:"")
|
|---|
| 64 | Q $G(USRY)
|
|---|
| 65 | HELP ; -- help code
|
|---|
| 66 | D PROTOCOL^USRHELP
|
|---|
| 67 | Q
|
|---|
| 68 | ;
|
|---|
| 69 | EXIT ; -- exit code
|
|---|
| 70 | D CLEAN^VALM10
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
| 73 | EXPND ; -- expand code
|
|---|
| 74 | Q
|
|---|
| 75 | ;
|
|---|
