source: WorldVistAEHR/trunk/r/AUTHORIZATION_SUBSCRIPTION-USR/USRCLASS.m@ 738

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1USRCLASS ; SLC/JER - User Class Management actions ;08/17/1999
2 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**7,11**;Jun 20, 1997
3EDIT ; Edit user classes
4 N USRDA,USRDATA,USREXPND,USRI,USRSTAT,DIROUT,USRCHNG,USRLST
5 D:'$D(VALMY) EN^VALM2(XQORNOD(0)) S USRI=0
6 F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT)
7 . S USRDATA=$S(VALMAR="^TMP(""USRCLASS"",$J)":$G(^TMP("USRCLASSIDX",$J,USRI)),1:$G(^TMP("USREXPIDX",$J,USRI)))
8 . W !!,"Editing #",+USRDATA,!
9 . S USRDA=+$P(USRDATA,U,2) D EDIT1
10 . I +$G(USRCHNG) S USRLST=$S($L($G(USRLST)):$G(USRLST)_", ",1:"")_USRI
11 . I $D(USRDATA) D UPDATE^USRL(USRDATA)
12 W !,"Refreshing the list."
13 S VALMSG="** "_$S($L($G(USRLST)):"Item"_$S($L($G(USRLST),",")>1:"s ",1:" ")_$G(USRLST),1:"Nothing")_" Edited **"
14 K VALMY S VALMBCK="R"
15 Q
16EDIT1 ; Single record edit
17 ; Receives USRDA
18 N DA,DIE,DR
19 I '+$G(USRDA) W !,"No Classes selected." H 2 Q
20 S DIE="^USR(8930,",DA=USRDA,DR="[USR CLASS STRUCTURE EDIT]"
21 D FULL^VALM1,^DIE
22 S USRCHNG=1
23 Q
24EXPAND ; Expand/Collapse user class hierarchy display
25 N USRDNM,USRLNM,USRSTAT
26 D:'$D(VALMY) EN^VALM2(XQORNOD(0))
27 I $D(VALMY) D EC^USRECCL(.VALMY)
28 W !,"Refreshing the list."
29 ;S VALMSG="** "_$S($L($G(USRLST)):"Item"_$S($L($G(USRLST),",")>1:"s ",1:" ")_$G(USRLST),1:"Nothing")_" Edited **"
30 K VALMY S VALMBCK="R"
31 ;
32 S USRSTAT=+$P($G(^TMP("USRCLASS",$J,0)),U,2)
33 S USRDNM=$P($G(^TMP("USRCLASS",$J,0)),U,3)
34 S USRLNM=$P($G(^TMP("USRCLASS",$J,0)),U,4)
35 ;
36 S VALMCNT=+$G(@VALMAR@(0))
37 S VALMBCK="R"
38 Q
39CREATE ; Class constructor
40 N USRCREAT
41 N DIC,DLAYGO,X,Y,USRSTAT,USRDNM,USRLNM D FULL^VALM1
42 S (DIC,DLAYGO)=8930,DIC(0)="AELMQ",DIC("A")="Select CLASS: "
43 D ^DIC Q:+Y'>0
44 S USRCREAT=+$P(Y,U,3)
45 S DA=+Y,DIE=DIC,DIE("NO^")="BACK",DR="[USR CLASS STRUCTURE EDIT]"
46 D ^DIE
47 S USRSTAT=+$P($G(^TMP("USRCLASS",$J,0)),U,2)
48 S USRDNM=$P($G(^TMP("USRCLASS",$J,0)),U,3)
49 S USRLNM=$P($G(^TMP("USRCLASS",$J,0)),U,4)
50 I 'USRCREAT Q ; Don't rebuild without cause
51 W !,"Rebuilding main class list."
52 D BUILD^USRCLST(USRSTAT,USRDNM,USRLNM)
53 S VALMCNT=+$G(@VALMAR@(0))
54 S VALMBCK="R"
55 Q
56MEMBERS ; List Members of classes and their subclasses
57 N USRDA,USRDATA,USREXPND,USRI,USRSTAT,VALMCNT,DIROUT
58 D:'$D(VALMY) EN^VALM2(XQORNOD(0)) S USRI=0
59 F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT)
60 . S USRDATA=$S(VALMAR="^TMP(""USRCLASS"",$J)":$G(^TMP("USRCLASSIDX",$J,USRI)),1:$G(^TMP("USREXPIDX",$J,USRI)))
61 . W !!,"Listing Members of #",+USRDATA,!
62 . S USRDA=+$P(USRDATA,U,2) D EN^VALM("USR LIST MEMBERSHIP BY CLASS")
63 . I $D(USRDATA) D UPDATE^USRL(USRDATA)
64 W !,"Refreshing the list."
65 S VALMSG="Members listed"
66 K VALMY S VALMBCK="R"
67 Q
Note: See TracBrowser for help on using the repository browser.