source: WorldVistAEHR/trunk/r/AUTHORIZATION_SUBSCRIPTION-USR/USRCLST.m@ 1800

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

initial load of WorldVistAEHR
File size: 3.2 KB
RevLine 
[613]1USRCLST ; SLC/JER - Review User Classes ;05/11/1998
2 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**1,3,7**;Jun 20, 1997
3MAKELIST ; Build review screen list
4 N USRI,USRTMP,STATUS,FNAME,LNAME
5 S STATUS=$$SELSTAT("ACTIVE")
6 I +STATUS<0 S VALMQUIT=1 Q
7 S FNAME=$$RANGE(" Start With Class","FIRST")
8 I +FNAME=-1 S VALMQUIT=1 Q
9 S LNAME=$$RANGE(" Go To Class","LAST")
10 I +LNAME=-1 S VALMQUIT=1 Q
11 W !,"Searching for the User Classes."
12 D BUILD(STATUS,FNAME,LNAME)
13 Q
14SELSTAT(DEFLT) ; Select User Class status
15 N DIC,XQORM,X,Y
16 S DIC=101,DIC(0)="X",X="USR CLASS STATUS SELECT" D ^DIC
17 I +Y>0 D
18 . S XQORM=+Y_";ORD(101,",XQORM(0)="1A",XQORM("A")="Select User Class Status: "
19 . S XQORM("B")=DEFLT D ^XQORM
20 . I +Y,($D(Y)>9) S Y=$S($P(Y(1),U,3)="Inactive":0,$P(Y(1),U,3)="Active":1,1:2)
21 Q Y
22RANGE(PROMPT,DEFAULT) ; Get range of classes to browse
23 N Y
24 S Y=$$READ^USRU("F^1:20",PROMPT,DEFAULT)
25 S Y=$S(Y["FIRST":"",Y["LAST":"Zzzz",1:$$MIXED^USRLS(Y))
26 I Y="^" S Y=-1
27 Q Y
28BUILD(STATUS,USRDNM,USRLNM) ; Build List
29 N CLASSABB
30 N USRNM,USRCNT,USRI,USRJ,USRK,USRP,USRREC,USRSTAT,XREF,USRPICK
31 S VALMCNT=0
32 S USRPICK=+$O(^ORD(101,"B","USR ACTION SELECT LIST ELEMENT",0))
33 K ^TMP("USRCLASS",$J),^TMP("USRCLASSIDX",$J)
34 F STATUS=$S(STATUS=2:0,1:STATUS):1:STATUS D
35 . S USRDNM=$S($G(USRDNM)]"":$O(^USR(8930,"ADNM",STATUS,$P($G(USRDNM),U,1)),-1),1:"")
36 . S USRLNM=$P($G(USRLNM),U,1)_"z"
37 . S USRNM=USRDNM
38 . F S USRNM=$O(^USR(8930,"ADNM",STATUS,USRNM)) Q:USRNM']""!(USRNM]USRLNM) D
39 . . S USRI=+$O(^USR(8930,"ADNM",STATUS,USRNM,0)) Q:+USRI'>0
40 . . N DIC,DIQ,DA,DR,USRCLASS,CLASNM,ACTIVE
41 . . S DIQ="USRCLASS",DIC=8930,DA=USRI
42 . . S DR=".01:.04" D EN^DIQ1
43 . . S CLASSNM=$S($G(USRCLASS(8930,DA,.04))]"":USRCLASS(8930,DA,.04),1:$$MIXED^USRLS($G(USRCLASS(8930,DA,.01))))
44 . . I +$O(^USR(8930,+USRI,1,0)) S CLASSNM="+"_CLASSNM
45 . . E S CLASSNM=" "_CLASSNM
46 . . S CLASSABB=$G(USRCLASS(8930,DA,.02))
47 . . S ACTIVE=$G(USRCLASS(8930,DA,.03))
48 . . S USRCNT=+$G(USRCNT)+1
49 . . S USRREC=$$SETFLD^VALM1(USRCNT,"","NUMBER")
50 . . S USRREC=$$SETFLD^VALM1(CLASSNM,USRREC,"CLASS NAME")
51 . . S USRREC=$$SETFLD^VALM1(CLASSABB,USRREC,"ABBREVIATION")
52 . . S USRREC=$$SETFLD^VALM1(ACTIVE,USRREC,"ACTIVE")
53 . . S VALMCNT=+$G(VALMCNT)+1
54 . . S ^TMP("USRCLASS",$J,VALMCNT,0)=USRREC
55 . . S ^TMP("USRCLASS",$J,"IDX",VALMCNT,USRCNT)=""
56 . . S ^TMP("USRCLASSIDX",$J,USRCNT)=VALMCNT_U_USRI_U W:VALMCNT#10'>0 "."
57 . .;Clear the video attributes so we start fresh.
58 . . D KILL^VALM10(VALMCNT)
59 S ^TMP("USRCLASS",$J,0)=+$G(USRCNT)_U_STATUS_U_USRDNM_U_USRLNM
60 S ^TMP("USRCLASS",$J,"#")=USRPICK_U_"1:"_+$G(USRCNT)
61 I $D(VALMHDR)>9 D HDR
62 I +$G(USRCNT)'>0 D
63 . S ^TMP("USRCLASS",$J,1,0)=""
64 . S ^TMP("USRCLASS",$J,2,0)="No "_$S(STATUS=0:"Inactive ",STATUS=1:"Active ",1:"")_"User Classes found"
65 Q
66HDR ; Initialize header for review screen
67 N BY,USRX,USRCNT,SCREEN,STATUS,TITLE
68 S USRX=$G(^TMP("USRCLASS",$J,0)),STATUS=$P("INACTIVE^ACTIVE^ALL",U,+$P(USRX,U,2)+1)
69 S TITLE=STATUS_" USER CLASSES"
70 S USRCNT=$J(+$G(^TMP("USRCLASS",$J,0)),4)
71 S USRCNT=USRCNT_" Class"_$S(+USRCNT=1:"",1:"es")
72 S VALMHDR(1)=$$CENTER^USRLS(TITLE)
73 S VALMHDR(1)=$$SETSTR^VALM1(USRCNT,VALMHDR(1),(IOM-$L(USRCNT)),$L(USRCNT))
74 Q
75CLEAN ; "Joel...Clean up your mess!"
76 K ^TMP("USRCLASS",$J),^TMP("USRCLASSIDX",$J)
77 Q
Note: See TracBrowser for help on using the repository browser.