source: WorldVistAEHR/trunk/r/AUTHORIZATION_SUBSCRIPTION-USR/USRMLST.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1USRMLST ; SLC/JER - List User Class Members ;09/23/1998
2 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**2,3,4,9**;Jun 20, 1997
3MAIN ; 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
13MAKELIST ; Build review screen list
14 K VALMY
15 W !,"Searching for the User Classes."
16 D BUILD(USRDA)
17 Q
18BUILD(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
52HDR ; 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
62CLEAN ; "Joel...Clean up your mess!"
63 K ^TMP("USRMMBR",$J),^TMP("USRMMBRIDX",$J),^TMP("USRM",$J)
64 Q
Note: See TracBrowser for help on using the repository browser.