USRMLST ; SLC/JER - List User Class Members ;3/23/10
;;1.0;AUTHORIZATION/SUBSCRIPTION;**2,3,4,9,33**;Jun 20, 1997;Build 7
MAIN ; Control Branching
N DIC,MSBPN,X,Y,USRDUZ
;MSBPN is set true if a user is missing the SIGNATURE BLOCK PRINT
;NAME.
S MSBPN=0
S DIC=8930,DIC(0)="AEMQ",DIC("A")="Select CLASS: "
D ^DIC Q:+Y'>0
S USRDA=+Y
D EN^VALM(USRLTMPL)
K USRLTMPL
Q
MAKELIST ; Build review screen list
K VALMY
W !,"Searching for the User Classes."
D BUILD(USRDA)
Q
BUILD(USRDA) ; Build List
N USRCNT,USRNAME,USRPICK
S (USRCNT,VALMCNT)=0
S USRPICK=+$O(^ORD(101,"B","USR ACTION SELECT LIST ELEMENT",0)) ;ICR 872
K ^TMP("USRMMBR",$J),^TMP("USRMMBRIDX",$J),^TMP("USRM",$J)
;D WHOIS^USRLM("^TMP(""USRM"",$J)",USRDA)
D WHOIS^USRLM("^TMP(""USRM"",$J)",USRDA,1) ; Display .01 Class name
S USRNAME=0
F S USRNAME=$O(^TMP("USRM",$J,USRNAME)) Q:USRNAME="" D
. N USRDA,USRDUZ,USRSIGNM,USREFF,USREXP,USRMEM,USRREC,USRCLNM
. S USRMEM=$G(^TMP("USRM",$J,USRNAME))
. S USRDUZ=+USRMEM,USRSIGNM=$$SIGNAME^USRLS(+USRDUZ)
. I USRSIGNM["?SBPN" S MSBPN=1
.;If this user has been terminated change the name to reflect this.
. I $$ISTERM^USRLM(+USRDUZ) S USRSIGNM="(T) "_USRSIGNM
. S USRDA=+$P(USRMEM,U,2),USRCLNM=$P(USRMEM,U,3)
. S USREFF=$$DATE^USRLS(+$P(USRMEM,U,4),"MM/DD/YY")
. S USREXP=$$DATE^USRLS(+$P(USRMEM,U,5),"MM/DD/YY")
. S USRCNT=+$G(USRCNT)+1
. S USRREC=$$SETFLD^VALM1(USRCNT,"","NUMBER")
. S USRREC=$$SETFLD^VALM1(USRSIGNM,USRREC,"MEMBER")
. S USRREC=$$SETFLD^VALM1(USREFF,USRREC,"EFFECTIVE")
. S USRREC=$$SETFLD^VALM1(USREXP,USRREC,"EXPIRES")
. S USRREC=$$SETFLD^VALM1(USRCLNM,USRREC,"CLASS")
. S VALMCNT=+$G(VALMCNT)+1
. S ^TMP("USRMMBR",$J,VALMCNT,0)=USRREC
. S ^TMP("USRMMBR",$J,"IDX",VALMCNT,USRCNT)=""
. S ^TMP("USRMMBRIDX",$J,USRCNT)=VALMCNT_U_USRDA W:VALMCNT#10'>0 "."
S ^TMP("USRMMBR",$J,0)=+$G(USRCNT)_U_$P(^TMP("USRM",$J,0),U,2)
S ^TMP("USRMMBR",$J,"#")=USRPICK_U_"1:"_USRCNT
I $D(VALMHDR)>9 D HDR
I +$G(USRCNT)'>0 D
. S ^TMP("USRMMBR",$J,1,0)="",VALMCNT=2
. S ^TMP("USRMMBR",$J,2,0)="No "_$P(^TMP("USRM",$J,0),U,2)_"s found"
Q
HDR ; Initialize header for review screen
N BY,USRX,USRCNT,TITLE,USRCLASS
S USRX=$G(^TMP("USRMMBR",$J,0)),USRCLASS=$P(USRX,U,2)
S TITLE=USRCLASS_"s"
S USRCNT=$J(+USRX,4)_" Member"_$S(+USRX=1:"",1:"s")
S VALMHDR(1)=$$CENTER^USRLS(TITLE)
S VALMHDR(1)=$$SETSTR^VALM1(USRCNT,VALMHDR(1),(IOM-$L(USRCNT)),$L(USRCNT))
I $G(MSBPN) D
. S VALMSG="(?SBPN) missing SIGNATURE BLOCK PRINTED NAME"
Q
CLEAN ; "Joel...Clean up your mess!"
K ^TMP("USRMMBR",$J),^TMP("USRMMBRIDX",$J),^TMP("USRM",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HUSRMLST 2637 printed Dec 13, 2024@01:38:53 Page 2
USRMLST ; SLC/JER - List User Class Members ;3/23/10
+1 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**2,3,4,9,33**;Jun 20, 1997;Build 7
MAIN ; Control Branching
+1 NEW DIC,MSBPN,X,Y,USRDUZ
+2 ;MSBPN is set true if a user is missing the SIGNATURE BLOCK PRINT
+3 ;NAME.
+4 SET MSBPN=0
+5 SET DIC=8930
SET DIC(0)="AEMQ"
SET DIC("A")="Select CLASS: "
+6 DO ^DIC
if +Y'>0
QUIT
+7 SET USRDA=+Y
+8 DO EN^VALM(USRLTMPL)
+9 KILL USRLTMPL
+10 QUIT
MAKELIST ; Build review screen list
+1 KILL VALMY
+2 WRITE !,"Searching for the User Classes."
+3 DO BUILD(USRDA)
+4 QUIT
BUILD(USRDA) ; Build List
+1 NEW USRCNT,USRNAME,USRPICK
+2 SET (USRCNT,VALMCNT)=0
+3 ;ICR 872
SET USRPICK=+$ORDER(^ORD(101,"B","USR ACTION SELECT LIST ELEMENT",0))
+4 KILL ^TMP("USRMMBR",$JOB),^TMP("USRMMBRIDX",$JOB),^TMP("USRM",$JOB)
+5 ;D WHOIS^USRLM("^TMP(""USRM"",$J)",USRDA)
+6 ; Display .01 Class name
DO WHOIS^USRLM("^TMP(""USRM"",$J)",USRDA,1)
+7 SET USRNAME=0
+8 FOR
SET USRNAME=$ORDER(^TMP("USRM",$JOB,USRNAME))
if USRNAME=""
QUIT
Begin DoDot:1
+9 NEW USRDA,USRDUZ,USRSIGNM,USREFF,USREXP,USRMEM,USRREC,USRCLNM
+10 SET USRMEM=$GET(^TMP("USRM",$JOB,USRNAME))
+11 SET USRDUZ=+USRMEM
SET USRSIGNM=$$SIGNAME^USRLS(+USRDUZ)
+12 IF USRSIGNM["?SBPN"
SET MSBPN=1
+13 ;If this user has been terminated change the name to reflect this.
+14 IF $$ISTERM^USRLM(+USRDUZ)
SET USRSIGNM="(T) "_USRSIGNM
+15 SET USRDA=+$PIECE(USRMEM,U,2)
SET USRCLNM=$PIECE(USRMEM,U,3)
+16 SET USREFF=$$DATE^USRLS(+$PIECE(USRMEM,U,4),"MM/DD/YY")
+17 SET USREXP=$$DATE^USRLS(+$PIECE(USRMEM,U,5),"MM/DD/YY")
+18 SET USRCNT=+$GET(USRCNT)+1
+19 SET USRREC=$$SETFLD^VALM1(USRCNT,"","NUMBER")
+20 SET USRREC=$$SETFLD^VALM1(USRSIGNM,USRREC,"MEMBER")
+21 SET USRREC=$$SETFLD^VALM1(USREFF,USRREC,"EFFECTIVE")
+22 SET USRREC=$$SETFLD^VALM1(USREXP,USRREC,"EXPIRES")
+23 SET USRREC=$$SETFLD^VALM1(USRCLNM,USRREC,"CLASS")
+24 SET VALMCNT=+$GET(VALMCNT)+1
+25 SET ^TMP("USRMMBR",$JOB,VALMCNT,0)=USRREC
+26 SET ^TMP("USRMMBR",$JOB,"IDX",VALMCNT,USRCNT)=""
+27 SET ^TMP("USRMMBRIDX",$JOB,USRCNT)=VALMCNT_U_USRDA
if VALMCNT#10'>0
WRITE "."
End DoDot:1
+28 SET ^TMP("USRMMBR",$JOB,0)=+$GET(USRCNT)_U_$PIECE(^TMP("USRM",$JOB,0),U,2)
+29 SET ^TMP("USRMMBR",$JOB,"#")=USRPICK_U_"1:"_USRCNT
+30 IF $DATA(VALMHDR)>9
DO HDR
+31 IF +$GET(USRCNT)'>0
Begin DoDot:1
+32 SET ^TMP("USRMMBR",$JOB,1,0)=""
SET VALMCNT=2
+33 SET ^TMP("USRMMBR",$JOB,2,0)="No "_$PIECE(^TMP("USRM",$JOB,0),U,2)_"s found"
End DoDot:1
+34 QUIT
HDR ; Initialize header for review screen
+1 NEW BY,USRX,USRCNT,TITLE,USRCLASS
+2 SET USRX=$GET(^TMP("USRMMBR",$JOB,0))
SET USRCLASS=$PIECE(USRX,U,2)
+3 SET TITLE=USRCLASS_"s"
+4 SET USRCNT=$JUSTIFY(+USRX,4)_" Member"_$SELECT(+USRX=1:"",1:"s")
+5 SET VALMHDR(1)=$$CENTER^USRLS(TITLE)
+6 SET VALMHDR(1)=$$SETSTR^VALM1(USRCNT,VALMHDR(1),(IOM-$LENGTH(USRCNT)),$LENGTH(USRCNT))
+7 IF $GET(MSBPN)
Begin DoDot:1
+8 SET VALMSG="(?SBPN) missing SIGNATURE BLOCK PRINTED NAME"
End DoDot:1
+9 QUIT
CLEAN ; "Joel...Clean up your mess!"
+1 KILL ^TMP("USRMMBR",$JOB),^TMP("USRMMBRIDX",$JOB),^TMP("USRM",$JOB)
+2 QUIT
