| 1 | USRAEDT ; SLC/JER - Business Rule Edit ;2/28/01
|
|---|
| 2 | ;;1.0;AUTHORIZATION/SUBSCRIPTION;**15**;Jun 20, 1997
|
|---|
| 3 | MAIN ; Controls branching
|
|---|
| 4 | N DIC,DA,DIE,DR,DLAYGO,X,Y,DWPK,TIUFPRIV,USRY,USRI S TIUFPRIV=1
|
|---|
| 5 | W !,"Please Enter or Edit a Business Rule:",!
|
|---|
| 6 | S (DIC,DLAYGO)=8930.1,DIC(0)="AEMQL",DIC("A")="Select DOCUMENT DEFINITION: "
|
|---|
| 7 | D ^DIC K DIC,DLAYGO Q:+Y'>0 S DA=+Y
|
|---|
| 8 | S DIE=8930.1,DR="[USR DEFINE AUTHORIZATIONS]"
|
|---|
| 9 | D ^DIE
|
|---|
| 10 | I '$D(DA) W !!,"<Business Rule DELETED>" Q
|
|---|
| 11 | W !!,"You defined the following rule:",!
|
|---|
| 12 | D XLATE(.USRY,DA)
|
|---|
| 13 | S USRI=0 F S USRI=$O(USRY(USRI)) Q:+USRI'>0 D
|
|---|
| 14 | . W !?(2*USRI),USRY(USRI)
|
|---|
| 15 | Q
|
|---|
| 16 | XLATE(Y,DA) ; Translate business rule
|
|---|
| 17 | N STATUS,USRCLASS,USROLE,USRD0,USRI
|
|---|
| 18 | S USRD0=$G(^USR(8930.1,+DA,0))
|
|---|
| 19 | S STATUS=$$STATUS(DA,USRD0),USRCLASS=$$CLASS(DA,USRD0)
|
|---|
| 20 | S USROLE=$$ROLE(DA,USRD0)
|
|---|
| 21 | S Y=$S($E(STATUS,1,2)="UN":"An",$E(STATUS,1)="A":"An",1:"A")
|
|---|
| 22 | S Y=Y_" "_STATUS_" "
|
|---|
| 23 | ;**ID** was " may be "
|
|---|
| 24 | S Y=Y_$$DOCUMENT(DA,USRD0)_" may "_$$ACTION(DA,USRD0)_" by "
|
|---|
| 25 | S Y=Y_USRCLASS_$S($P(USRD0,U,5)="&":" who is also ",$P(USRD0,U,5)="!":" OR ",1:"")
|
|---|
| 26 | S Y=Y_USROLE,Y=$$WRAP^USRLS(Y,75)
|
|---|
| 27 | F USRI=1:1:$L(Y,"|") S Y(USRI)=$P(Y,"|",USRI)
|
|---|
| 28 | Q
|
|---|
| 29 | STATUS(DA,USRD0) ; to which status does the rule apply?
|
|---|
| 30 | N Y
|
|---|
| 31 | S Y=$P($G(^USR(8930.6,+$P(USRD0,U,2),0)),U)
|
|---|
| 32 | Q $G(Y)
|
|---|
| 33 | DOCUMENT(DA,USRD0) ; to which document does the rule apply?
|
|---|
| 34 | N Y
|
|---|
| 35 | S Y=$$DDHLEV($P($G(^TIU(8925.1,+USRD0,0)),U,4))
|
|---|
| 36 | S Y=Y_$$UP^XLFSTR($$PNAME^TIULC1(+USRD0))
|
|---|
| 37 | I $E(Y,$L(Y))="S" S Y=$E(Y,1,$L(Y)-1)
|
|---|
| 38 | Q $G(Y)
|
|---|
| 39 | DDHLEV(USRDTYP) ; External value of Document Definition Type
|
|---|
| 40 | N USRY
|
|---|
| 41 | S USRY=$S(USRDTYP="CL":"(CLASS) ",USRDTYP="DC":"(DOCUMENT CLASS) ",USRDTYP="DOC":"(TITLE) ",1:"")
|
|---|
| 42 | Q $G(USRY)
|
|---|
| 43 | ACTION(DA,USRD0) ; to which action does rule apply?
|
|---|
| 44 | ; **100** update with new DOCUMENT VERB fld in 8930.8
|
|---|
| 45 | N Y,ACTNDA,NODE0
|
|---|
| 46 | S ACTNDA=+$P(USRD0,U,3),NODE0=$G(^USR(8930.8,ACTNDA,0))
|
|---|
| 47 | S Y=$P(NODE0,U,6) ;DOCMT VERB
|
|---|
| 48 | ACTX Q $G(Y)
|
|---|
| 49 | ;
|
|---|
| 50 | CLASS(DA,USRD0) ; to which user class does the rule apply?
|
|---|
| 51 | N Y
|
|---|
| 52 | S Y=$$UP^XLFSTR($$CLNAME^USRLM($P(USRD0,U,4)))
|
|---|
| 53 | ; **ID** was "A ". Omit U to avoid "an User"
|
|---|
| 54 | I $L(Y) S Y=$S("AEIO"[$E(Y):"an ",1:"a ")_Y
|
|---|
| 55 | Q $G(Y)
|
|---|
| 56 | ROLE(DA,USRD0) ; to which user role does the rule apply?
|
|---|
| 57 | N Y,USRDA
|
|---|
| 58 | S USRDA=$P(USRD0,U,6),Y=$P($G(^USR(8930.2,+USRDA,0)),U)
|
|---|
| 59 | ;**ID** changed A and An to lower case
|
|---|
| 60 | I $L(Y) S Y=$S($E(Y)="A":"an ",$E(Y)="E":"an ",1:"a ")_Y
|
|---|
| 61 | Q Y
|
|---|
