source: FOIAVistA/trunk/r/AUTHORIZATION_SUBSCRIPTION-USR/USRUMMBR.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 4.9 KB
Line 
1USRUMMBR ; SLC/JER,MA - User Class Membership by User actions ;6/28/00 13:49
2 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**2,3,5,6,7,8,14,16**;Jun 20, 1997
3 ; 14 Feb 00 MA - Added check for 0 USRDA in DELETE
4 ; 19 Jun 00 MA - Added check for inactive class when adding user.
5EDIT ; Edit user's class membership
6 N USRDA,USRDATA,USREXPND,USRI,USRSTAT,DIROUT,USRCHNG,USRLST
7 I '$D(VALMY) D EN^VALM2(XQORNOD(0))
8 S (USRCHNG,USRI)=0
9 F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT)
10 . S USRDATA=$G(^TMP("USRUSERIDX",$J,USRI))
11 . W !!,"Editing #",+USRDATA,!
12 . S USRDA=+$P(USRDATA,U,2) D EDIT1
13 . I +$G(USRCHNG) S USRLST=$S($L($G(USRLST)):$G(USRLST)_", ",1:"")_USRI
14 . I $D(USRDATA) D UPDATE^USRUM(USRDATA)
15 W !,"Refreshing the list."
16 S VALMSG="** "_$S($L($G(USRLST)):"Item"_$S($L($G(USRLST),",")>1:"s ",1:" ")_$G(USRLST),1:"Nothing")_" Edited **"
17 K VALMY S VALMBCK="R"
18 Q
19EDIT1 ; Single record edit
20 ; Receives USRDA
21 N DA,DIE,DR
22 I '+$G(USRDA) W !,"No Member selected." H 2 S USRCHNG=0 Q
23 S DIE="^USR(8930.3,",DA=USRDA,DR="[USR MEMBERSHIP EDIT]"
24 D FULL^VALM1,^DIE S USRCHNG=1
25 Q
26ADD ; Add a membership to selected classes for current user
27 N CLASSADD,DIC,DLAYGO,FDA,MSG,X,Y
28 N I2N,FDA,FDAIEN,MSG
29 N USRCLASS,USRCREAT,USRUSER,USRCNT,USRQUIT
30 D FULL^VALM1
31 I $$ISTERM^USRLM(USRDUZ) D Q
32 . W !,"You cannot add class memberships, this user is terminated!"
33 . H 2
34 S USRCNT=0
35 F D Q:+$G(USRQUIT)
36 . W !
37 . S DIC=8930,DIC(0)="AEMQ"
38 . S DIC("A")="Select "_$S(USRCNT'>0:"",1:"Another ")_"USER CLASS: "
39 . D ^DIC I +Y'>0 S USRQUIT=1 Q
40 . ;
41 . ; Mike Antry added the check for inactive CLASS 19 June 2000
42 . I $P(^USR(8930,+Y,0),"^",3)=0 D Q
43 .. W !,"You may not add a user to a inactive USER CLASS !!!"
44 .. I $$READ^USRU("FAO","Press return to continue")
45 .. S USRQUIT=1
46 . S USRCLASS=+Y
47 . S DIC=200,DIC(0)="NMX",X="`"_USRDUZ
48 .;Make sure the user is not already a member of this class.
49 . I $$ISAWM^USRLM(USRDUZ,USRCLASS) S USRQUIT=1 Q
50 . K FDA,FDAIEN,MSG
51 . S CLASSADD=0
52 . S I2N="+1,"
53 . S FDA(8930.3,I2N,.01)=USRDUZ
54 . S FDA(8930.3,I2N,.02)=USRCLASS
55 . D UPDATE^DIE("","FDA","FDAIEN","MSG")
56 . I +$G(FDAIEN(1))>0 D
57 .. S CLASSADD=1
58 .. S DA=+FDAIEN(1),DIE=8930.3,DIE("NO^")="BACK"
59 .. S DR=".03;.04" D ^DIE
60 .. I $D(Y) D
61 ... S DIK=DIC D ^DIK K DIK
62 ... S CLASSADD=0
63 . I 'CLASSADD D Q
64 .. W !,"Error adding ",$$CLNAME^USRLM(+$P($G(^USR(8930.3,+DA,0)),U,2))
65 . E S USRCNT=USRCNT+1
66 W !,"Rebuilding membership list."
67 D BUILD^USRULST(USRDUZ)
68 I USRCNT>0 D
69 . S USRUSER=$$SIGNAME^USRLS(+$G(USRDUZ))
70 . S VALMSG="** "_USRUSER_" added to "_USRCNT_" classes **"
71 S VALMCNT=+$G(@VALMAR@(0))
72 S VALMBCK="R"
73 Q
74DELETE ; Delete a member of the class
75 N DIE,X,Y,USRCLASS D FULL^VALM1
76 N USRCLASS,USRDA,USRCHNG,USRDATA,USRI,USRLST,DIROUT
77 I '$D(VALMY) D EN^VALM2(XQORNOD(0))
78 S USRI=0
79 F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT)
80 . S USRDATA=$G(^TMP("USRUSERIDX",$J,USRI))
81 . ;02/14/00 Been having trouble with USRDA=0
82 . ;possible bad x-ref. Will check for USRDA=0
83 . ;Changed USRLM to check for valid 0 node for x-ref AUC
84 . S USRDA=+$P(USRDATA,U,2) Q:USRDA=0 D DELETE1(USRDA)
85 . S:+$G(USRCHNG) USRLST=$S(+$G(USRLST):USRLST_", ",1:"")_+USRDATA
86 . I $D(USRDATA) D UPDATE^USRUM(USRDATA)
87 W !,"Rebuilding the list."
88 S USRCLASS=+$G(^TMP("USRU",$J,0))
89 D BUILD^USRULST(USRDUZ)
90 S VALMCNT=+$G(@VALMAR@(0))
91 K VALMY S VALMBCK="R"
92 S VALMSG="** "_$S($L($G(USRLST)):"Item"_$S($L($G(USRLST),",")>1:"s ",1:" ")_$G(USRLST),1:"Nothing")_" removed **"
93 Q
94DELETE1(DA) ; Delete one member from a class
95 N DIE,DR,USER,CLASS,USRMEM S USRMEM=$G(^USR(8930.3,+DA,0))
96 I USRMEM']"" W !,"Record #",DA," NOT FOUND!" H 2 D MAILMSG Q
97 S USER=$P($G(^VA(200,+USRMEM,0)),U)
98 S CLASS=$P($G(^USR(8930,+$P(USRMEM,U,2),0)),U)
99 W !,"Removing ",USER," from ",CLASS
100 I '$$READ^USRU("Y","Are you SURE","NO") S USRCHNG=0 W !,USER," NOT Removed from ",CLASS,"." H 2 Q
101 S USRCHNG=1
102 S DIK="^USR(8930.3," D ^DIK W "."
103 Q
104MAILMSG ; This section will mail an error message to DUZ
105 W " A mail message is being sent to ",$P($G(^VA(200,DUZ,0)),"^",1) H 1
106 N XMY,XMSUB,USRTEXT,XMTEXT,XMDUZ
107 S XMDUZ=0.5
108 S XMY(DUZ)=""
109 S XMSUB="ERROR MESSAGE FROM AUTHORIZED/SUBSCRIPTION (USRUMMBR)"
110 S USRTEXT(1)="This message is being generated due to a bad x-ref (AUC)"
111 S USRTEXT(2)="in ^USR(8930.3) pointing to a IEN on the 0 node that"
112 S USRTEXT(3)="does not exist."
113 S USRTEXT(4)=""
114 S USRTEXT(5)="Please forward this message to your IRM representative"
115 S USRTEXT(6)="asking them to verify the Global ^USR(8930.3) x-ref"
116 S USRTEXT(7)="on AUC & ACU."
117 S USRTEXT(8)=""
118 S USRTEXT(9)="IRM will need to verify that the x-ref AUC & ACU for"
119 S USRTEXT(10)=$$GET1^DIQ(200,USRDUZ,.01)_" is pointing to a valid 0 node."
120 S USRTEXT(11)=""
121 S USRTEXT(12)="DO NOT CONTINUE WITH THIS USER UNTIL IRM VERIFIES!!"
122 S USRTEXT(13)=""
123 S USRTEXT(14)="IRM please check ^USR(8930.3,""AUC"","_USRDUZ_") to"
124 S USRTEXT(15)="verify it is pointing to a valid 0 node IEN."
125 S USRTEXT(16)="Also do the same for x-ref ACU"
126 S XMTEXT="USRTEXT("
127 D ^XMD
128 Q
Note: See TracBrowser for help on using the repository browser.