source: WorldVistAEHR/trunk/r/AUTHORIZATION_SUBSCRIPTION-USR/USRAEDT.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1USRAEDT ; SLC/JER - Business Rule Edit ;2/28/01
2 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**15**;Jun 20, 1997
3MAIN ; 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
16XLATE(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
29STATUS(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)
33DOCUMENT(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)
39DDHLEV(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)
43ACTION(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
48ACTX Q $G(Y)
49 ;
50CLASS(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)
56ROLE(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
Note: See TracBrowser for help on using the repository browser.