source: WorldVistAEHR/trunk/r/AUTHORIZATION_SUBSCRIPTION-USR/USRRULA.m@ 770

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

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1USRRULA ; SLC/JER - Rule Browser actions ;2/6/98 17:12
2 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3,28**;Jun 20, 1997
3EDIT ; Edit an existing rule
4 N USRDA,USRI,DIROUT,USRCHNG,USRLST,USRRBLD
5 I '$D(VALMY) D EN^VALM2(XQORNOD(0))
6 S (USRCHNG,USRI)=0
7 F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT)
8 . S USRDA=+$O(^TMP("USRRUL",$J,"INDEX",USRI,0)) Q:+USRDA'>0
9 . W !!,"Editing #",+USRI,!
10 . D EDIT1
11 . I +$G(USRCHNG) S USRLST=$S($L($G(USRLST)):$G(USRLST)_", ",1:"")_USRI
12 W !,"Refreshing the list."
13 I $L($G(USRLST)) D
14 . S USRRBLD=$P($G(@VALMAR@(0)),U,1,4) D INIT^USRRUL,HDR^USRRUL
15 S VALMSG="** "_$S($L($G(USRLST)):"Item"_$S($L($G(USRLST),",")>1:"s ",1:" ")_$G(USRLST),1:"Nothing")_" Edited **"
16 K VALMY S VALMBCK="R"
17 Q
18EDIT1 ; Single record edit
19 ; Receives USRDA
20 N DA,DIE,DR
21 I '+$G(USRDA) W !,"No Classes selected." H 2 S USRCHNG=0 Q
22 S DIE="^USR(8930.1,",DA=USRDA,DR="[USR DEFINE AUTHORIZATIONS]"
23 D FULL^VALM1,^DIE S USRCHNG=1
24 I '$D(DA) W !!,"<Business Rule DELETED>" H 3 Q
25 Q
26ADD ; Add a member to the class
27 N DA,DR,DIC,DLAYGO,X,Y,USRRBLD,USRCNT D FULL^VALM1
28 W !,"Please Enter a New Business Rule:",!
29 S (DIC,DLAYGO)=8930.1,DIC(0)="NL",X=$$DOCPICK
30 Q:+X'>0
31 S X=""""_"`"_+X_""""
32 D ^DIC K DLAYGO Q:+Y'>0 S DA=+Y
33 S DIE=8930.1,DR="[USR DEFINE AUTHORIZATIONS]"
34 D ^DIE
35 I '$D(DA) S VALMSG="<Business Rule DELETED>" Q
36 S USRCNT=+$P($G(@VALMAR@(0)),U,5)
37 I +USRCNT D ADD^USRRUL(DA) S $P(@VALMAR@(0),U,5)=+USRCNT D HDR^USRRUL I 1
38 E S USRRBLD=$P($G(@VALMAR@(0)),U,1,4) D INIT^USRRUL,HDR^USRRUL
39 S USRCNT=+$P($G(@VALMAR@(0)),U,5)
40 S $P(@VALMAR@("#"),":",2)=+USRCNT
41 S VALMSG="** Item "_+USRCNT_" Added **"
42 S USRCHNG=1,VALMBCK="R"
43 Q
44DOCPICK() ; Function to pick a document for which rule will be created
45 N DIC,X,Y
46 ; I +$G(^TMP("USRRUL",$J,0))
47 S DIC=8925.1,DIC(0)="AEMQ",DIC("A")="Select DOCUMENT DEFINITION: "
48 S DIC("S")="I +$$CANPICK^TIULP(+Y),$S($P($G(^TIU(8925.1,+Y,0)),U,4)=""CO"":0,$P($G(^TIU(8925.1,+Y,0)),U,4)=""O"":0,$P($G(^TIU(8925.1,+Y,0)),U)[""ADDENDUM"":0,1:1)"
49 D ^DIC K DIC("S")
50 Q Y
51DELETE ; Delete a member to the class
52 N USRDA,USRCHNG,USRI,USRLST,DIE,X,Y,USRRBLD K DIROUT
53 D FULL^VALM1
54 I '$D(VALMY) D EN^VALM2(XQORNOD(0))
55 S USRI=0
56 F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT)
57 . S USRDA=+$O(^TMP("USRRUL",$J,"INDEX",USRI,0)) Q:+USRDA'>0
58 . W !!,"Deleting #",+USRI,!
59 . D DELETE1(USRDA)
60 . S:+USRCHNG USRLST=$S(+$G(USRLST):USRLST_", ",1:"")_+USRI
61 I +$G(USRLST) D
62 . S USRRBLD=$P($G(@VALMAR@(0)),U,1,4) D INIT^USRRUL,HDR^USRRUL
63 K VALMY S VALMBCK="R"
64 S VALMSG="** "_$S($L($G(USRLST)):"Item"_$S($L($G(USRLST),",")>1:"s ",1:" ")_$G(USRLST),1:"Nothing")_" deleted **"
65 Q
66DELETE1(DA) ; Delete one member from a class
67 N DIE,DR,USRI,USRULE D XLATE^USRAEDT(.USRULE,+DA)
68 I $G(USRULE)']"" W !,"Record #",DA," NOT FOUND!" Q
69 W !,"Removing the rule:",!
70 F USRI=1:1:$L(USRULE,"|") W !,$P(USRULE,"|",USRI)
71 W !
72 I '$$READ^USRU("Y","Are you SURE","NO") S USRCHNG=0 W !,"Business Rule NOT Removed." Q
73 W !,"Deleting Business Rule"
74 S USRCHNG=1
75 S DIK="^USR(8930.1," D ^DIK K DIK W "."
76 Q
Note: See TracBrowser for help on using the repository browser.