Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: USRMLST

USRMLST.m

Go to the documentation of this file.
  1. 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
  1. MAIN ; Control Branching
  1. N DIC,MSBPN,X,Y,USRDUZ
  1. ;MSBPN is set true if a user is missing the SIGNATURE BLOCK PRINT
  1. ;NAME.
  1. S MSBPN=0
  1. S DIC=8930,DIC(0)="AEMQ",DIC("A")="Select CLASS: "
  1. D ^DIC Q:+Y'>0
  1. S USRDA=+Y
  1. D EN^VALM(USRLTMPL)
  1. K USRLTMPL
  1. Q
  1. MAKELIST ; Build review screen list
  1. K VALMY
  1. W !,"Searching for the User Classes."
  1. D BUILD(USRDA)
  1. Q
  1. BUILD(USRDA) ; Build List
  1. N USRCNT,USRNAME,USRPICK
  1. S (USRCNT,VALMCNT)=0
  1. S USRPICK=+$O(^ORD(101,"B","USR ACTION SELECT LIST ELEMENT",0)) ;ICR 872
  1. K ^TMP("USRMMBR",$J),^TMP("USRMMBRIDX",$J),^TMP("USRM",$J)
  1. ;D WHOIS^USRLM("^TMP(""USRM"",$J)",USRDA)
  1. D WHOIS^USRLM("^TMP(""USRM"",$J)",USRDA,1) ; Display .01 Class name
  1. S USRNAME=0
  1. F S USRNAME=$O(^TMP("USRM",$J,USRNAME)) Q:USRNAME="" D
  1. . N USRDA,USRDUZ,USRSIGNM,USREFF,USREXP,USRMEM,USRREC,USRCLNM
  1. . S USRMEM=$G(^TMP("USRM",$J,USRNAME))
  1. . S USRDUZ=+USRMEM,USRSIGNM=$$SIGNAME^USRLS(+USRDUZ)
  1. . I USRSIGNM["?SBPN" S MSBPN=1
  1. .;If this user has been terminated change the name to reflect this.
  1. . I $$ISTERM^USRLM(+USRDUZ) S USRSIGNM="(T) "_USRSIGNM
  1. . S USRDA=+$P(USRMEM,U,2),USRCLNM=$P(USRMEM,U,3)
  1. . S USREFF=$$DATE^USRLS(+$P(USRMEM,U,4),"MM/DD/YY")
  1. . S USREXP=$$DATE^USRLS(+$P(USRMEM,U,5),"MM/DD/YY")
  1. . S USRCNT=+$G(USRCNT)+1
  1. . S USRREC=$$SETFLD^VALM1(USRCNT,"","NUMBER")
  1. . S USRREC=$$SETFLD^VALM1(USRSIGNM,USRREC,"MEMBER")
  1. . S USRREC=$$SETFLD^VALM1(USREFF,USRREC,"EFFECTIVE")
  1. . S USRREC=$$SETFLD^VALM1(USREXP,USRREC,"EXPIRES")
  1. . S USRREC=$$SETFLD^VALM1(USRCLNM,USRREC,"CLASS")
  1. . S VALMCNT=+$G(VALMCNT)+1
  1. . S ^TMP("USRMMBR",$J,VALMCNT,0)=USRREC
  1. . S ^TMP("USRMMBR",$J,"IDX",VALMCNT,USRCNT)=""
  1. . S ^TMP("USRMMBRIDX",$J,USRCNT)=VALMCNT_U_USRDA W:VALMCNT#10'>0 "."
  1. S ^TMP("USRMMBR",$J,0)=+$G(USRCNT)_U_$P(^TMP("USRM",$J,0),U,2)
  1. S ^TMP("USRMMBR",$J,"#")=USRPICK_U_"1:"_USRCNT
  1. I $D(VALMHDR)>9 D HDR
  1. I +$G(USRCNT)'>0 D
  1. . S ^TMP("USRMMBR",$J,1,0)="",VALMCNT=2
  1. . S ^TMP("USRMMBR",$J,2,0)="No "_$P(^TMP("USRM",$J,0),U,2)_"s found"
  1. Q
  1. HDR ; Initialize header for review screen
  1. N BY,USRX,USRCNT,TITLE,USRCLASS
  1. S USRX=$G(^TMP("USRMMBR",$J,0)),USRCLASS=$P(USRX,U,2)
  1. S TITLE=USRCLASS_"s"
  1. S USRCNT=$J(+USRX,4)_" Member"_$S(+USRX=1:"",1:"s")
  1. S VALMHDR(1)=$$CENTER^USRLS(TITLE)
  1. S VALMHDR(1)=$$SETSTR^VALM1(USRCNT,VALMHDR(1),(IOM-$L(USRCNT)),$L(USRCNT))
  1. I $G(MSBPN) D
  1. . S VALMSG="(?SBPN) missing SIGNATURE BLOCK PRINTED NAME"
  1. Q
  1. CLEAN ; "Joel...Clean up your mess!"
  1. K ^TMP("USRMMBR",$J),^TMP("USRMMBRIDX",$J),^TMP("USRM",$J)
  1. Q