- USRL ; SLC/JER - User class library ;11/12/09
- ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3,7,33**;Jun 20, 1997;Build 5
- ;======================================================================
- UPDATE(ITEM) ; Updates list following edit
- N DA,USRREC,USRABB,USRCLNM,USRACT,USRITM
- N USRLREC,USREREC
- S DA=+$P(ITEM,U,2),USRREC=$G(^USR(8930,+DA,0))
- S USRITM=+ITEM
- ;S USRCLNM=$S(USRREC']"":"<Class DELETED>",$P(USRREC,U,4)]"":$P(USRREC,U,4),1:$$MIXED^USRLS($P(USRREC,U)))
- S USRCLNM=$S(USRREC']"":"<Class DELETED>",1:$P(USRREC,U))
- I +$D(^USR(8930,DA,1))>9 S USRCLNM="+"_USRCLNM
- S USRABB=$P(USRREC,U,2),USRACT=$S(+$P(USRREC,U,3):"Active",1:"Inactive")
- S USRLREC=$$SETFLD^VALM1(USRITM,$G(USRLREC),"NUMBER")
- S USRLREC=$$SETFLD^VALM1(USRCLNM,$G(USRLREC),"CLASS NAME")
- S USRLREC=$$SETFLD^VALM1(USRABB,$G(USRLREC),"ABBREVIATION")
- S USRLREC=$$SETFLD^VALM1(USRACT,$G(USRLREC),"ACTIVE")
- S USREREC=$$SETFLD^VALM1(USRITM,$G(USREREC),"NUMBER")
- S USREREC=$$SETFLD^VALM1(USRCLNM,$G(USREREC),"CLASS NAME")
- S USREREC=$$SETFLD^VALM1(USRABB,$G(USREREC),"ABBREVIATION")
- S USREREC=$$SETFLD^VALM1(USRACT,$G(USREREC),"ACTIVE")
- S ^TMP("USRCLASS",$J,+USRITM,0)=USRLREC
- D RESTORE^VALM10(+USRITM),CNTRL^VALM10(+USRITM,1,VALM("RM"),IOINHI,IOINORM)
- Q
- RESTORE(ITEM) ; Restore video attributes for a single list element
- D RESTORE^VALM10(ITEM),FLDCTRL^VALM10(ITEM,"NUMBER",IOINHI,IOINORM)
- Q
- ;
- ;======================================================================
- VCLDN(NAME) ;Screen for valid class display names.
- N LEN
- S LEN=$L(NAME)
- I (LEN<3)!(LEN>55) Q 0
- ;
- ;Don't allow "+" or "-", or "|" in the name.
- I (NAME["+")!(NAME["-")!(NAME["|") Q 0
- ;
- Q 1
- ;
- USRL ; SLC/JER - User class library ;11/12/09
- +1 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3,7,33**;Jun 20, 1997;Build 5
- +2 ;======================================================================
- UPDATE(ITEM) ; Updates list following edit
- +1 NEW DA,USRREC,USRABB,USRCLNM,USRACT,USRITM
- +2 NEW USRLREC,USREREC
- +3 SET DA=+$PIECE(ITEM,U,2)
- SET USRREC=$GET(^USR(8930,+DA,0))
- +4 SET USRITM=+ITEM
- +5 ;S USRCLNM=$S(USRREC']"":"<Class DELETED>",$P(USRREC,U,4)]"":$P(USRREC,U,4),1:$$MIXED^USRLS($P(USRREC,U)))
- +6 SET USRCLNM=$SELECT(USRREC']"":"<Class DELETED>",1:$PIECE(USRREC,U))
- +7 IF +$DATA(^USR(8930,DA,1))>9
- SET USRCLNM="+"_USRCLNM
- +8 SET USRABB=$PIECE(USRREC,U,2)
- SET USRACT=$SELECT(+$PIECE(USRREC,U,3):"Active",1:"Inactive")
- +9 SET USRLREC=$$SETFLD^VALM1(USRITM,$GET(USRLREC),"NUMBER")
- +10 SET USRLREC=$$SETFLD^VALM1(USRCLNM,$GET(USRLREC),"CLASS NAME")
- +11 SET USRLREC=$$SETFLD^VALM1(USRABB,$GET(USRLREC),"ABBREVIATION")
- +12 SET USRLREC=$$SETFLD^VALM1(USRACT,$GET(USRLREC),"ACTIVE")
- +13 SET USREREC=$$SETFLD^VALM1(USRITM,$GET(USREREC),"NUMBER")
- +14 SET USREREC=$$SETFLD^VALM1(USRCLNM,$GET(USREREC),"CLASS NAME")
- +15 SET USREREC=$$SETFLD^VALM1(USRABB,$GET(USREREC),"ABBREVIATION")
- +16 SET USREREC=$$SETFLD^VALM1(USRACT,$GET(USREREC),"ACTIVE")
- +17 SET ^TMP("USRCLASS",$JOB,+USRITM,0)=USRLREC
- +18 DO RESTORE^VALM10(+USRITM)
- DO CNTRL^VALM10(+USRITM,1,VALM("RM"),IOINHI,IOINORM)
- +19 QUIT
- RESTORE(ITEM) ; Restore video attributes for a single list element
- +1 DO RESTORE^VALM10(ITEM)
- DO FLDCTRL^VALM10(ITEM,"NUMBER",IOINHI,IOINORM)
- +2 QUIT
- +3 ;
- +4 ;======================================================================
- VCLDN(NAME) ;Screen for valid class display names.
- +1 NEW LEN
- +2 SET LEN=$LENGTH(NAME)
- +3 IF (LEN<3)!(LEN>55)
- QUIT 0
- +4 ;
- +5 ;Don't allow "+" or "-", or "|" in the name.
- +6 IF (NAME["+")!(NAME["-")!(NAME["|")
- QUIT 0
- +7 ;
- +8 QUIT 1
- +9 ;