| 1 | USRULST ; SLC/JER - List Class Membership by user ;9/6/01 14:47
|
|---|
| 2 | ;;1.0;AUTHORIZATION/SUBSCRIPTION;**2,3,4,9,10,16,17,21,22,28**;Jun 20, 1997
|
|---|
| 3 | ; 30 Jun 00 MA - Added MAIN2 to prevent stack overflow
|
|---|
| 4 | ; 20 Sep 00 MA - Removed MAIN2 and added GETUSER and chg protocol to
|
|---|
| 5 | ; avoid looping through MAIN when doing a "CHANGE VIEW".
|
|---|
| 6 | ; 7 Aug 01 MA - Removed line "S USRDUZ=+Y" from line tag GETUSER()
|
|---|
| 7 | ; 6 Sep 01 MA - Added line "I +Y>0 S USRDUZ=Y" in GETUSER
|
|---|
| 8 | ; to avoid adding USER Classes to the wrong person.
|
|---|
| 9 | MAIN ; Control Branching
|
|---|
| 10 | N DIC,X,Y,USRDUZ
|
|---|
| 11 | S DIC=200,DIC(0)="AEMQ",DIC("A")="Select USER: "
|
|---|
| 12 | D ^DIC Q:+Y'>0
|
|---|
| 13 | S USRDUZ=+Y
|
|---|
| 14 | D EN^VALM(USRLTMPL)
|
|---|
| 15 | Q
|
|---|
| 16 | GETUSER() ; Get a new user
|
|---|
| 17 | N DIC,X,Y
|
|---|
| 18 | S DIC=200,DIC(0)="AEMQ",DIC("A")="Select USER: "
|
|---|
| 19 | D ^DIC ; If Y is not set then will use current USRDUZ
|
|---|
| 20 | I +Y>0 S USRDUZ=+Y
|
|---|
| 21 | Q USRDUZ
|
|---|
| 22 | MAKELIST ; Build review screen list
|
|---|
| 23 | W !,"Searching for the User Classes."
|
|---|
| 24 | D BUILD(USRDUZ)
|
|---|
| 25 | Q
|
|---|
| 26 | BUILD(USRDUZ) ; Build List
|
|---|
| 27 | ; DBIA 872 ^ORD(101)
|
|---|
| 28 | N USRCNT,USRNAME,USRPICK
|
|---|
| 29 | S (USRCNT,VALMCNT)=0
|
|---|
| 30 | S USRPICK=+$O(^ORD(101,"B","USR ACTION SELECT LIST ELEMENT",0))
|
|---|
| 31 | K ^TMP("USRUSER",$J),^TMP("USRUSERIDX",$J),^TMP("USRU",$J)
|
|---|
| 32 | D WHATIS^USRLM(USRDUZ,"^TMP(""USRU"",$J)")
|
|---|
| 33 | S USRNAME=""
|
|---|
| 34 | F S USRNAME=$O(^TMP("USRU",$J,USRNAME),-1) Q:USRNAME="" Q:USRNAME=0 D
|
|---|
| 35 | . N USRDA,USREFF,USREXP,USRMEM,USRREC,USRCLNM
|
|---|
| 36 | . S USRMEM=$G(^TMP("USRU",$J,USRNAME))
|
|---|
| 37 | . S USRDA=+$P(USRMEM,U,2)
|
|---|
| 38 | . S USRCLNM=$P(USRMEM,U,3)
|
|---|
| 39 | . S USREFF=$$DATE^USRLS(+$P(USRMEM,U,4),"MM/DD/YY")
|
|---|
| 40 | . S USREXP=$$DATE^USRLS(+$P(USRMEM,U,5),"MM/DD/YY")
|
|---|
| 41 | . S USRCNT=+$G(USRCNT)+1
|
|---|
| 42 | . S USRREC=$$SETFLD^VALM1(USRCNT,"","NUMBER")
|
|---|
| 43 | . S USRREC=$$SETFLD^VALM1(USRCLNM,USRREC,"CLASS")
|
|---|
| 44 | . S USRREC=$$SETFLD^VALM1(USREFF,USRREC,"EFFECTIVE")
|
|---|
| 45 | . S USRREC=$$SETFLD^VALM1(USREXP,USRREC,"EXPIRES")
|
|---|
| 46 | . S VALMCNT=+$G(VALMCNT)+1
|
|---|
| 47 | . S ^TMP("USRUSER",$J,VALMCNT,0)=USRREC
|
|---|
| 48 | . S ^TMP("USRUSER",$J,"IDX",VALMCNT,USRCNT)=""
|
|---|
| 49 | . S ^TMP("USRUSERIDX",$J,USRCNT)=VALMCNT_U_USRDA W:VALMCNT#10'>0 "."
|
|---|
| 50 | S ^TMP("USRUSER",$J,0)=+$G(USRCNT)_U_$P(^TMP("USRU",$J,0),U,2)
|
|---|
| 51 | S ^TMP("USRUSER",$J,"#")=USRPICK_"^0:"_+$G(USRCNT)
|
|---|
| 52 | I $D(VALMHDR)>9 D HDR
|
|---|
| 53 | I +$G(USRCNT)'>0 D
|
|---|
| 54 | . S ^TMP("USRUSER",$J,1,0)="",VALMCNT=2
|
|---|
| 55 | . S ^TMP("USRUSER",$J,2,0)="No Class Memberships found for "_$P(^TMP("USRU",$J,0),U,2)
|
|---|
| 56 | Q
|
|---|
| 57 | HDR ; Initialize header for review screen
|
|---|
| 58 | N BY,USRX,USRCNT,TITLE,USRNAME
|
|---|
| 59 | S USRX=$G(^TMP("USRUSER",$J,0)),USRNAME=$P(USRX,U,2)
|
|---|
| 60 | S TITLE=USRNAME
|
|---|
| 61 | I USRNAME["?SBPN" D
|
|---|
| 62 | . S VALMSG="(?SBPN) missing SIGNATURE BLOCK PRINTED NAME"
|
|---|
| 63 | ;If this user has been terminated change the title to reflect this.
|
|---|
| 64 | I $$ISTERM^USRLM(USRDUZ) S TITLE=TITLE_" (terminated)"
|
|---|
| 65 | S USRCNT=$J(+USRX,4)_" Class"_$S(+USRX=1:"",1:"es")
|
|---|
| 66 | S VALMHDR(1)=$$CENTER^USRLS(TITLE)
|
|---|
| 67 | S VALMHDR(1)=$$SETSTR^VALM1(USRCNT,VALMHDR(1),(IOM-$L(USRCNT)),$L(USRCNT))
|
|---|
| 68 | Q
|
|---|
| 69 | CLEAN ; "Joel...Clean up your mess!"
|
|---|
| 70 | K ^TMP("USRUSER",$J),^TMP("USRUSERIDX",$J),^TMP("USRU",$J)
|
|---|
| 71 | Q
|
|---|
