source: WorldVistAEHR/trunk/r/AUTHORIZATION_SUBSCRIPTION-USR/USRMEMBR.m@ 1351

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

initial load of WorldVistAEHR
File size: 4.5 KB
RevLine 
[613]1USRMEMBR ; SLC/JER - User Class Management actions ;05/05/98
2 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**2,3,6,7**;Jun 20, 1997
3EDIT ; Edit user's class membership
4 N USRDA,USRDATA,USREXPND,USRI,USRSTAT,DIROUT,USRCHNG,USRLST
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 USRDATA=$G(^TMP("USRMMBRIDX",$J,USRI))
9 . W !!,"Editing #",+USRDATA,!
10 . S USRDA=+$P(USRDATA,U,2) D EDIT1
11 . I +$G(USRCHNG) S USRLST=$S($L($G(USRLST)):$G(USRLST)_", ",1:"")_USRI
12 . I $D(USRDATA) D UPDATE^USRM(USRDATA)
13 W !,"Refreshing the list."
14 S VALMSG="** "_$S($L($G(USRLST)):"Item"_$S($L($G(USRLST),",")>1:"s ",1:" ")_$G(USRLST),1:"Nothing")_" Edited **"
15 K VALMY S VALMBCK="R"
16 Q
17EDIT1 ; Single record edit
18 ; Receives USRDA
19 N DA,DIE,DR
20 I '+$G(USRDA) W !,"No Classes selected." H 2 S USRCHNG=0 Q
21 S DIE="^USR(8930.3,",DA=USRDA,DR="[USR MEMBERSHIP EDIT]"
22 D FULL^VALM1,^DIE S USRCHNG=1
23 Q
24ADD ; Add a member to the class
25 N DA,DR,DIC,DLAYGO,X,Y,USRCLASS,USRUSER,USRQUIT,USRCNT D FULL^VALM1
26 S USRCNT=0
27 F D Q:+$G(USRQUIT)
28 . W !
29 . S DIC=200,DIC(0)="AEMQ"
30 . S DIC("A")="Select "_$S(USRCNT'>0:"",1:"Another ")_"MEMBER: "
31 . S DIC("S")="I ('$$ISAWM^USRLM(+Y,USRDA))"
32 . D ^DIC I +Y'>0 S USRQUIT=1 Q
33 . I $$ISTERM^USRLM(+Y) D Q
34 .. S USRQUIT=1
35 .. W !,"The user you selected is terminated, cannot add them as a class member!"
36 .. H 2
37 . S (DIC,DLAYGO)=8930.3,DIC(0)="LM",X=""""_$P(Y,U,2)_""""
38 . S DIC("W")="D DICW^USRMEMBR"
39 . D ^DIC I +Y'>0 S USRQUIT=1 Q
40 . S USRCREAT=+$P(Y,U,3),USRCNT=USRCNT+1
41 . S DA=+Y,DIE=DIC,DIE("NO^")="BACK",DR="[USR CLASS EDIT]" D ^DIE
42 . I $D(Y) D Q
43 . . S DIK=DIC D ^DIK K DIK
44 . . S:+USRCNT'>1 VALMSG="** Nothing Added **"
45 . . S VALMBCK="R",USRQUIT=1
46 . I 'USRCREAT D Q
47 . . S:+USRCNT'>1 VALMSG="** Nothing Added **"
48 . . S VALMBCK="R",USRQUIT=1
49 W !,"Rebuilding membership list."
50 S USRCLASS=+$G(^TMP("USRM",$J,0))
51 D BUILD^USRMLST(USRCLASS)
52 I USRCNT'>1,+$G(DA) D
53 . S USRUSER=$$SIGNAME^USRLS(+$G(^USR(8930.3,+DA,0)))
54 . S VALMSG="** "_USRUSER_" Added **"
55 S VALMCNT=+$G(@VALMAR@(0))
56 S VALMBCK="R"
57 Q
58DICW ; Write code for member look-up
59 N USRSIGNM,USRCLASS,USREFF,USREXP,USRMEM
60 S USRMEM=$G(^USR(8930.3,+Y,0))
61 S USRSIGNM=$$SIGNAME^USRLS(+USRMEM)
62 S USRCLASS=$E($$CLNAME^USRLM(+$P(USRMEM,U,2)),1,24)
63 S USREFF=$$DATE^USRLS($P(USRMEM,U,3),"MM/DD/YY")
64 S USREXP=$$DATE^USRLS($P(USRMEM,U,4),"MM/DD/YY")
65 W USRSIGNM," ",USRCLASS,?60,USREFF," - ",USREXP
66 Q
67DELETE ; Delete a member to the class
68 N DIE,X,Y,USRCLASS D FULL^VALM1
69 N USRCLASS,USRDA,USRCHNG,USRDATA,USRI,USRLST,DIROUT
70 I '$D(VALMY) D EN^VALM2(XQORNOD(0))
71 S USRI=0
72 F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT)
73 . S USRDATA=$G(^TMP("USRMMBRIDX",$J,USRI))
74 . S USRDA=+$P(USRDATA,U,2) D DELETE1(USRDA)
75 . S:+$G(USRCHNG) USRLST=$S(+$G(USRLST):USRLST_", ",1:"")_+USRDATA
76 . I $D(USRDATA) D UPDATE^USRM(USRDATA)
77 W !,"Rebuilding the list."
78 S USRCLASS=+$G(^TMP("USRM",$J,0))
79 D BUILD^USRMLST(USRCLASS)
80 S VALMCNT=+$G(@VALMAR@(0))
81 K VALMY S VALMBCK="R"
82 S VALMSG="** "_$S($L($G(USRLST)):"Item"_$S($L($G(USRLST),",")>1:"s ",1:" ")_$G(USRLST),1:"Nothing")_" removed **"
83 Q
84DELETE1(DA) ; Delete one member from a class
85 N DIE,DR,USER,CLASS,USRMEM S USRMEM=$G(^USR(8930.3,+DA,0))
86 I USRMEM']"" W !,"Record #",DA," NOT FOUND!" Q
87 S USER=$P($G(^VA(200,+USRMEM,0)),U)
88 S CLASS=$P($G(^USR(8930,+$P(USRMEM,U,2),0)),U)
89 W !,"Removing ",USER," from ",CLASS
90 I '$$READ^USRU("Y","Are you SURE","NO") S USRCHNG=0 W !,USER," NOT Removed from ",CLASS,"." Q
91 S USRCHNG=1
92 S DIK="^USR(8930.3," D ^DIK K DIK W "."
93 Q
94SCHEDULE ; Schedule changes in class membership
95 N DIC,DLAYGO,X,Y
96 N USRCREAT,USRDUZ,USRUSER,USRMIN,USRMAX,USREFF,USREXP,USRCLASS
97 N USRCLNM
98 D FULL^VALM1
99 I '$D(VALMY) D EN^VALM2(XQORNOD(0))
100 S DIC=8930,DIC(0)="AEMQZ",DIC("A")="Select CLASS: "
101 S DIC("B")=$P($G(^TMP("USRMMBR",$J,0)),U,2)
102 D ^DIC Q:+Y'>0
103 S USRCLASS=+Y,USRCLNM=$$CLNAME^USRLM(USRCLASS)
104 S USRMIN=DT,USRMAX=$$FMADD^XLFDT(DT,365)
105 S USREFF=$$READ^USRU("D^"_USRMIN_":"_USRMAX_":EXFT"," Specify EFFECTIVE DATE/TIME","TODAY")
106 S USREXP=$$READ^USRU("D^"_USRMIN_":"_USRMAX_":EXFT","Specify EXPIRATION DATE/TIME","T+365")
107 S USRI=0
108 F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D
109 . N USRDATA,USRDUZ,USRMEM,USRUSER,DIC,DIE,DA,DR,X,Y
110 . S USRDATA=$G(^TMP("USRMMBRIDX",$J,USRI))
111 . S USRMEM=$G(^USR(8930.3,+$P(USRDATA,U,2),0)),USRDUZ=+USRMEM
112 . S DIC=200,DIC(0)="NX",X="`"_USRDUZ
113 . D ^DIC Q:+Y'>0
114 . S (DIC,DLAYGO)=8930.3,DIC(0)="LM",X=""""_$P(Y,U,2)_""""
115 . D ^DIC Q:+Y'>0
116 . S USRCREAT=+$P(Y,U,3)
117 . S DA=+Y,DIE=DIC
118 . S DR=".02////"_USRCLASS_";.03////"_USREFF_";.04////"_USREXP
119 . D ^DIE
120 W !,"Rebuilding membership list."
121 S VALMBCK="R"
122 Q
Note: See TracBrowser for help on using the repository browser.