| 1 | USRMLST ; SLC/JER - List User Class Members ;09/23/1998
|
|---|
| 2 | ;;1.0;AUTHORIZATION/SUBSCRIPTION;**2,3,4,9**;Jun 20, 1997
|
|---|
| 3 | MAIN ; Control Branching
|
|---|
| 4 | N DIC,MSBPN,X,Y,USRDUZ
|
|---|
| 5 | ;MSBPN is set true if a user is missing the SIGNATURE BLOCK PRINT
|
|---|
| 6 | ;NAME.
|
|---|
| 7 | S MSBPN=0
|
|---|
| 8 | S DIC=8930,DIC(0)="AEMQ",DIC("A")="Select CLASS: "
|
|---|
| 9 | D ^DIC Q:+Y'>0
|
|---|
| 10 | S USRDA=+Y
|
|---|
| 11 | D EN^VALM(USRLTMPL)
|
|---|
| 12 | Q
|
|---|
| 13 | MAKELIST ; Build review screen list
|
|---|
| 14 | K VALMY
|
|---|
| 15 | W !,"Searching for the User Classes."
|
|---|
| 16 | D BUILD(USRDA)
|
|---|
| 17 | Q
|
|---|
| 18 | BUILD(USRDA) ; Build List
|
|---|
| 19 | N USRCNT,USRNAME,USRPICK
|
|---|
| 20 | S (USRCNT,VALMCNT)=0
|
|---|
| 21 | S USRPICK=+$O(^ORD(101,"B","USR ACTION SELECT LIST ELEMENT",0))
|
|---|
| 22 | K ^TMP("USRMMBR",$J),^TMP("USRMMBRIDX",$J),^TMP("USRM",$J)
|
|---|
| 23 | D WHOIS^USRLM("^TMP(""USRM"",$J)",USRDA)
|
|---|
| 24 | S USRNAME=0
|
|---|
| 25 | F S USRNAME=$O(^TMP("USRM",$J,USRNAME)) Q:USRNAME="" D
|
|---|
| 26 | . N USRDA,USRDUZ,USRSIGNM,USREFF,USREXP,USRMEM,USRREC,USRCLNM
|
|---|
| 27 | . S USRMEM=$G(^TMP("USRM",$J,USRNAME))
|
|---|
| 28 | . S USRDUZ=+USRMEM,USRSIGNM=$$SIGNAME^USRLS(+USRDUZ)
|
|---|
| 29 | . I USRSIGNM["?SBPN" S MSBPN=1
|
|---|
| 30 | .;If this user has been terminated change the name to reflect this.
|
|---|
| 31 | . I $$ISTERM^USRLM(+USRDUZ) S USRSIGNM="(T) "_USRSIGNM
|
|---|
| 32 | . S USRDA=+$P(USRMEM,U,2),USRCLNM=$P(USRMEM,U,3)
|
|---|
| 33 | . S USREFF=$$DATE^USRLS(+$P(USRMEM,U,4),"MM/DD/YY")
|
|---|
| 34 | . S USREXP=$$DATE^USRLS(+$P(USRMEM,U,5),"MM/DD/YY")
|
|---|
| 35 | . S USRCNT=+$G(USRCNT)+1
|
|---|
| 36 | . S USRREC=$$SETFLD^VALM1(USRCNT,"","NUMBER")
|
|---|
| 37 | . S USRREC=$$SETFLD^VALM1(USRSIGNM,USRREC,"MEMBER")
|
|---|
| 38 | . S USRREC=$$SETFLD^VALM1(USREFF,USRREC,"EFFECTIVE")
|
|---|
| 39 | . S USRREC=$$SETFLD^VALM1(USREXP,USRREC,"EXPIRES")
|
|---|
| 40 | . S USRREC=$$SETFLD^VALM1(USRCLNM,USRREC,"CLASS")
|
|---|
| 41 | . S VALMCNT=+$G(VALMCNT)+1
|
|---|
| 42 | . S ^TMP("USRMMBR",$J,VALMCNT,0)=USRREC
|
|---|
| 43 | . S ^TMP("USRMMBR",$J,"IDX",VALMCNT,USRCNT)=""
|
|---|
| 44 | . S ^TMP("USRMMBRIDX",$J,USRCNT)=VALMCNT_U_USRDA W:VALMCNT#10'>0 "."
|
|---|
| 45 | S ^TMP("USRMMBR",$J,0)=+$G(USRCNT)_U_$P(^TMP("USRM",$J,0),U,2)
|
|---|
| 46 | S ^TMP("USRMMBR",$J,"#")=USRPICK_U_"1:"_USRCNT
|
|---|
| 47 | I $D(VALMHDR)>9 D HDR
|
|---|
| 48 | I +$G(USRCNT)'>0 D
|
|---|
| 49 | . S ^TMP("USRMMBR",$J,1,0)="",VALMCNT=2
|
|---|
| 50 | . S ^TMP("USRMMBR",$J,2,0)="No "_$P(^TMP("USRM",$J,0),U,2)_"s found"
|
|---|
| 51 | Q
|
|---|
| 52 | HDR ; Initialize header for review screen
|
|---|
| 53 | N BY,USRX,USRCNT,TITLE,USRCLASS
|
|---|
| 54 | S USRX=$G(^TMP("USRMMBR",$J,0)),USRCLASS=$P(USRX,U,2)
|
|---|
| 55 | S TITLE=USRCLASS_"s"
|
|---|
| 56 | S USRCNT=$J(+USRX,4)_" Member"_$S(+USRX=1:"",1:"s")
|
|---|
| 57 | S VALMHDR(1)=$$CENTER^USRLS(TITLE)
|
|---|
| 58 | S VALMHDR(1)=$$SETSTR^VALM1(USRCNT,VALMHDR(1),(IOM-$L(USRCNT)),$L(USRCNT))
|
|---|
| 59 | I $G(MSBPN) D
|
|---|
| 60 | . S VALMSG="(?SBPN) missing SIGNATURE BLOCK PRINTED NAME"
|
|---|
| 61 | Q
|
|---|
| 62 | CLEAN ; "Joel...Clean up your mess!"
|
|---|
| 63 | K ^TMP("USRMMBR",$J),^TMP("USRMMBRIDX",$J),^TMP("USRM",$J)
|
|---|
| 64 | Q
|
|---|
