source: FOIAVistA/tag/r/AUTHORIZATION_SUBSCRIPTION-USR/USRCLST.m@ 628

USRCLST ; SLC/JER - Review User Classes ;05/11/1998
 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**1,3,7**;Jun 20, 1997
MAKELIST ; Build review screen list
 N USRI,USRTMP,STATUS,FNAME,LNAME
 S STATUS=$$SELSTAT("ACTIVE")
 I +STATUS<0 S VALMQUIT=1 Q
 S FNAME=$$RANGE("        Start With Class","FIRST")
 I +FNAME=-1 S VALMQUIT=1 Q
 S LNAME=$$RANGE("             Go To Class","LAST")
 I +LNAME=-1 S VALMQUIT=1 Q 
 W !,"Searching for the User Classes."
 D BUILD(STATUS,FNAME,LNAME)
 Q
SELSTAT(DEFLT) ; Select User Class status
 N DIC,XQORM,X,Y
 S DIC=101,DIC(0)="X",X="USR CLASS STATUS SELECT" D ^DIC
 I +Y>0 D
 . S XQORM=+Y_";ORD(101,",XQORM(0)="1A",XQORM("A")="Select User Class Status: "
 . S XQORM("B")=DEFLT D ^XQORM
 . I +Y,($D(Y)>9) S Y=$S($P(Y(1),U,3)="Inactive":0,$P(Y(1),U,3)="Active":1,1:2)
 Q Y
RANGE(PROMPT,DEFAULT) ; Get range of classes to browse
 N Y
 S Y=$$READ^USRU("F^1:20",PROMPT,DEFAULT)
 S Y=$S(Y["FIRST":"",Y["LAST":"Zzzz",1:$$MIXED^USRLS(Y))
 I Y="^" S Y=-1
 Q Y
BUILD(STATUS,USRDNM,USRLNM) ; Build List
 N CLASSABB
 N USRNM,USRCNT,USRI,USRJ,USRK,USRP,USRREC,USRSTAT,XREF,USRPICK
 S VALMCNT=0
 S USRPICK=+$O(^ORD(101,"B","USR ACTION SELECT LIST ELEMENT",0))
 K ^TMP("USRCLASS",$J),^TMP("USRCLASSIDX",$J)
 F STATUS=$S(STATUS=2:0,1:STATUS):1:STATUS D
 . S USRDNM=$S($G(USRDNM)]"":$O(^USR(8930,"ADNM",STATUS,$P($G(USRDNM),U,1)),-1),1:"")
 . S USRLNM=$P($G(USRLNM),U,1)_"z"
 . S USRNM=USRDNM
 . F  S USRNM=$O(^USR(8930,"ADNM",STATUS,USRNM)) Q:USRNM']""!(USRNM]USRLNM)  D
 . . S USRI=+$O(^USR(8930,"ADNM",STATUS,USRNM,0)) Q:+USRI'>0
 . . N DIC,DIQ,DA,DR,USRCLASS,CLASNM,ACTIVE
 . . S DIQ="USRCLASS",DIC=8930,DA=USRI
 . . S DR=".01:.04" D EN^DIQ1
 . . S CLASSNM=$S($G(USRCLASS(8930,DA,.04))]"":USRCLASS(8930,DA,.04),1:$$MIXED^USRLS($G(USRCLASS(8930,DA,.01))))
 . . I +$O(^USR(8930,+USRI,1,0)) S CLASSNM="+"_CLASSNM
 . . E  S CLASSNM=" "_CLASSNM
 . . S CLASSABB=$G(USRCLASS(8930,DA,.02))
 . . S ACTIVE=$G(USRCLASS(8930,DA,.03))
 . . S USRCNT=+$G(USRCNT)+1
 . . S USRREC=$$SETFLD^VALM1(USRCNT,"","NUMBER")
 . . S USRREC=$$SETFLD^VALM1(CLASSNM,USRREC,"CLASS NAME")
 . . S USRREC=$$SETFLD^VALM1(CLASSABB,USRREC,"ABBREVIATION")
 . . S USRREC=$$SETFLD^VALM1(ACTIVE,USRREC,"ACTIVE")
 . . S VALMCNT=+$G(VALMCNT)+1
 . . S ^TMP("USRCLASS",$J,VALMCNT,0)=USRREC
 . . S ^TMP("USRCLASS",$J,"IDX",VALMCNT,USRCNT)=""
 . . S ^TMP("USRCLASSIDX",$J,USRCNT)=VALMCNT_U_USRI_U W:VALMCNT#10'>0 "."
 . .;Clear the video attributes so we start fresh.
 . . D KILL^VALM10(VALMCNT)
 S ^TMP("USRCLASS",$J,0)=+$G(USRCNT)_U_STATUS_U_USRDNM_U_USRLNM
 S ^TMP("USRCLASS",$J,"#")=USRPICK_U_"1:"_+$G(USRCNT)
 I $D(VALMHDR)>9 D HDR
 I +$G(USRCNT)'>0 D
 . S ^TMP("USRCLASS",$J,1,0)=""
 . S ^TMP("USRCLASS",$J,2,0)="No "_$S(STATUS=0:"Inactive ",STATUS=1:"Active ",1:"")_"User Classes found"
 Q
HDR ; Initialize header for review screen
 N BY,USRX,USRCNT,SCREEN,STATUS,TITLE
 S USRX=$G(^TMP("USRCLASS",$J,0)),STATUS=$P("INACTIVE^ACTIVE^ALL",U,+$P(USRX,U,2)+1)
 S TITLE=STATUS_" USER CLASSES"
 S USRCNT=$J(+$G(^TMP("USRCLASS",$J,0)),4)
 S USRCNT=USRCNT_" Class"_$S(+USRCNT=1:"",1:"es")
 S VALMHDR(1)=$$CENTER^USRLS(TITLE)
 S VALMHDR(1)=$$SETSTR^VALM1(USRCNT,VALMHDR(1),(IOM-$L(USRCNT)),$L(USRCNT))
 Q
CLEAN ; "Joel...Clean up your mess!"
 K ^TMP("USRCLASS",$J),^TMP("USRCLASSIDX",$J)
 Q