source: WorldVistAEHR/trunk/r/AUTHORIZATION_SUBSCRIPTION-USR/USRL.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: 1.5 KB
RevLine 
[613]1USRL ; SLC/JER - User class library ;05/11/1998
2 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3,7**;Jun 20, 1997
3 ;======================================================================
4UPDATE(ITEM) ; Updates list following edit
5 N DA,USRREC,USRABB,USRCLNM,USRACT,USRITM
6 N USRLREC,USREREC
7 S DA=+$P(ITEM,U,2),USRREC=$G(^USR(8930,+DA,0))
8 S USRITM=+ITEM
9 S USRCLNM=$S(USRREC']"":"<Class DELETED>",$P(USRREC,U,4)]"":$P(USRREC,U,4),1:$$MIXED^USRLS($P(USRREC,U)))
10 I +$D(^USR(8930,DA,1))>9 S USRCLNM="+"_USRCLNM
11 S USRABB=$P(USRREC,U,2),USRACT=$S(+$P(USRREC,U,3):"Active",1:"Inactive")
12 S USRLREC=$$SETFLD^VALM1(USRITM,$G(USRLREC),"NUMBER")
13 S USRLREC=$$SETFLD^VALM1(USRCLNM,$G(USRLREC),"CLASS NAME")
14 S USRLREC=$$SETFLD^VALM1(USRABB,$G(USRLREC),"ABBREVIATION")
15 S USRLREC=$$SETFLD^VALM1(USRACT,$G(USRLREC),"ACTIVE")
16 S USREREC=$$SETFLD^VALM1(USRITM,$G(USREREC),"NUMBER")
17 S USREREC=$$SETFLD^VALM1(USRCLNM,$G(USREREC),"CLASS NAME")
18 S USREREC=$$SETFLD^VALM1(USRABB,$G(USREREC),"ABBREVIATION")
19 S USREREC=$$SETFLD^VALM1(USRACT,$G(USREREC),"ACTIVE")
20 S ^TMP("USRCLASS",$J,+USRITM,0)=USRLREC
21 D RESTORE^VALM10(+USRITM),CNTRL^VALM10(+USRITM,1,VALM("RM"),IOINHI,IOINORM)
22 Q
23RESTORE(ITEM) ; Restore video attributes for a single list element
24 D RESTORE^VALM10(ITEM),FLDCTRL^VALM10(ITEM,"NUMBER",IOINHI,IOINORM)
25 Q
26 ;
27 ;======================================================================
28VCLDN(NAME) ;Screen for valid class display names.
29 N LEN
30 S LEN=$L(NAME)
31 I (LEN<3)!(LEN>55) Q 0
32 ;
33 ;Don't allow "+" or "-", or "|" in the name.
34 I (NAME["+")!(NAME["-")!(NAME["|") Q 0
35 ;
36 Q 1
37 ;
Note: See TracBrowser for help on using the repository browser.