Released USR*1*3 SEQ #3 Extracted from mail message **KIDS**:USR*1.0*3^ **INSTALL NAME** USR*1.0*3 "BLD",903,0) USR*1.0*3^AUTHORIZATION/SUBSCRIPTION^0^2980506^y "BLD",903,1,0) ^^2^2^2980506^^^^ "BLD",903,1,1,0) ASU patch 3, USR*1.0*3. This patch removes TIU dependencies from ASU. "BLD",903,1,2,0) See the National Patch module for a complete description. "BLD",903,4,0) ^9.64PA^8930.3^1 "BLD",903,4,8930.3,0) 8930.3 "BLD",903,4,8930.3,2,0) ^9.641^8930.3^1 "BLD",903,4,8930.3,2,8930.3,0) USR CLASS MEMBERSHIP (File-top level) "BLD",903,4,8930.3,2,8930.3,1,0) ^9.6411^.02^2 "BLD",903,4,8930.3,2,8930.3,1,.01,0) MEMBER "BLD",903,4,8930.3,2,8930.3,1,.02,0) USER CLASS "BLD",903,4,8930.3,222) y^y^p^^^^n "BLD",903,4,"APDD",8930.3,8930.3) "BLD",903,4,"APDD",8930.3,8930.3,.01) "BLD",903,4,"APDD",8930.3,8930.3,.02) "BLD",903,4,"B",8930.3,8930.3) "BLD",903,"ABPKG") n "BLD",903,"INI") "BLD",903,"INIT") POST^USRP3INI "BLD",903,"KRN",0) ^9.67PA^8994^18 "BLD",903,"KRN",.4,0) .4 "BLD",903,"KRN",.4,"NM",0) ^9.68A^^0 "BLD",903,"KRN",.401,0) .401 "BLD",903,"KRN",.401,"NM",0) ^9.68A^^ "BLD",903,"KRN",.402,0) .402 "BLD",903,"KRN",.403,0) .403 "BLD",903,"KRN",.5,0) .5 "BLD",903,"KRN",.84,0) .84 "BLD",903,"KRN",3.6,0) 3.6 "BLD",903,"KRN",3.8,0) 3.8 "BLD",903,"KRN",9.2,0) 9.2 "BLD",903,"KRN",9.8,0) 9.8 "BLD",903,"KRN",9.8,"NM",0) ^9.68A^16^16 "BLD",903,"KRN",9.8,"NM",1,0) USRU^^0^B1811292 "BLD",903,"KRN",9.8,"NM",2,0) USRCLST^^0^B13063556 "BLD",903,"KRN",9.8,"NM",3,0) USRMEMBR^^0^B24260854 "BLD",903,"KRN",9.8,"NM",4,0) USRRUL^^0^B8593668 "BLD",903,"KRN",9.8,"NM",5,0) USRUM^^0^B1465384 "BLD",903,"KRN",9.8,"NM",6,0) USRECLST^^0^B11992155 "BLD",903,"KRN",9.8,"NM",7,0) USRL^^0^B5749721 "BLD",903,"KRN",9.8,"NM",8,0) USRLM^^0^B35996106 "BLD",903,"KRN",9.8,"NM",9,0) USRM^^0^B1609192 "BLD",903,"KRN",9.8,"NM",10,0) USRULST^^0^B6922025 "BLD",903,"KRN",9.8,"NM",11,0) USRLS^^0^B6815279 "BLD",903,"KRN",9.8,"NM",12,0) USRHELP^^0^B4504957 "BLD",903,"KRN",9.8,"NM",13,0) USRLFF^^0^B359140 "BLD",903,"KRN",9.8,"NM",14,0) USRUMMBR^^0^B13626324 "BLD",903,"KRN",9.8,"NM",15,0) USRMLST^^0^B8359979 "BLD",903,"KRN",9.8,"NM",16,0) USRRULA^^0^B12235287 "BLD",903,"KRN",9.8,"NM","B","USRCLST",2) "BLD",903,"KRN",9.8,"NM","B","USRECLST",6) "BLD",903,"KRN",9.8,"NM","B","USRHELP",12) "BLD",903,"KRN",9.8,"NM","B","USRL",7) "BLD",903,"KRN",9.8,"NM","B","USRLFF",13) "BLD",903,"KRN",9.8,"NM","B","USRLM",8) "BLD",903,"KRN",9.8,"NM","B","USRLS",11) "BLD",903,"KRN",9.8,"NM","B","USRM",9) "BLD",903,"KRN",9.8,"NM","B","USRMEMBR",3) "BLD",903,"KRN",9.8,"NM","B","USRMLST",15) "BLD",903,"KRN",9.8,"NM","B","USRRUL",4) "BLD",903,"KRN",9.8,"NM","B","USRRULA",16) "BLD",903,"KRN",9.8,"NM","B","USRU",1) "BLD",903,"KRN",9.8,"NM","B","USRULST",10) "BLD",903,"KRN",9.8,"NM","B","USRUM",5) "BLD",903,"KRN",9.8,"NM","B","USRUMMBR",14) "BLD",903,"KRN",19,0) 19 "BLD",903,"KRN",19,"NM",0) ^9.68A^1^1 "BLD",903,"KRN",19,"NM",1,0) USR CLASS MANAGEMENT MENU^^3 "BLD",903,"KRN",19,"NM","B","USR CLASS MANAGEMENT MENU",1) "BLD",903,"KRN",19.1,0) 19.1 "BLD",903,"KRN",19.1,"NM",0) ^9.68A^^ "BLD",903,"KRN",101,0) 101 "BLD",903,"KRN",101,"NM",0) ^9.68A^4^4 "BLD",903,"KRN",101,"NM",1,0) USR BUSINESS RULE MENU^^3 "BLD",903,"KRN",101,"NM",2,0) USR CLASS ACTION MENU^^3 "BLD",903,"KRN",101,"NM",3,0) USR CLASS MEMBER USER MENU^^3 "BLD",903,"KRN",101,"NM",4,0) USR CLASS MEMBERSHIP MENU^^3 "BLD",903,"KRN",101,"NM","B","USR BUSINESS RULE MENU",1) "BLD",903,"KRN",101,"NM","B","USR CLASS ACTION MENU",2) "BLD",903,"KRN",101,"NM","B","USR CLASS MEMBER USER MENU",3) "BLD",903,"KRN",101,"NM","B","USR CLASS MEMBERSHIP MENU",4) "BLD",903,"KRN",409.61,0) 409.61 "BLD",903,"KRN",409.61,"NM",0) ^9.68A^3^3 "BLD",903,"KRN",409.61,"NM",1,0) USR DEFINE CLASSES^^0 "BLD",903,"KRN",409.61,"NM",2,0) USR LIST MEMBERSHIP BY CLASS^^0 "BLD",903,"KRN",409.61,"NM",3,0) USR LIST MEMBERSHIP BY USER^^0 "BLD",903,"KRN",409.61,"NM","B","USR DEFINE CLASSES",1) "BLD",903,"KRN",409.61,"NM","B","USR LIST MEMBERSHIP BY CLASS",2) "BLD",903,"KRN",409.61,"NM","B","USR LIST MEMBERSHIP BY USER",3) "BLD",903,"KRN",771,0) 771 "BLD",903,"KRN",869.2,0) 869.2 "BLD",903,"KRN",870,0) 870 "BLD",903,"KRN",8994,0) 8994 "BLD",903,"KRN","B",.4,.4) "BLD",903,"KRN","B",.401,.401) "BLD",903,"KRN","B",.402,.402) "BLD",903,"KRN","B",.403,.403) "BLD",903,"KRN","B",.5,.5) "BLD",903,"KRN","B",.84,.84) "BLD",903,"KRN","B",3.6,3.6) "BLD",903,"KRN","B",3.8,3.8) "BLD",903,"KRN","B",9.2,9.2) "BLD",903,"KRN","B",9.8,9.8) "BLD",903,"KRN","B",19,19) "BLD",903,"KRN","B",19.1,19.1) "BLD",903,"KRN","B",101,101) "BLD",903,"KRN","B",409.61,409.61) "BLD",903,"KRN","B",771,771) "BLD",903,"KRN","B",869.2,869.2) "BLD",903,"KRN","B",870,870) "BLD",903,"KRN","B",8994,8994) "BLD",903,"QUES",0) ^9.62^^ "BLD",903,"REQB",0) ^9.611^1^1 "BLD",903,"REQB",1,0) USR*1.0*2^1 "BLD",903,"REQB","B","USR*1.0*2",1) "FIA",8930.3) USR CLASS MEMBERSHIP "FIA",8930.3,0) ^USR(8930.3, "FIA",8930.3,0,0) 8930.3P "FIA",8930.3,0,1) y^y^p^^^^n "FIA",8930.3,0,10) "FIA",8930.3,0,11) "FIA",8930.3,0,"RLRO") "FIA",8930.3,0,"VR") 1.0^USR "FIA",8930.3,8930.3) 1 "FIA",8930.3,8930.3,.01) "FIA",8930.3,8930.3,.02) "INIT") POST^USRP3INI "KRN",19,20366,-1) 3^1 "KRN",19,20366,0) USR CLASS MANAGEMENT MENU^User Class Management^^M^^^^^^^^AUTHORIZATION/SUBSCRIPTION^^1^^^1 "KRN",19,20366,1,0) ^^2^2^2970124^^^^ "KRN",19,20366,1,1,0) This is the menu of options for management of User Class Definition and "KRN",19,20366,1,2,0) Membership. "KRN",19,20366,10,0) ^19.01IP^5^5 "KRN",19,20366,20) Q "KRN",19,20366,26) W !!,$$CENTER^USRLS("--- User Class Management Menu ---") "KRN",19,20366,99) 57462,29303 "KRN",19,20366,99.1) 57025,18084 "KRN",19,20366,"U") USER CLASS MANAGEMENT "KRN",101,3774,-1) 3^2 "KRN",101,3774,0) USR CLASS ACTION MENU^User Class Review Menu^^M^^^^^^^^AUTHORIZATION/SUBSCRIPTION "KRN",101,3774,1,0) ^^1^1^2960222^^^^ "KRN",101,3774,1,1,0) Menu of actions which may be executed by clinicians. "KRN",101,3774,4) 26 "KRN",101,3774,10,0) ^101.01PA^14^14 "KRN",101,3774,20) S XQORM("SH")=0 S:$G(VALMSG)'["*" VALMSG="+ Next Screen - Prev Screen ?? More Actions",VALM("MAX")=+$G(VALMCNT) "KRN",101,3774,24) I 1 X:$D(^ORD(101,+$P(^ORD(101,DA(1),10,DA,0),"^"),24)) ^(24) "KRN",101,3774,26) X "S XQORM(""#"")=$G(@VALMAR@(""#""))" D RESIZE^USRLM((IOSL-2),18),SHOW^VALM K XQORM("XLATE","FIND") "KRN",101,3774,28) Select Action: "KRN",101,3774,99) 57462,29299 "KRN",101,3780,-1) 3^4 "KRN",101,3780,0) USR CLASS MEMBERSHIP MENU^User Class Membership Menu^^M^^^^^^^^AUTHORIZATION/SUBSCRIPTION "KRN",101,3780,1,0) ^^1^1^2960214^^^^ "KRN",101,3780,1,1,0) Menu of actions which may be executed by clinicians. "KRN",101,3780,4) 26 "KRN",101,3780,10,0) ^101.01PA^16^16 "KRN",101,3780,20) S XQORM("SH")=0 S:$G(VALMSG)'["*" VALMSG="+ Next Screen - Prev Screen ?? More Actions",VALM("MAX")=+$G(VALMCNT)+1 "KRN",101,3780,24) I 1 X:$D(^ORD(101,+$P(^ORD(101,DA(1),10,DA,0),"^"),24)) ^(24) "KRN",101,3780,26) S XQORM("#")=$G(^TMP("USRMMBR",$J,"#")) D RESIZE^USRLM((IOSL-2),18),SHOW^VALM K XQORM("XLATE","FIND") "KRN",101,3780,28) Select Action: "KRN",101,3780,99) 57462,29299 "KRN",101,3787,-1) 3^3 "KRN",101,3787,0) USR CLASS MEMBER USER MENU^User Class Membership Menu^^M^^^^^^^^AUTHORIZATION/SUBSCRIPTION "KRN",101,3787,1,0) ^^1^1^2960222^^^^ "KRN",101,3787,1,1,0) Menu of actions which may be executed by clinicians. "KRN",101,3787,4) 26 "KRN",101,3787,10,0) ^101.01PA^15^15 "KRN",101,3787,20) S XQORM("SH")=0 S:$G(VALMSG)'["*" VALMSG="+ Next Screen - Prev Screen ?? More Actions",VALM("MAX")=+$G(VALMCNT) "KRN",101,3787,24) I 1 X:$D(^ORD(101,+$P(^ORD(101,DA(1),10,DA,0),"^"),24)) ^(24) "KRN",101,3787,26) S XQORM("#")=$G(^TMP("USRUSER",$J,"#")) D RESIZE^USRLM((IOSL-2),18),SHOW^VALM K XQORM("XLATE","FIND") "KRN",101,3787,28) Select Action: "KRN",101,3787,99) 57469,40362 "KRN",101,3796,-1) 3^1 "KRN",101,3796,0) USR BUSINESS RULE MENU^Business Rule Menu^^M^^^^^^^^AUTHORIZATION/SUBSCRIPTION "KRN",101,3796,1,0) ^^1^1^2970115^ "KRN",101,3796,1,1,0) Menu of actions useful in the management of Business Rules. "KRN",101,3796,4) 26 "KRN",101,3796,10,0) ^101.01PA^17^17 "KRN",101,3796,20) S XQORM("SH")=0 S:$G(VALMSG)'["*" VALMSG="+ Next Screen - Prev Screen ?? More Actions",VALM("MAX")=+$G(VALMCNT)+1 "KRN",101,3796,24) I 1 X:$D(^ORD(101,+$P(^ORD(101,DA(1),10,DA,0),"^"),24)) ^(24) "KRN",101,3796,26) S XQORM("#")=$G(^TMP("USRRUL",$J,"#")) D RESIZE^USRLM((IOSL-2),18),SHOW^VALM K XQORM("XLATE","FIND") "KRN",101,3796,28) Select Action: "KRN",101,3796,99) 57462,29300 "KRN",409.61,527,-1) 0^1 "KRN",409.61,527,0) USR DEFINE CLASSES^1^^80^4^18^1^1^Class^USR CLASS ACTION MENU^User Classes "KRN",409.61,527,1) ^USR HIDDEN ACTIONS "KRN",409.61,527,"ARRAY") ^TMP("USRCLASS",$J) "KRN",409.61,527,"COL",0) ^409.621^4^4 "KRN",409.61,527,"COL",1,0) NUMBER^1^5 "KRN",409.61,527,"COL",2,0) CLASS NAME^6^50^Class Name "KRN",409.61,527,"COL",3,0) ABBREVIATION^58^7^Abbrev "KRN",409.61,527,"COL",4,0) ACTIVE^70^8 "KRN",409.61,527,"COL","B","ABBREVIATION",3) "KRN",409.61,527,"COL","B","ACTIVE",4) "KRN",409.61,527,"COL","B","CLASS NAME",2) "KRN",409.61,527,"COL","B","NUMBER",1) "KRN",409.61,527,"FNL") D CLEAN^USRCLST "KRN",409.61,527,"HDR") D HDR^USRCLST "KRN",409.61,527,"HLP") D PROTOCOL^USRHELP "KRN",409.61,527,"INIT") D MAKELIST^USRCLST "KRN",409.61,528,-1) 0^2 "KRN",409.61,528,0) USR LIST MEMBERSHIP BY CLASS^1^^142^4^18^1^1^Member^USR CLASS MEMBERSHIP MENU^User Class Members "KRN",409.61,528,1) ^USR HIDDEN ACTIONS "KRN",409.61,528,"ARRAY") ^TMP("USRMMBR",$J) "KRN",409.61,528,"COL",0) ^409.621^5^5 "KRN",409.61,528,"COL",1,0) NUMBER^1^5 "KRN",409.61,528,"COL",2,0) MEMBER^6^30^Member^^1 "KRN",409.61,528,"COL",3,0) EFFECTIVE^61^9^Effective "KRN",409.61,528,"COL",4,0) EXPIRES^72^8^Expires "KRN",409.61,528,"COL",5,0) CLASS^82^60^Specific Class "KRN",409.61,528,"COL","AIDENT",1,2) "KRN",409.61,528,"COL","B","CLASS",5) "KRN",409.61,528,"COL","B","EFFECTIVE",3) "KRN",409.61,528,"COL","B","EXPIRES",4) "KRN",409.61,528,"COL","B","MEMBER",2) "KRN",409.61,528,"COL","B","NUMBER",1) "KRN",409.61,528,"FNL") D CLEAN^USRMLST "KRN",409.61,528,"HDR") D HDR^USRMLST "KRN",409.61,528,"HLP") D PROTOCOL^USRHELP "KRN",409.61,528,"INIT") D MAKELIST^USRMLST "KRN",409.61,529,-1) 0^3 "KRN",409.61,529,0) USR LIST MEMBERSHIP BY USER^1^^80^4^18^1^1^Class^USR CLASS MEMBER USER MENU^Current User Classes "KRN",409.61,529,1) ^USR HIDDEN ACTIONS "KRN",409.61,529,"ARRAY") ^TMP("USRUSER",$J) "KRN",409.61,529,"COL",0) ^409.621^4^4 "KRN",409.61,529,"COL",1,0) NUMBER^1^5 "KRN",409.61,529,"COL",2,0) CLASS^6^30^User Class^^1 "KRN",409.61,529,"COL",3,0) EFFECTIVE^61^9^Effective "KRN",409.61,529,"COL",4,0) EXPIRES^72^8^Expires "KRN",409.61,529,"COL","AIDENT",1,2) "KRN",409.61,529,"COL","B","CLASS",2) "KRN",409.61,529,"COL","B","EFFECTIVE",3) "KRN",409.61,529,"COL","B","EXPIRES",4) "KRN",409.61,529,"COL","B","NUMBER",1) "KRN",409.61,529,"FNL") D CLEAN^USRULST "KRN",409.61,529,"HDR") D HDR^USRULST "KRN",409.61,529,"HLP") D PROTOCOL^USRHELP "KRN",409.61,529,"INIT") D MAKELIST^USRULST "ORD",15,101) 101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA "ORD",15,101,0) PROTOCOL "ORD",17,409.61) 409.61;17;1;;;;;;;LMDEL^XPDIA1 "ORD",17,409.61,0) LIST TEMPLATE "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "PKG",451,-1) 1^1 "PKG",451,0) AUTHORIZATION/SUBSCRIPTION^USR^User Authorization "PKG",451,22,0) ^9.49I^1^1 "PKG",451,22,1,0) 1.0^2970620^2971106^27 "PKG",451,22,1,"PAH",1,0) 3^2980506^118 "PKG",451,22,1,"PAH",1,1,0) ^^2^2^2980506 "PKG",451,22,1,"PAH",1,1,1,0) ASU patch 3, USR*1.0*3. This patch removes TIU dependencies from ASU. "PKG",451,22,1,"PAH",1,1,2,0) See the National Patch module for a complete description. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 17 "RTN","USRCLST") 0^2^B13063556 "RTN","USRCLST",1,0) USRCLST ; SLC/JER - Review User Classes ;2/9/98 "RTN","USRCLST",2,0) ;;1.0;AUTHORIZATION/SUBSCRIPTION;**1,3**;Jun 20, 1997 "RTN","USRCLST",3,0) MAKELIST ; Build review screen list "RTN","USRCLST",4,0) N USRI,USRTMP,STATUS,FNAME,LNAME "RTN","USRCLST",5,0) S STATUS=$$SELSTAT("ACTIVE") "RTN","USRCLST",6,0) I +STATUS<0 S VALMQUIT=1 Q "RTN","USRCLST",7,0) S FNAME=$$RANGE(" Start With Class","FIRST") "RTN","USRCLST",8,0) I +FNAME=-1 S VALMQUIT=1 Q "RTN","USRCLST",9,0) S LNAME=$$RANGE(" Go To Class","LAST") "RTN","USRCLST",10,0) I +LNAME=-1 S VALMQUIT=1 Q "RTN","USRCLST",11,0) W !,"Searching for the User Classes." "RTN","USRCLST",12,0) D BUILD(STATUS,FNAME,LNAME) "RTN","USRCLST",13,0) Q "RTN","USRCLST",14,0) SELSTAT(DEFLT) ; Select User Class status "RTN","USRCLST",15,0) N DIC,XQORM,X,Y "RTN","USRCLST",16,0) S DIC=101,DIC(0)="X",X="USR CLASS STATUS SELECT" D ^DIC "RTN","USRCLST",17,0) I +Y>0 D "RTN","USRCLST",18,0) . S XQORM=+Y_";ORD(101,",XQORM(0)="1A",XQORM("A")="Select User Class Status: " "RTN","USRCLST",19,0) . S XQORM("B")=DEFLT D ^XQORM "RTN","USRCLST",20,0) . I +Y,($D(Y)>9) S Y=$S($P(Y(1),U,3)="Inactive":0,$P(Y(1),U,3)="Active":1,1:2) "RTN","USRCLST",21,0) Q Y "RTN","USRCLST",22,0) RANGE(PROMPT,DEFAULT) ; Get range of classes to browse "RTN","USRCLST",23,0) N Y "RTN","USRCLST",24,0) S Y=$$READ^USRU("F^1:20",PROMPT,DEFAULT) "RTN","USRCLST",25,0) S Y=$S(Y["FIRST":"",Y["LAST":"Zzzz",1:$$MIXED^USRLS(Y)) "RTN","USRCLST",26,0) I Y="^" S Y=-1 "RTN","USRCLST",27,0) Q Y "RTN","USRCLST",28,0) BUILD(STATUS,USRDNM,USRLNM) ; Build List "RTN","USRCLST",29,0) N USRNM,USRCNT,USRI,USRJ,USRK,USRP,USRREC,USRSTAT,XREF,USRPICK "RTN","USRCLST",30,0) S VALMCNT=0 "RTN","USRCLST",31,0) S USRPICK=+$O(^ORD(101,"B","USR ACTION SELECT LIST ELEMENT",0)) "RTN","USRCLST",32,0) K ^TMP("USRCLASS",$J),^TMP("USRCLASSIDX",$J) "RTN","USRCLST",33,0) F STATUS=$S(STATUS=2:0,1:STATUS):1:STATUS D "RTN","USRCLST",34,0) . S USRDNM=$S($G(USRDNM)]"":$O(^USR(8930,"ADNM",STATUS,$P($G(USRDNM),U,1)),-1),1:"") "RTN","USRCLST",35,0) . S USRLNM=$P($G(USRLNM),U,1)_"z" "RTN","USRCLST",36,0) . S USRNM=USRDNM "RTN","USRCLST",37,0) . F S USRNM=$O(^USR(8930,"ADNM",STATUS,USRNM)) Q:USRNM']""!(USRNM]USRLNM) D "RTN","USRCLST",38,0) . . S USRI=+$O(^USR(8930,"ADNM",STATUS,USRNM,0)) Q:+USRI'>0 "RTN","USRCLST",39,0) . . N DIC,DIQ,DA,DR,USRCLASS,CLASNM,ACTIVE "RTN","USRCLST",40,0) . . S DIQ="USRCLASS",DIC=8930,DA=USRI "RTN","USRCLST",41,0) . . S DR=".01:.04" D EN^DIQ1 "RTN","USRCLST",42,0) . . S CLASSNM=$S($G(USRCLASS(8930,DA,.04))]"":USRCLASS(8930,DA,.04),1:$$MIXED^USRLS($G(USRCLASS(8930,DA,.01)))) "RTN","USRCLST",43,0) . . I +$O(^USR(8930,+USRI,1,0)) S CLASSNM="+ "_CLASSNM "RTN","USRCLST",44,0) . . S CLASSABB=$G(USRCLASS(8930,DA,.02)) "RTN","USRCLST",45,0) . . S ACTIVE=$G(USRCLASS(8930,DA,.03)) "RTN","USRCLST",46,0) . . S USRCNT=+$G(USRCNT)+1 "RTN","USRCLST",47,0) . . S USRREC=$$SETFLD^VALM1(USRCNT,"","NUMBER") "RTN","USRCLST",48,0) . . S USRREC=$$SETFLD^VALM1(CLASSNM,USRREC,"CLASS NAME") "RTN","USRCLST",49,0) . . S USRREC=$$SETFLD^VALM1(CLASSABB,USRREC,"ABBREVIATION") "RTN","USRCLST",50,0) . . S USRREC=$$SETFLD^VALM1(ACTIVE,USRREC,"ACTIVE") "RTN","USRCLST",51,0) . . S VALMCNT=+$G(VALMCNT)+1 "RTN","USRCLST",52,0) . . S ^TMP("USRCLASS",$J,VALMCNT,0)=USRREC "RTN","USRCLST",53,0) . . S ^TMP("USRCLASS",$J,"IDX",VALMCNT,USRCNT)="" "RTN","USRCLST",54,0) . . ;S ^TMP("USRCLASS",$J,"PICK",USRCNT,VALMCNT)="" "RTN","USRCLST",55,0) . . S ^TMP("USRCLASSIDX",$J,USRCNT)=VALMCNT_U_USRI_U W:VALMCNT#10'>0 "." "RTN","USRCLST",56,0) S ^TMP("USRCLASS",$J,0)=+$G(USRCNT)_U_STATUS_U_USRDNM_U_USRLNM "RTN","USRCLST",57,0) S ^TMP("USRCLASS",$J,"#")=USRPICK_U_"1:"_+$G(USRCNT) "RTN","USRCLST",58,0) I $D(VALMHDR)>9 D HDR "RTN","USRCLST",59,0) I +$G(USRCNT)'>0 D "RTN","USRCLST",60,0) . S ^TMP("USRCLASS",$J,1,0)="" "RTN","USRCLST",61,0) . S ^TMP("USRCLASS",$J,2,0)="No "_$S(STATUS=0:"Inactive ",STATUS=1:"Active ",1:"")_"User Classes found" "RTN","USRCLST",62,0) Q "RTN","USRCLST",63,0) HDR ; Initialize header for review screen "RTN","USRCLST",64,0) N BY,USRX,USRCNT,SCREEN,STATUS,TITLE "RTN","USRCLST",65,0) S USRX=$G(^TMP("USRCLASS",$J,0)),STATUS=$P("INACTIVE^ACTIVE^ALL",U,+$P(USRX,U,2)+1) "RTN","USRCLST",66,0) S TITLE=STATUS_" USER CLASSES" "RTN","USRCLST",67,0) S USRCNT=$J(+$G(^TMP("USRCLASS",$J,0)),4) "RTN","USRCLST",68,0) S USRCNT=USRCNT_" Class"_$S(+USRCNT=1:"",1:"es") "RTN","USRCLST",69,0) S VALMHDR(1)=$$CENTER^USRLS(TITLE) "RTN","USRCLST",70,0) S VALMHDR(1)=$$SETSTR^VALM1(USRCNT,VALMHDR(1),(IOM-$L(USRCNT)),$L(USRCNT)) "RTN","USRCLST",71,0) Q "RTN","USRCLST",72,0) CLEAN ; "Joel...Clean up your mess!" "RTN","USRCLST",73,0) K ^TMP("USRCLASS",$J),^TMP("USRCLASSIDX",$J) "RTN","USRCLST",74,0) K ^TMP("USREXP",$J),^TMP("USREXPIDX",$J),^TMP("USREXPMAP",$J) "RTN","USRCLST",75,0) Q "RTN","USRECLST") 0^6^B11992155 "RTN","USRECLST",1,0) USRECLST ; SLC/JER - Expand User Class hierarchy ;2/9/98 "RTN","USRECLST",2,0) ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3**;Jun 20, 1997 "RTN","USRECLST",3,0) BUILD(STATUS,USRDNM,USRLNM) ; Build List "RTN","USRECLST",4,0) N USRCNT,USRI,USRJ,USRK,USRP,USRREC,USRSTAT,XREF,USRNM,USRPICK "RTN","USRECLST",5,0) S VALMCNT=0 "RTN","USRECLST",6,0) S VALMAR=$S(VALMAR="^TMP(""USRCLASS"",$J)":"^TMP(""USREXP"",$J)",1:"^TMP(""USRCLASS"",$J)") "RTN","USRECLST",7,0) I $D(^TMP("USREXP",$J)),$D(^TMP("USREXPIDX",$J)) Q "RTN","USRECLST",8,0) K ^TMP("USREXP",$J),^TMP("USREXPIDX",$J) "RTN","USRECLST",9,0) S USRPICK=+$O(^ORD(101,"B","USR ACTION SELECT LIST ELEMENT",0)) "RTN","USRECLST",10,0) F STATUS=$S(STATUS=2:0,1:STATUS):1:STATUS D "RTN","USRECLST",11,0) . S USRNM=$G(USRDNM),USRLNM=$G(USRLNM,"Zzzz") "RTN","USRECLST",12,0) . F S USRNM=$O(^USR(8930,"ADNM",STATUS,USRNM)) Q:USRNM']""!(USRNM]USRLNM) D "RTN","USRECLST",13,0) . . S USRI=+$O(^USR(8930,"ADNM",STATUS,USRNM,0)) Q:+USRI'>0 "RTN","USRECLST",14,0) . . N DIC,DIQ,DA,DR,USRCLASS,CLASNM,ACTIVE "RTN","USRECLST",15,0) . . S DIQ="USRCLASS",DIC=8930,DA=USRI "RTN","USRECLST",16,0) . . S DR=".01:.04" D EN^DIQ1 "RTN","USRECLST",17,0) . . S CLASSNM=$S($G(USRCLASS(8930,DA,.04))]"":USRCLASS(8930,DA,.04),1:$$MIXED^USRLS($G(USRCLASS(8930,DA,.01)))) "RTN","USRECLST",18,0) . . S CLASSABB=$G(USRCLASS(8930,DA,.02)) "RTN","USRECLST",19,0) . . S ACTIVE=$G(USRCLASS(8930,DA,.03)) "RTN","USRECLST",20,0) . . S USRCNT=+$G(USRCNT)+1 "RTN","USRECLST",21,0) . . S USRREC=$$SETFLD^VALM1(USRCNT,"","NUMBER") "RTN","USRECLST",22,0) . . S USRREC=$$SETFLD^VALM1(CLASSNM,USRREC,"CLASS NAME") "RTN","USRECLST",23,0) . . S USRREC=$$SETFLD^VALM1(CLASSABB,USRREC,"ABBREVIATION") "RTN","USRECLST",24,0) . . S USRREC=$$SETFLD^VALM1(ACTIVE,USRREC,"ACTIVE") "RTN","USRECLST",25,0) . . S VALMCNT=+$G(VALMCNT)+1 "RTN","USRECLST",26,0) . . S ^TMP("USREXP",$J,VALMCNT,0)=USRREC "RTN","USRECLST",27,0) . . S ^TMP("USREXP",$J,"IDX",VALMCNT,USRCNT)="" "RTN","USRECLST",28,0) . . S ^TMP("USREXP",$J,"PICK",USRCNT,VALMCNT)="" "RTN","USRECLST",29,0) . . S ^TMP("USREXPIDX",$J,USRCNT)=VALMCNT_U_USRI_U W:+VALMCNT#10'>0 "." "RTN","USRECLST",30,0) . . I +$O(^USR(8930,USRI,1,0))>0 D ITEMS(USRI,.VALMCNT,USRCNT,0) "RTN","USRECLST",31,0) S ^TMP("USREXP",$J,0)=+$G(VALMCNT)_U_STATUS_U_$G(USRDNM)_U_$G(USRLNM) "RTN","USRECLST",32,0) S ^TMP("USREXP",$J,"#")=USRPICK_U_"1:"_+$G(USRCNT) "RTN","USRECLST",33,0) I $D(VALMHDR)>9 D HDR "RTN","USRECLST",34,0) I +$G(USRCNT)'>0 D "RTN","USRECLST",35,0) . S ^TMP("USREXP",$J,1,0)="" "RTN","USRECLST",36,0) . S ^TMP("USREXP",$J,2,0)="No "_$S(STATUS=0:"Inactive ",STATUS=1:"Active ",1:"")_"User Classes found" "RTN","USRECLST",37,0) Q "RTN","USRECLST",38,0) ITEMS(USRDA,VALMCNT,USRCNT,USRLVL) ; Resolve subclasses "RTN","USRECLST",39,0) N USRI,USRJ,USRNM,USRSIBS,USRSUB,USRSUB0,USRREC S USRI=0 "RTN","USRECLST",40,0) S USRLVL=+$G(USRLVL)+1 "RTN","USRECLST",41,0) F S USRI=$O(^USR(8930,USRDA,1,USRI)) Q:+USRI'>0 D "RTN","USRECLST",42,0) . N USRPAD "RTN","USRECLST",43,0) . S USRSUB=+$G(^USR(8930,USRDA,1,USRI,0)) "RTN","USRECLST",44,0) . S USRSIBS=+$O(^USR(8930,USRDA,1,USRI)) "RTN","USRECLST",45,0) . S USRSUB0=$G(^USR(8930,+USRSUB,0)) "RTN","USRECLST",46,0) . I '+$P(USRSUB0,U,3) Q ; exclude inactive subclasses "RTN","USRECLST",47,0) . F USRJ=1:1:USRLVL D "RTN","USRECLST",48,0) . . S USRPAD=$G(USRPAD)_"|"_$S((+USRSIBS'>0)&(USRJ=USRLVL):"_",USRJ=USRLVL:"-",1:" ") "RTN","USRECLST",49,0) . S USRNM=USRPAD_$S($P(USRSUB0,U,4)]"":$P(USRSUB0,U,4),1:$$MIXED^USRLS($P(USRSUB0,U))),USRPAD="" "RTN","USRECLST",50,0) . S USRREC=$$SETSTR^VALM1(USRNM,$G(USRREC),6,55) "RTN","USRECLST",51,0) . S VALMCNT=+$G(VALMCNT)+1 "RTN","USRECLST",52,0) . S ^TMP("USREXP",$J,VALMCNT,0)=USRREC "RTN","USRECLST",53,0) . S ^TMP("USREXP",$J,"IDX",VALMCNT,USRCNT)="" "RTN","USRECLST",54,0) . S ^TMP("USREXP",$J,"PICK",USRCNT,VALMCNT)="" "RTN","USRECLST",55,0) . S ^TMP("USREXPMAP",$J,+USRSUB,VALMCNT)="" "RTN","USRECLST",56,0) . I +$O(^USR(8930,+USRSUB,1,0))>0 D ITEMS(USRSUB,.VALMCNT,USRCNT,USRLVL) "RTN","USRECLST",57,0) Q "RTN","USRECLST",58,0) HDR ; Initialize header for review screen "RTN","USRECLST",59,0) N BY,USRX,USRCNT,SCREEN,STATUS,TITLE "RTN","USRECLST",60,0) S USRX=$G(^TMP("USREXP",$J,0)),STATUS=$P("INACTIVE^ACTIVE^ALL",U,+$P(USRX,U,2)+1) "RTN","USRECLST",61,0) S TITLE=STATUS_" USER CLASSES" "RTN","USRECLST",62,0) S USRCNT=$J(+$G(^TMP("USRCLASS",$J,0)),4)_" Classes" "RTN","USRECLST",63,0) S VALMHDR(1)=$$CENTER^USRLS(TITLE) "RTN","USRECLST",64,0) S VALMHDR(1)=$$SETSTR^VALM1(USRCNT,VALMHDR(1),(IOM-$L(USRCNT)),$L(USRCNT)) "RTN","USRECLST",65,0) Q "RTN","USRHELP") 0^12^B4504957 "RTN","USRHELP",1,0) USRHELP ; SLC/JER,PKR - On-line help library ;2/9/98 "RTN","USRHELP",2,0) ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3**;Jun 20, 1997 "RTN","USRHELP",3,0) ;This is a direct copy of TIUHELP with TIU only portions removed. "RTN","USRHELP",4,0) ;====================================================================== "RTN","USRHELP",5,0) PROTOCOL ; Help for protocols "RTN","USRHELP",6,0) N DIRUT,DTOUT,DUOUT,USRX,ORU,ORUPRMT,VALMDDF,VALMPGE S USRX=X "RTN","USRHELP",7,0) D FULL^VALM1 "RTN","USRHELP",8,0) I USRX="?"!(USRX="??") D G PROTX "RTN","USRHELP",9,0) . D DISP^XQORM1 W !!,"Enter selection by typing the name, or abbreviation.",!,"Enter '??' or '???' for additional details.",! "RTN","USRHELP",10,0) . I USRX="?" W:$$STOP^USRU "" "RTN","USRHELP",11,0) I USRX="???" D MENU(XQORNOD) I $D(DIROUT) S (XQORQUIT,XQORPOP)=1 Q "RTN","USRHELP",12,0) PROTX S VALMBCK="R" "RTN","USRHELP",13,0) Q "RTN","USRHELP",14,0) ;====================================================================== "RTN","USRHELP",15,0) MENU(XQORNOD) ; Unwind protocol menus for help "RTN","USRHELP",16,0) N USRSEQ,USRI,USRJ D CLEAR^VALM1 "RTN","USRHELP",17,0) W:$$CONTINUE "Valid selections are:",! "RTN","USRHELP",18,0) S USRI=0 F S USRI=$O(^ORD(101,+XQORNOD,10,USRI)) Q:+USRI'>0 D "RTN","USRHELP",19,0) . S USRJ=+$P($G(^ORD(101,+XQORNOD,10,USRI,0)),U,3) S:$D(USRSEQ(USRJ)) USRJ=USRJ+.1 "RTN","USRHELP",20,0) . S USRSEQ(USRJ)=+$P(^ORD(101,+XQORNOD,10,USRI,0),U) "RTN","USRHELP",21,0) S USRI=0 F S USRI=$O(USRSEQ(USRI)) Q:+USRI'>0!$D(DIRUT) D "RTN","USRHELP",22,0) . I $D(^ORD(101,+USRSEQ(USRI),0)) D ITEM(+USRSEQ(USRI),1) "RTN","USRHELP",23,0) Q "RTN","USRHELP",24,0) ;====================================================================== "RTN","USRHELP",25,0) ITEM(XQORNOD,TAB) ; Show descriptions of items "RTN","USRHELP",26,0) N USRI "RTN","USRHELP",27,0) Q:$P($G(^ORD(101,+XQORNOD,0)),U,2)']"" "RTN","USRHELP",28,0) W:$$CONTINUE ?+$G(TAB),$G(IOINHI),$$UPPER^USRLS($P($G(^ORD(101,+XQORNOD,0)),U,2)),$G(IOINORM),! "RTN","USRHELP",29,0) I $D(DIRUT) Q "RTN","USRHELP",30,0) S USRI=0 F S USRI=$O(^ORD(101,+XQORNOD,1,USRI)) Q:+USRI'>0!$D(DIRUT) D "RTN","USRHELP",31,0) . W:$$CONTINUE ?(TAB+2),$G(^ORD(101,+XQORNOD,1,USRI,0)),! Q:$D(DIRUT) "RTN","USRHELP",32,0) S USRI=0 F S USRI=$O(^ORD(101,+XQORNOD,10,USRI)) Q:+USRI'>0 D "RTN","USRHELP",33,0) . D ITEM(+$G(^ORD(101,+XQORNOD,10,+USRI,0))_";ORD(101,",3) "RTN","USRHELP",34,0) Q "RTN","USRHELP",35,0) ;====================================================================== "RTN","USRHELP",36,0) CONTINUE() ; Pagination control "RTN","USRHELP",37,0) N Y "RTN","USRHELP",38,0) I $Y<(IOSL-2) S Y=1 G CONTX "RTN","USRHELP",39,0) S Y=$$STOP^USRU("",1) W:+Y @IOF,! "RTN","USRHELP",40,0) CONTX Q Y "RTN","USRL") 0^7^B5749721 "RTN","USRL",1,0) USRL ; SLC/JER - User class library ;2/6/98 "RTN","USRL",2,0) ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3**;Jun 20, 1997 "RTN","USRL",3,0) UPDATE(ITEM) ; Updates list following edit "RTN","USRL",4,0) N DA,USRREC,USRABB,USRCLNM,USRACT,USRITM,USREXITM,USREXPND "RTN","USRL",5,0) N USRLREC,USREREC "RTN","USRL",6,0) S DA=+$P(ITEM,U,2),USRREC=$G(^USR(8930,+DA,0)) "RTN","USRL",7,0) S USREXPND=$S(VALMAR="^TMP(""USREXP"",$J)":1,1:0) "RTN","USRL",8,0) S USRITM=$S('USREXPND:+ITEM,1:+$O(@VALMAR@("IDX",+ITEM,0))) "RTN","USRL",9,0) S USREXITM=$S(USREXPND:+ITEM,$D(^TMP("USREXP",$J)):+$G(^TMP("USREXPIDX",$J,+ITEM)),1:0) "RTN","USRL",10,0) S USRCLNM=$S(USRREC']"":"",$P(USRREC,U,4)]"":$P(USRREC,U,4),1:$$MIXED^USRLS($P(USRREC,U))) "RTN","USRL",11,0) I +$D(^USR(8930,DA,1))>9 S USRCLNM="+ "_USRCLNM "RTN","USRL",12,0) S USRABB=$P(USRREC,U,2),USRACT=$S(+$P(USRREC,U,3):"Active",1:"Inactive") "RTN","USRL",13,0) S USRLREC=$$SETFLD^VALM1(USRITM,$G(USRLREC),"NUMBER") "RTN","USRL",14,0) S USRLREC=$$SETFLD^VALM1(USRCLNM,$G(USRLREC),"CLASS NAME") "RTN","USRL",15,0) S USRLREC=$$SETFLD^VALM1(USRABB,$G(USRLREC),"ABBREVIATION") "RTN","USRL",16,0) S USRLREC=$$SETFLD^VALM1(USRACT,$G(USRLREC),"ACTIVE") "RTN","USRL",17,0) S USREREC=$$SETFLD^VALM1(USRITM,$G(USREREC),"NUMBER") "RTN","USRL",18,0) S USREREC=$$SETFLD^VALM1(USRCLNM,$G(USREREC),"CLASS NAME") "RTN","USRL",19,0) S USREREC=$$SETFLD^VALM1(USRABB,$G(USREREC),"ABBREVIATION") "RTN","USRL",20,0) S USREREC=$$SETFLD^VALM1(USRACT,$G(USREREC),"ACTIVE") "RTN","USRL",21,0) S ^TMP("USRCLASS",$J,+USRITM,0)=USRLREC "RTN","USRL",22,0) D RESTORE^VALM10(+USRITM),CNTRL^VALM10(+USRITM,1,VALM("RM"),IOINHI,IOINORM) "RTN","USRL",23,0) I $D(^TMP("USREXP",$J)) D "RTN","USRL",24,0) . S ^TMP("USREXP",$J,+USREXITM,0)=USREREC "RTN","USRL",25,0) . N USRI S USRI=0 "RTN","USRL",26,0) . F S USRI=$O(^TMP("USREXPMAP",$J,DA,USRI)) Q:+USRI'>0 D "RTN","USRL",27,0) . . S $P(^TMP("USREXP",$J,+USRI,0),"|-",2)=USRCLNM "RTN","USRL",28,0) . I +$G(USRCHNG) D Q "RTN","USRL",29,0) . . N USRSTAT,USRDNM,USRLNM S USRSTAT=+$P(^TMP("USREXP",$J,0),U,2) "RTN","USRL",30,0) . . W !,"Class hierarchy changed" "RTN","USRL",31,0) . . K ^TMP("USREXP",$J),^TMP("USREXPIDX",$J),^TMP("USREXPMAP",$J) "RTN","USRL",32,0) . . S VALMAR="^TMP(""USRCLASS"",$J)" "RTN","USRL",33,0) . . S USRDNM=$P($G(^TMP("USRCLASS",$J,0)),U,3) "RTN","USRL",34,0) . . S USRLNM=$P($G(^TMP("USRCLASS",$J,0)),U,4) "RTN","USRL",35,0) . . D BUILD^USRECLST(+USRSTAT,USRDNM,USRLNM) "RTN","USRL",36,0) . . K USRCHNG "RTN","USRL",37,0) Q "RTN","USRL",38,0) RESTORE(ITEM) ; Restore video attributes for a single list element "RTN","USRL",39,0) D RESTORE^VALM10(ITEM),FLDCTRL^VALM10(ITEM,"NUMBER",IOINHI,IOINORM) "RTN","USRL",40,0) Q "RTN","USRLFF") 0^13^B359140 "RTN","USRLFF",1,0) USRLFF ;SLC/PKR - User Class file functions and proc's ;2/19/98 "RTN","USRLFF",2,0) ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3**;Jun 20, 1997 "RTN","USRLFF",3,0) ;This is a library of file functions, mainly for other packages that "RTN","USRLFF",4,0) ;need to access ASU data. "RTN","USRLFF",5,0) ;====================================================================== "RTN","USRLFF",6,0) EVNTPTR(EVENT) ;Return pointer to event EVENT in the USR ACTION file. "RTN","USRLFF",7,0) Q +$O(^USR(8930.8,"B",EVENT,0)) "RTN","USRLFF",8,0) ; "RTN","USRLFF",9,0) ;====================================================================== "RTN","USRLFF",10,0) EVNTVERB(IEN) ;Return the verb for event with ien of IEN. "RTN","USRLFF",11,0) Q $P($G(^USR(8930.8,IEN,0)),U,5) "RTN","USRLFF",12,0) ; "RTN","USRLFF",13,0) ;====================================================================== "RTN","USRLFF",14,0) HASAS(IEN) ;Return true if entry IEN has Authorizations/Subscriptions. "RTN","USRLFF",15,0) I $D(^USR(8930.1,"B",IEN)) Q 1 "RTN","USRLFF",16,0) E Q 0 "RTN","USRLFF",17,0) ; "RTN","USRLFF",18,0) ;====================================================================== "RTN","USRLFF",19,0) USRCLASS(IEN) ;Return the 0 node of USR CLASS. "RTN","USRLFF",20,0) Q $G(^USR(8930,IEN,0)) "RTN","USRLFF",21,0) ; "RTN","USRLFF",22,0) ;====================================================================== "RTN","USRLFF",23,0) USRROLE(ROLE) ;Return the IEN of role ROLE in the USR ROLE file. "RTN","USRLFF",24,0) Q +$O(^USR(8930.2,"B",ROLE,0)) "RTN","USRLFF",25,0) ; "RTN","USRLM") 0^8^B35996106 "RTN","USRLM",1,0) USRLM ; SLC/JER - User Class Membership functions and proc's ;2/9/98 "RTN","USRLM",2,0) ;;1.0;AUTHORIZATION/SUBSCRIPTION;**2,3**;Jun 20, 1997 "RTN","USRLM",3,0) ISA(USER,CLASS,ERR) ; Boolean - Is USER a Member of CLASS? "RTN","USRLM",4,0) N USRY,USRI "RTN","USRLM",5,0) I $S(CLASS="USER":1,CLASS=+$O(^USR(8930,"B","USER",0)):1,1:0) S USRY=1 G ISAX "RTN","USRLM",6,0) I '+USER S USER=+$O(^VA(200,"B",USER,0)) "RTN","USRLM",7,0) I +USER'>0 S ERR="INVALID USER",USRY=0 G ISAX "RTN","USRLM",8,0) I '+CLASS S CLASS=+$O(^USR(8930,"B",CLASS,0)) "RTN","USRLM",9,0) I +CLASS'>0 S ERR="INVALID USER CLASS",USRY=0 G ISAX "RTN","USRLM",10,0) ; If USER is a member of CLASS return true "RTN","USRLM",11,0) S USRY=$S(+$D(^USR(8930.3,"AUC",USER,CLASS)):1,1:0) "RTN","USRLM",12,0) I +$G(USRY)>0 D G ISAX "RTN","USRLM",13,0) . N USRMDA S USRMDA=+$O(^USR(8930.3,"AUC",USER,CLASS,0)) "RTN","USRLM",14,0) . Q:+USRMDA'>0 "RTN","USRLM",15,0) . S USRY=+$$CURRENT(USRMDA) "RTN","USRLM",16,0) ; G:+USRY ISAX "RTN","USRLM",17,0) ; Otherwise, check to see if user is a member of any subclass of CLASS "RTN","USRLM",18,0) S USRI=0 F S USRI=$O(^USR(8930,+CLASS,1,USRI)) Q:+USRI'>0!+$G(USRY) D "RTN","USRLM",19,0) . N USRSUB S USRSUB=+$G(^USR(8930,+CLASS,1,USRI,0)) Q:+USRSUB'>0 "RTN","USRLM",20,0) . S USRY=$$ISA(USER,USRSUB) ; Recurse to find members of subclass "RTN","USRLM",21,0) ISAX Q +$G(USRY) "RTN","USRLM",22,0) CURRENT(MEMBER) ; Boolean - Is Membership current? "RTN","USRLM",23,0) N USRIN,USROUT,USRY "RTN","USRLM",24,0) S USRIN=+$P($G(^USR(8930.3,+MEMBER,0)),U,3) "RTN","USRLM",25,0) S USROUT=+$P($G(^USR(8930.3,+MEMBER,0)),U,4) "RTN","USRLM",26,0) I USRIN'>DT,$S(USROUT>0&(USROUT'0) D "RTN","USRLM",38,0) . I TERMDATE<$$NOW^XLFDT S TERM=1 "RTN","USRLM",39,0) Q TERM "RTN","USRLM",40,0) ; "RTN","USRLM",41,0) ;====================================================================== "RTN","USRLM",42,0) RESIZE(LONG,SHORT,SHRINK) ; Resizes list area "RTN","USRLM",43,0) N USRBM S USRBM=$S(VALMMENU:SHORT,+$G(SHRINK):SHORT,1:LONG) "RTN","USRLM",44,0) I VALM("BM")'=USRBM S VALMBCK="R" D "RTN","USRLM",45,0) . S VALM("BM")=USRBM,VALM("LINES")=(USRBM-VALM("TM"))+1 "RTN","USRLM",46,0) . I +$G(VALMCC) D RESET^VALM4 "RTN","USRLM",47,0) Q "RTN","USRLM",48,0) ;====================================================================== "RTN","USRLM",49,0) TERM ;Actions to be taken when a user is terminated. Invoked by "RTN","USRLM",50,0) ;XU USER TERMINATE. XUIFN is the user being terminated. "RTN","USRLM",51,0) N IND,NOW,OLDTERM "RTN","USRLM",52,0) S NOW=$$NOW^XLFDT "RTN","USRLM",53,0) S IND="" "RTN","USRLM",54,0) F S IND=$O(^USR(8930.3,"B",XUIFN,IND)) Q:IND="" D "RTN","USRLM",55,0) . S OLDTERM=+$P($G(^USR(8930.3,IND,0)),U,4) "RTN","USRLM",56,0) . I (OLDTERM>0)&(OLDTERM0 D "RTN","USRLM",68,0) . S USRDA=$O(^USR(8930.3,"ACU",CLASS,USER,0)) Q:+USRDA'>0 "RTN","USRLM",69,0) . S EFFCTV=$P($G(^USR(8930.3,+USRDA,0)),U,3) "RTN","USRLM",70,0) . S EXPIRES=$P($G(^USR(8930.3,+USRDA,0)),U,4) "RTN","USRLM",71,0) . S USRNM=$P($G(^VA(200,+USER,0)),U) "RTN","USRLM",72,0) . S USRCLNM=$$CLNAME(+CLASS) "RTN","USRLM",73,0) . S @MEMBER@(USRNM)=USER_U_USRDA_U_USRCLNM_U_EFFCTV_U_EXPIRES "RTN","USRLM",74,0) . S USRCNT=+$G(USRCNT)+1 "RTN","USRLM",75,0) I '$D(@MEMBER@(0)) S @MEMBER@(0)=CLASS_U_$P($G(^USR(8930,+CLASS,0)),U)_U "RTN","USRLM",76,0) S $P(@MEMBER@(0),U,3)=USRCNT "RTN","USRLM",77,0) S USRI=0 F S USRI=$O(^USR(8930,+CLASS,1,USRI)) Q:+USRI'>0 D "RTN","USRLM",78,0) . N USRSUB S USRSUB=+$G(^USR(8930,+CLASS,1,USRI,0)) Q:+USRSUB'>0 "RTN","USRLM",79,0) . D WHOIS(MEMBER,USRSUB) ; Recurse to find members of subclass "RTN","USRLM",80,0) Q "RTN","USRLM",81,0) WHOIS2(MEMBER,CLASS) ; Given a Class, return list of CURRENT members "RTN","USRLM",82,0) ; CLASS is pointer to file 8930 "RTN","USRLM",83,0) ; MEMBER is name of array (local or global) in which members are "RTN","USRLM",84,0) ; returned in alphabetical order by name - indexed by number "RTN","USRLM",85,0) ; i.e. @MEMBER@(1 ...n) "RTN","USRLM",86,0) ; @member@(0) = ien of8930^usr class name^count of members "RTN","USRLM",87,0) ; @member@(1..n)= "RTN","USRLM",88,0) ; 1 2 3 4 5 6 7 8 "RTN","USRLM",89,0) ; p200^p8930.3^classname^effectdate^inactdate^username^title^mailcode "RTN","USRLM",90,0) ; Note: For pieces 2,4 & 5 - Only one of potentially many is returned "RTN","USRLM",91,0) ; "RTN","USRLM",92,0) N USER,USRNM,USRCLNM,USRCNT,USRDA,EFFCTV,EXPIRES,USRI "RTN","USRLM",93,0) D WHOISTMP(.CLASS) "RTN","USRLM",94,0) S USRNM="",USRNDX=0 "RTN","USRLM",95,0) F S USRNM=$O(^TMP($J,"USRWHO2","B",USRNM)) Q:USRNM']"" D "RTN","USRLM",96,0) . S USER=0 F S USER=$O(^TMP($J,"USRWHO2","B",USRNM,USER)) Q:'USER D "RTN","USRLM",97,0) . . S USRNDX=USRNDX+1 "RTN","USRLM",98,0) . . S @MEMBER@(USRNDX)=^TMP($J,"USRWHO2",USER) "RTN","USRLM",99,0) S @MEMBER@(0)=^TMP($J,"USRWHO2",0) "RTN","USRLM",100,0) S $P(@MEMBER@(0),U,3)=USRNDX "RTN","USRLM",101,0) K ^TMP($J,"USRWHO2") "RTN","USRLM",102,0) Q "RTN","USRLM",103,0) WHOISTMP(CLASS) ; Given a Class, return list of CURRENT members into ^TMP "RTN","USRLM",104,0) ; CLASS is pointer to file 8930 "RTN","USRLM",105,0) ; MEMBER is name of array (local or global) in which members are "RTN","USRLM",106,0) ; returned in order by user/x-ref by name "RTN","USRLM",107,0) ; main = ^tmp($j,"USRWHO2",user) "RTN","USRLM",108,0) ; x-ref= ^tmp($j,"USRWHO2","b",usrnm,user) "RTN","USRLM",109,0) ; -- used by whois2 call "RTN","USRLM",110,0) N USER,USRNM,USRCLNM,USRCNT,USRDA,EFFCTV,EXPIRES,USRI,USRMC,USRTIT,USRX "RTN","USRLM",111,0) S USER=0,USRCNT=+$P($G(@MEMBER@(0)),U,3) "RTN","USRLM",112,0) F S USER=$O(^USR(8930.3,"ACU",CLASS,USER)) Q:+USER'>0 D "RTN","USRLM",113,0) . S USRDA=$O(^USR(8930.3,"ACU",CLASS,USER,0)) Q:+USRDA'>0 "RTN","USRLM",114,0) . S EFFCTV=$P($G(^USR(8930.3,+USRDA,0)),U,3) "RTN","USRLM",115,0) . S EXPIRES=$P($G(^USR(8930.3,+USRDA,0)),U,4) "RTN","USRLM",116,0) . S USRNM=$P($G(^VA(200,+USER,0)),U) "RTN","USRLM",117,0) . S USRX=$P($G(^VA(200,+USER,0)),U,9) "RTN","USRLM",118,0) . S USRTIT=$$EXTERNAL^DILFD(200,8,"",USRX) "RTN","USRLM",119,0) . S USRMC=$P($G(^VA(200,+USER,5)),U,2) "RTN","USRLM",120,0) . S USRCLNM=$$CLNAME(+CLASS) "RTN","USRLM",121,0) . S ^TMP($J,"USRWHO2",USER)=USER_U_USRDA_U_USRCLNM_U_EFFCTV_U_EXPIRES_U_USRNM_U_USRTIT_U_USRMC "RTN","USRLM",122,0) . S ^TMP($J,"USRWHO2","B",USRNM,USER)="" "RTN","USRLM",123,0) . S USRCNT=+$G(USRCNT)+1 "RTN","USRLM",124,0) I '$D(^TMP($J,"USRWHO2",0))#2 S ^TMP($J,"USRWHO2",0)=CLASS_U_$P($G(^USR(8930,+CLASS,0)),U)_U "RTN","USRLM",125,0) S $P(^TMP($J,"USRWHO2",0),U,3)=USRCNT "RTN","USRLM",126,0) S USRI=0 F S USRI=$O(^USR(8930,+CLASS,1,USRI)) Q:+USRI'>0 D "RTN","USRLM",127,0) . N USRSUB S USRSUB=+$G(^USR(8930,+CLASS,1,USRI,0)) Q:+USRSUB'>0 "RTN","USRLM",128,0) . D WHOISTMP(USRSUB) ; Recurse to find members of subclass "RTN","USRLM",129,0) Q "RTN","USRLM",130,0) WHATIS(USER,CLASS) ; Given a User, return list of CURRENT classes "RTN","USRLM",131,0) ; USER is pointer to file 200 "RTN","USRLM",132,0) ; CLASS is name of array (local or global) in which the list of "RTN","USRLM",133,0) ; classes to which the USER belongs will be returned in "RTN","USRLM",134,0) ; alphabetic order by class name "RTN","USRLM",135,0) N GROUP,CLASSNM,CLASSCNT,USRDA,EFFCTV,EXPIRES S (CLASSCNT,GROUP)=0 "RTN","USRLM",136,0) F S GROUP=$O(^USR(8930.3,"AUC",USER,GROUP)) Q:+GROUP'>0 D "RTN","USRLM",137,0) . S USRDA=$O(^USR(8930.3,"AUC",USER,GROUP,0)) Q:+USRDA'>0 "RTN","USRLM",138,0) . S EFFCTV=$P($G(^USR(8930.3,+USRDA,0)),U,3) "RTN","USRLM",139,0) . S EXPIRES=$P($G(^USR(8930.3,+USRDA,0)),U,4) "RTN","USRLM",140,0) . S CLASSNM=$$CLNAME(+GROUP) "RTN","USRLM",141,0) . S @CLASS@(CLASSNM)=GROUP_U_USRDA_U_CLASSNM_U_EFFCTV_U_EXPIRES "RTN","USRLM",142,0) . S CLASSCNT=+$G(CLASSCNT)+1 "RTN","USRLM",143,0) S @CLASS@(0)=USER_U_$$SIGNAME^USRLS(+USER)_U_CLASSCNT "RTN","USRLM",144,0) Q "RTN","USRLM",145,0) CLNAME(CLASS) ; Given a class, return the Display Name "RTN","USRLM",146,0) N USRREC,USRY "RTN","USRLM",147,0) S USRREC=$G(^USR(8930,+CLASS,0)) "RTN","USRLM",148,0) Q $S($P(USRREC,U,4)]"":$P(USRREC,U,4),1:$$MIXED^USRLS($P(USRREC,U))) "RTN","USRLM",149,0) PUT(USER,CLASS) ; Make user a member of a given class "RTN","USRLM",150,0) N DIC,DLAYGO,DA,DR,DIE,X,Y "RTN","USRLM",151,0) S (DIC,DLAYGO)=8930.3,DIC(0)="LXF",X=""""_"`"_USER_"""" D ^DIC Q:+Y'>0 "RTN","USRLM",152,0) S DIE=DIC,DA=+Y,DR=".02///"_CLASS_";.03///"_DT "RTN","USRLM",153,0) D ^DIE "RTN","USRLM",154,0) Q "RTN","USRLM",155,0) SUBCLASS(DA,CLASS) ; Evaluate whether a given USER CLASS is a DESCENDENT "RTN","USRLM",156,0) ; of another class "RTN","USRLM",157,0) ; Receives DA = record # of possible subclass in 8930, and "RTN","USRLM",158,0) ; CLASS = record # of possible descendent class in 8930 "RTN","USRLM",159,0) N USRI,USRY S (USRI,USRY)=0 "RTN","USRLM",160,0) I +$G(DA)'>0 S DA=+$O(^USR(8930,"B",DA,0)) "RTN","USRLM",161,0) I +$G(CLASS)'>0 S CLASS=+$O(^USR(8930,"B",CLASS,0)) "RTN","USRLM",162,0) F S USRI=$O(^USR(8930,"AD",DA,USRI)) Q:+USRI'>0!(USRY=1) D "RTN","USRLM",163,0) . I USRI=CLASS S USRY=1 Q "RTN","USRLM",164,0) . S USRY=$$SUBCLASS(USRI,CLASS) "RTN","USRLM",165,0) Q USRY "RTN","USRLM",166,0) CANDEL(USRCLDA) ; Evaluate whether user can delete a class "RTN","USRLM",167,0) N USRMLST,USRY S USRY=0 "RTN","USRLM",168,0) D WHOIS("USRMLST",USRCLDA) "RTN","USRLM",169,0) I +$P(USRMLST(0),U,3)>0 S USRY=1 W " There are members of the class ",$$CLNAME(USRCLDA) "RTN","USRLM",170,0) Q USRY "RTN","USRLS") 0^11^B6815279 "RTN","USRLS",1,0) USRLS ; SLC/JER - String functions for ASU ;2/9/1998 "RTN","USRLS",2,0) ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3**;Jun 20, 1997 "RTN","USRLS",3,0) ;====================================================================== "RTN","USRLS",4,0) CENTER(X) ; Center X "RTN","USRLS",5,0) N SP "RTN","USRLS",6,0) S $P(SP," ",((IOM-$L(X))\2))="" "RTN","USRLS",7,0) Q $G(SP)_X "RTN","USRLS",8,0) ;====================================================================== "RTN","USRLS",9,0) DATE(X,FMT) ; Call with X=2910419.01 and FMT=Return Format of date ("MM/DD") "RTN","USRLS",10,0) N AMTH,MM,CC,DD,YY,GMRDI,GMRDTMP "RTN","USRLS",11,0) I +X'>0 S $P(GMRDTMP," ",$L($G(FMT))+1)="",FMT=GMRDTMP G QDATE "RTN","USRLS",12,0) I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="MM/DD/YY" "RTN","USRLS",13,0) S MM=$E(X,4,5),DD=$E(X,6,7),YY=$E(X,2,3),CC=17+$E(X) "RTN","USRLS",14,0) S:FMT["AMTH" AMTH=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+MM) "RTN","USRLS",15,0) F GMRDI="AMTH","MM","DD","CC","YY" S:FMT[GMRDI FMT=$P(FMT,GMRDI)_@GMRDI_$P(FMT,GMRDI,2) "RTN","USRLS",16,0) I FMT["HR" S FMT=$$TIME(X,FMT) "RTN","USRLS",17,0) QDATE Q FMT "RTN","USRLS",18,0) ;====================================================================== "RTN","USRLS",19,0) MIXED(X) ; Return Mixed Case X "RTN","USRLS",20,0) N USRI,WORD,TMP "RTN","USRLS",21,0) S TMP="" F USRI=1:1:$L(X," ") S WORD=$$UP^XLFSTR($E($P(X," ",USRI)))_$$LOW^XLFSTR($E($P(X," ",USRI),2,$L($P(X," ",USRI)))),TMP=$S(TMP="":WORD,1:TMP_" "_WORD) "RTN","USRLS",22,0) Q TMP "RTN","USRLS",23,0) ;====================================================================== "RTN","USRLS",24,0) SIGNAME(GMDA) ; Get/Return Signature Block Printed Name "RTN","USRLS",25,0) Q $P($G(^VA(200,+GMDA,20)),U,2) "RTN","USRLS",26,0) ;====================================================================== "RTN","USRLS",27,0) TIME(X,FMT) ; Recieves X as 2910419.01 and FMT=Return Format of time (HH:MM:SS). "RTN","USRLS",28,0) N HR,MIN,SEC,TIUI "RTN","USRLS",29,0) I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="HR:MIN" "RTN","USRLS",30,0) S X=$P(X,".",2),HR=$E(X,1,2)_$E("00",0,2-$L($E(X,1,2))),MIN=$E(X,3,4)_$E("00",0,2-$L($E(X,3,4))),SEC=$E(X,5,6)_$E("00",0,2-$L($E(X,5,6))) "RTN","USRLS",31,0) F TIUI="HR","MIN","SEC" S:FMT[TIUI FMT=$P(FMT,TIUI)_@TIUI_$P(FMT,TIUI,2) "RTN","USRLS",32,0) Q FMT "RTN","USRLS",33,0) ;====================================================================== "RTN","USRLS",34,0) UPPER(X) ; Convert lower case X to UPPER CASE "RTN","USRLS",35,0) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","USRLS",36,0) ;====================================================================== "RTN","USRLS",37,0) WRAP(TEXT,LENGTH) ; Breaks text string into substrings of length LENGTH "RTN","USRLS",38,0) N USRI,USRJ,LINE,USRX,USRX1,USRX2,USRY "RTN","USRLS",39,0) I $G(TEXT)']"" Q "" "RTN","USRLS",40,0) F USRI=1:1 D Q:USRI=$L(TEXT," ") "RTN","USRLS",41,0) . S USRX=$P(TEXT," ",USRI) "RTN","USRLS",42,0) . I $L(USRX)>LENGTH D "RTN","USRLS",43,0) . . S USRX1=$E(USRX,1,LENGTH),USRX2=$E(USRX,LENGTH+1,$L(USRX)) "RTN","USRLS",44,0) . . S $P(TEXT," ",USRI)=USRX1_" "_USRX2 "RTN","USRLS",45,0) S LINE=1,USRX(1)=$P(TEXT," ") "RTN","USRLS",46,0) F USRI=2:1 D Q:USRI'<$L(TEXT," ") "RTN","USRLS",47,0) . S:$L($G(USRX(LINE))_" "_$P(TEXT," ",USRI))>LENGTH LINE=LINE+1,USRY=1 "RTN","USRLS",48,0) . S USRX(LINE)=$G(USRX(LINE))_$S(+$G(USRY):"",1:" ")_$P(TEXT," ",USRI),USRY=0 "RTN","USRLS",49,0) S USRJ=0,TEXT="" F USRI=1:1 S USRJ=$O(USRX(USRJ)) Q:+USRJ'>0 S TEXT=TEXT_$S(USRI=1:"",1:"|")_USRX(USRJ) "RTN","USRLS",50,0) Q TEXT "RTN","USRM") 0^9^B1609192 "RTN","USRM",1,0) USRM ; SLC/JER - User class membership library ;2/6/98 "RTN","USRM",2,0) ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3**;Jun 20, 1997 "RTN","USRM",3,0) UPDATE(ITEM) ; Updates list following edit "RTN","USRM",4,0) N USRDA,USRDUZ,USRSIGNM,USREFF,USREXP,USRMEM,USRREC,USRCLNM "RTN","USRM",5,0) S USRDA=$P(ITEM,U,2) "RTN","USRM",6,0) S USRMEM=$G(^USR(8930.3,+USRDA,0)) "RTN","USRM",7,0) S USRDUZ=+USRMEM,USRSIGNM=$$SIGNAME^USRLS(+USRDUZ) "RTN","USRM",8,0) S USRCLNM=$$CLNAME^USRLM(+$P(USRMEM,U,2)) "RTN","USRM",9,0) S USREFF=$$DATE^USRLS(+$P(USRMEM,U,3),"MM/DD/YY") "RTN","USRM",10,0) S USREXP=$$DATE^USRLS(+$P(USRMEM,U,4),"MM/DD/YY") "RTN","USRM",11,0) S USRREC=$$SETFLD^VALM1(+ITEM,"","NUMBER") "RTN","USRM",12,0) S USRREC=$$SETFLD^VALM1(USRSIGNM,USRREC,"MEMBER") "RTN","USRM",13,0) S USRREC=$$SETFLD^VALM1(USREFF,USRREC,"EFFECTIVE") "RTN","USRM",14,0) S USRREC=$$SETFLD^VALM1(USREXP,USRREC,"EXPIRES") "RTN","USRM",15,0) S USRREC=$$SETFLD^VALM1(USRCLNM,USRREC,"CLASS") "RTN","USRM",16,0) S ^TMP("USRMMBR",$J,+ITEM,0)=USRREC "RTN","USRM",17,0) D RESTORE^VALM10(+ITEM),CNTRL^VALM10(+ITEM,1,VALM("RM"),IOINHI,IOINORM) "RTN","USRM",18,0) Q "RTN","USRMEMBR") 0^3^B24260854 "RTN","USRMEMBR",1,0) USRMEMBR ; SLC/JER - User Class Management actions ;2/11/98 "RTN","USRMEMBR",2,0) ;;1.0;AUTHORIZATION/SUBSCRIPTION;**2,3**;Jun 20, 1997 "RTN","USRMEMBR",3,0) EDIT ; Edit user's class membership "RTN","USRMEMBR",4,0) N USRDA,USRDATA,USREXPND,USRI,USRSTAT,DIROUT,USRCHNG,USRLST "RTN","USRMEMBR",5,0) I '$D(VALMY) D EN^VALM2(XQORNOD(0)) "RTN","USRMEMBR",6,0) S (USRCHNG,USRI)=0 "RTN","USRMEMBR",7,0) F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT) "RTN","USRMEMBR",8,0) . S USRDATA=$G(^TMP("USRMMBRIDX",$J,USRI)) "RTN","USRMEMBR",9,0) . W !!,"Editing #",+USRDATA,! "RTN","USRMEMBR",10,0) . S USRDA=+$P(USRDATA,U,2) D EDIT1 "RTN","USRMEMBR",11,0) . I +$G(USRCHNG) S USRLST=$S($L($G(USRLST)):$G(USRLST)_", ",1:"")_USRI "RTN","USRMEMBR",12,0) . I $D(USRDATA) D UPDATE^USRM(USRDATA) "RTN","USRMEMBR",13,0) W !,"Refreshing the list." "RTN","USRMEMBR",14,0) S VALMSG="** "_$S($L($G(USRLST)):"Item"_$S($L($G(USRLST),",")>1:"s ",1:" ")_$G(USRLST),1:"Nothing")_" Edited **" "RTN","USRMEMBR",15,0) K VALMY S VALMBCK="R" "RTN","USRMEMBR",16,0) Q "RTN","USRMEMBR",17,0) EDIT1 ; Single record edit "RTN","USRMEMBR",18,0) ; Receives USRDA "RTN","USRMEMBR",19,0) N DA,DIE,DR "RTN","USRMEMBR",20,0) I '+$G(USRDA) W !,"No Classes selected." H 2 S USRCHNG=0 Q "RTN","USRMEMBR",21,0) S DIE="^USR(8930.3,",DA=USRDA,DR="[USR MEMBERSHIP EDIT]" "RTN","USRMEMBR",22,0) D FULL^VALM1,^DIE S USRCHNG=1 "RTN","USRMEMBR",23,0) Q "RTN","USRMEMBR",24,0) ADD ; Add a member to the class "RTN","USRMEMBR",25,0) N DA,DR,DIC,DLAYGO,X,Y,USRCLASS,USRUSER,USRQUIT,USRCNT D FULL^VALM1 "RTN","USRMEMBR",26,0) S USRCNT=0 "RTN","USRMEMBR",27,0) F D Q:+$G(USRQUIT) "RTN","USRMEMBR",28,0) . W ! "RTN","USRMEMBR",29,0) . S DIC=200,DIC(0)="AEMQ" "RTN","USRMEMBR",30,0) . S DIC("A")="Select "_$S(USRCNT'>0:"",1:"Another ")_"MEMBER: " "RTN","USRMEMBR",31,0) . S DIC("S")="I ('$$ISA^USRLM(+Y,USRDA))" ;USR*1.0*2 PKR "RTN","USRMEMBR",32,0) . D ^DIC I +Y'>0 S USRQUIT=1 Q "RTN","USRMEMBR",33,0) . I $$ISTERM^USRLM(+Y) D Q "RTN","USRMEMBR",34,0) .. S USRQUIT=1 "RTN","USRMEMBR",35,0) .. W !,"The user you selected is terminated, cannot add them as a class member!" "RTN","USRMEMBR",36,0) .. H 2 "RTN","USRMEMBR",37,0) . S (DIC,DLAYGO)=8930.3,DIC(0)="LM",X=""""_$P(Y,U,2)_"""" "RTN","USRMEMBR",38,0) . S DIC("W")="D DICW^USRMEMBR" "RTN","USRMEMBR",39,0) . D ^DIC I +Y'>0 S USRQUIT=1 Q "RTN","USRMEMBR",40,0) . S USRCREAT=+$P(Y,U,3),USRCNT=USRCNT+1 "RTN","USRMEMBR",41,0) . S DA=+Y,DIE=DIC,DIE("NO^")="BACK",DR="[USR CLASS EDIT]" D ^DIE "RTN","USRMEMBR",42,0) . I $D(Y) D Q "RTN","USRMEMBR",43,0) . . S DIK=DIC D ^DIK K DIK "RTN","USRMEMBR",44,0) . . S:+USRCNT'>1 VALMSG="** Nothing Added **" "RTN","USRMEMBR",45,0) . . S VALMBCK="R",USRQUIT=1 "RTN","USRMEMBR",46,0) . I 'USRCREAT D Q "RTN","USRMEMBR",47,0) . . S:+USRCNT'>1 VALMSG="** Nothing Added **" "RTN","USRMEMBR",48,0) . . S VALMBCK="R",USRQUIT=1 "RTN","USRMEMBR",49,0) W !,"Rebuilding membership list." "RTN","USRMEMBR",50,0) S USRCLASS=+$G(^TMP("USRM",$J,0)) "RTN","USRMEMBR",51,0) D BUILD^USRMLST(USRCLASS) "RTN","USRMEMBR",52,0) I USRCNT'>1,+$G(DA) D "RTN","USRMEMBR",53,0) . S USRUSER=$$SIGNAME^USRLS(+$G(^USR(8930.3,+DA,0))) "RTN","USRMEMBR",54,0) . S VALMSG="** "_USRUSER_" Added **" "RTN","USRMEMBR",55,0) S VALMCNT=+$G(@VALMAR@(0)) "RTN","USRMEMBR",56,0) S VALMBCK="R" "RTN","USRMEMBR",57,0) Q "RTN","USRMEMBR",58,0) DICW ; Write code for member look-up "RTN","USRMEMBR",59,0) N USRSIGNM,USRCLASS,USREFF,USREXP,USRMEM "RTN","USRMEMBR",60,0) S USRMEM=$G(^USR(8930.3,+Y,0)) "RTN","USRMEMBR",61,0) S USRSIGNM=$$SIGNAME^USRLS(+USRMEM) "RTN","USRMEMBR",62,0) S USRCLASS=$E($$CLNAME^USRLM(+$P(USRMEM,U,2)),1,24) "RTN","USRMEMBR",63,0) S USREFF=$$DATE^USRLS($P(USRMEM,U,3),"MM/DD/YY") "RTN","USRMEMBR",64,0) S USREXP=$$DATE^USRLS($P(USRMEM,U,4),"MM/DD/YY") "RTN","USRMEMBR",65,0) W USRSIGNM," ",USRCLASS,?60,USREFF," - ",USREXP "RTN","USRMEMBR",66,0) Q "RTN","USRMEMBR",67,0) DELETE ; Delete a member to the class "RTN","USRMEMBR",68,0) N DIE,X,Y,USRCLASS D FULL^VALM1 "RTN","USRMEMBR",69,0) N USRCLASS,USRDA,USRCHNG,USRDATA,USRI,USRLST,DIROUT "RTN","USRMEMBR",70,0) I '$D(VALMY) D EN^VALM2(XQORNOD(0)) "RTN","USRMEMBR",71,0) S USRI=0 "RTN","USRMEMBR",72,0) F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT) "RTN","USRMEMBR",73,0) . S USRDATA=$G(^TMP("USRMMBRIDX",$J,USRI)) "RTN","USRMEMBR",74,0) . S USRDA=+$P(USRDATA,U,2) D DELETE1(USRDA) "RTN","USRMEMBR",75,0) . S:+$G(USRCHNG) USRLST=$S(+$G(USRLST):USRLST_", ",1:"")_+USRDATA "RTN","USRMEMBR",76,0) . I $D(USRDATA) D UPDATE^USRM(USRDATA) "RTN","USRMEMBR",77,0) W !,"Rebuilding the list." "RTN","USRMEMBR",78,0) S USRCLASS=+$G(^TMP("USRM",$J,0)) "RTN","USRMEMBR",79,0) D BUILD^USRMLST(USRCLASS) "RTN","USRMEMBR",80,0) S VALMCNT=+$G(@VALMAR@(0)) "RTN","USRMEMBR",81,0) K VALMY S VALMBCK="R" "RTN","USRMEMBR",82,0) S VALMSG="** "_$S($L($G(USRLST)):"Item"_$S($L($G(USRLST),",")>1:"s ",1:" ")_$G(USRLST),1:"Nothing")_" removed **" "RTN","USRMEMBR",83,0) Q "RTN","USRMEMBR",84,0) DELETE1(DA) ; Delete one member from a class "RTN","USRMEMBR",85,0) N DIE,DR,USER,CLASS,USRMEM S USRMEM=$G(^USR(8930.3,+DA,0)) "RTN","USRMEMBR",86,0) I USRMEM']"" W !,"Record #",DA," NOT FOUND!" Q "RTN","USRMEMBR",87,0) S USER=$P($G(^VA(200,+USRMEM,0)),U) "RTN","USRMEMBR",88,0) S CLASS=$P($G(^USR(8930,+$P(USRMEM,U,2),0)),U) "RTN","USRMEMBR",89,0) W !,"Removing ",USER," from ",CLASS "RTN","USRMEMBR",90,0) I '$$READ^USRU("Y","Are you SURE","NO") S USRCHNG=0 W !,USER," NOT Removed from ",CLASS,"." Q "RTN","USRMEMBR",91,0) S USRCHNG=1 "RTN","USRMEMBR",92,0) S DIK="^USR(8930.3," D ^DIK K DIK W "." "RTN","USRMEMBR",93,0) Q "RTN","USRMEMBR",94,0) SCHEDULE ; Schedule changes in class membership "RTN","USRMEMBR",95,0) N DIC,DLAYGO,X,Y,USRDUZ,USRUSER,USRMIN,USRMAX,USREFF,USREXP,USRCLASS "RTN","USRMEMBR",96,0) N USRCLNM "RTN","USRMEMBR",97,0) D FULL^VALM1 "RTN","USRMEMBR",98,0) I '$D(VALMY) D EN^VALM2(XQORNOD(0)) "RTN","USRMEMBR",99,0) S DIC=8930,DIC(0)="AEMQZ",DIC("A")="Select CLASS: " "RTN","USRMEMBR",100,0) S DIC("B")=$P($G(^TMP("USRMMBR",$J,0)),U,2) "RTN","USRMEMBR",101,0) D ^DIC Q:+Y'>0 "RTN","USRMEMBR",102,0) S USRCLASS=+Y,USRCLNM=$$CLNAME^USRLM(USRCLASS) "RTN","USRMEMBR",103,0) S USRMIN=DT,USRMAX=$$FMADD^XLFDT(DT,365) "RTN","USRMEMBR",104,0) S USREFF=$$READ^USRU("D^"_USRMIN_":"_USRMAX_":EXFT"," Specify EFFECTIVE DATE/TIME","TODAY") "RTN","USRMEMBR",105,0) S USREXP=$$READ^USRU("D^"_USRMIN_":"_USRMAX_":EXFT","Specify EXPIRATION DATE/TIME","T+365") "RTN","USRMEMBR",106,0) S USRI=0 "RTN","USRMEMBR",107,0) F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D "RTN","USRMEMBR",108,0) . N USRDATA,USRDUZ,USRMEM,USRUSER,DIC,DIE,DA,DR,X,Y "RTN","USRMEMBR",109,0) . S USRDATA=$G(^TMP("USRMMBRIDX",$J,USRI)) "RTN","USRMEMBR",110,0) . S USRMEM=$G(^USR(8930.3,+$P(USRDATA,U,2),0)),USRDUZ=+USRMEM "RTN","USRMEMBR",111,0) . S DIC=200,DIC(0)="NX",X="`"_USRDUZ "RTN","USRMEMBR",112,0) . D ^DIC Q:+Y'>0 "RTN","USRMEMBR",113,0) . S (DIC,DLAYGO)=8930.3,DIC(0)="LM",X=""""_$P(Y,U,2)_"""" "RTN","USRMEMBR",114,0) . D ^DIC Q:+Y'>0 "RTN","USRMEMBR",115,0) . S USRCREAT=+$P(Y,U,3) "RTN","USRMEMBR",116,0) . S DA=+Y,DIE=DIC "RTN","USRMEMBR",117,0) . S DR=".02////"_USRCLASS_";.03////"_USREFF_";.04////"_USREXP "RTN","USRMEMBR",118,0) . D ^DIE "RTN","USRMEMBR",119,0) W !,"Rebuilding membership list." "RTN","USRMEMBR",120,0) ;D BUILD^USRMLST(USRCLASS) "RTN","USRMEMBR",121,0) ;S USRUSER=$$SIGNAME^USRLS(+$G(^USR(8930.3,+DA,0))) "RTN","USRMEMBR",122,0) ;S VALMSG="** "_USRUSER_" Added **" "RTN","USRMEMBR",123,0) ;S VALMCNT=+$G(@VALMAR@(0)) "RTN","USRMEMBR",124,0) S VALMBCK="R" "RTN","USRMEMBR",125,0) Q "RTN","USRMLST") 0^15^B8359979 "RTN","USRMLST",1,0) USRMLST ; SLC/JER - List User Class Members ;2/9/98 "RTN","USRMLST",2,0) ;;1.0;AUTHORIZATION/SUBSCRIPTION;**2,3**;Jun 20, 1997 "RTN","USRMLST",3,0) MAIN ; Control Branching "RTN","USRMLST",4,0) N DIC,X,Y,USRDUZ "RTN","USRMLST",5,0) S DIC=8930,DIC(0)="AEMQ",DIC("A")="Select CLASS: " "RTN","USRMLST",6,0) D ^DIC Q:+Y'>0 "RTN","USRMLST",7,0) S USRDA=+Y "RTN","USRMLST",8,0) D EN^VALM("USR LIST MEMBERSHIP BY CLASS") "RTN","USRMLST",9,0) Q "RTN","USRMLST",10,0) MAKELIST ; Build review screen list "RTN","USRMLST",11,0) K VALMY "RTN","USRMLST",12,0) W !,"Searching for the User Classes." "RTN","USRMLST",13,0) D BUILD(USRDA) "RTN","USRMLST",14,0) Q "RTN","USRMLST",15,0) BUILD(USRDA) ; Build List "RTN","USRMLST",16,0) N USRCNT,USRNAME,USRPICK "RTN","USRMLST",17,0) S (USRCNT,VALMCNT)=0 "RTN","USRMLST",18,0) S USRPICK=+$O(^ORD(101,"B","USR ACTION SELECT LIST ELEMENT",0)) "RTN","USRMLST",19,0) K ^TMP("USRMMBR",$J),^TMP("USRMMBRIDX",$J),^TMP("USRM",$J) "RTN","USRMLST",20,0) D WHOIS^USRLM("^TMP(""USRM"",$J)",USRDA) "RTN","USRMLST",21,0) S USRNAME=0 "RTN","USRMLST",22,0) F S USRNAME=$O(^TMP("USRM",$J,USRNAME)) Q:USRNAME="" D "RTN","USRMLST",23,0) . N USRDA,USRDUZ,USRSIGNM,USREFF,USREXP,USRMEM,USRREC,USRCLNM "RTN","USRMLST",24,0) . S USRMEM=$G(^TMP("USRM",$J,USRNAME)) "RTN","USRMLST",25,0) . S USRDUZ=+USRMEM,USRSIGNM=$$SIGNAME^USRLS(+USRDUZ) "RTN","USRMLST",26,0) .;==== START USR*1.0*2 PKR ============================================= "RTN","USRMLST",27,0) .;If this user has been terminated change the name to reflect this. "RTN","USRMLST",28,0) . I $$ISTERM^USRLM(+USRDUZ) S USRSIGNM="(T) "_USRSIGNM "RTN","USRMLST",29,0) .;=== END USR*1.0*2 ==================================================== "RTN","USRMLST",30,0) . S USRDA=+$P(USRMEM,U,2),USRCLNM=$P(USRMEM,U,3) "RTN","USRMLST",31,0) . S USREFF=$$DATE^USRLS(+$P(USRMEM,U,4),"MM/DD/YY") "RTN","USRMLST",32,0) . S USREXP=$$DATE^USRLS(+$P(USRMEM,U,5),"MM/DD/YY") "RTN","USRMLST",33,0) . S USRCNT=+$G(USRCNT)+1 "RTN","USRMLST",34,0) . S USRREC=$$SETFLD^VALM1(USRCNT,"","NUMBER") "RTN","USRMLST",35,0) . S USRREC=$$SETFLD^VALM1(USRSIGNM,USRREC,"MEMBER") "RTN","USRMLST",36,0) . S USRREC=$$SETFLD^VALM1(USREFF,USRREC,"EFFECTIVE") "RTN","USRMLST",37,0) . S USRREC=$$SETFLD^VALM1(USREXP,USRREC,"EXPIRES") "RTN","USRMLST",38,0) . S USRREC=$$SETFLD^VALM1(USRCLNM,USRREC,"CLASS") "RTN","USRMLST",39,0) . S VALMCNT=+$G(VALMCNT)+1 "RTN","USRMLST",40,0) . S ^TMP("USRMMBR",$J,VALMCNT,0)=USRREC "RTN","USRMLST",41,0) . S ^TMP("USRMMBR",$J,"IDX",VALMCNT,USRCNT)="" "RTN","USRMLST",42,0) . S ^TMP("USRMMBRIDX",$J,USRCNT)=VALMCNT_U_USRDA W:VALMCNT#10'>0 "." "RTN","USRMLST",43,0) S ^TMP("USRMMBR",$J,0)=+$G(USRCNT)_U_$P(^TMP("USRM",$J,0),U,2) "RTN","USRMLST",44,0) S ^TMP("USRMMBR",$J,"#")=USRPICK_U_"1:"_USRCNT "RTN","USRMLST",45,0) I $D(VALMHDR)>9 D HDR "RTN","USRMLST",46,0) I +$G(USRCNT)'>0 D "RTN","USRMLST",47,0) . S ^TMP("USRMMBR",$J,1,0)="",VALMCNT=2 "RTN","USRMLST",48,0) . S ^TMP("USRMMBR",$J,2,0)="No "_$P(^TMP("USRM",$J,0),U,2)_"s found" "RTN","USRMLST",49,0) Q "RTN","USRMLST",50,0) HDR ; Initialize header for review screen "RTN","USRMLST",51,0) N BY,USRX,USRCNT,TITLE,USRCLASS "RTN","USRMLST",52,0) S USRX=$G(^TMP("USRMMBR",$J,0)),USRCLASS=$P(USRX,U,2) "RTN","USRMLST",53,0) S TITLE=USRCLASS_"s" "RTN","USRMLST",54,0) S USRCNT=$J(+USRX,4)_" Member"_$S(+USRX=1:"",1:"s") "RTN","USRMLST",55,0) S VALMHDR(1)=$$CENTER^USRLS(TITLE) "RTN","USRMLST",56,0) S VALMHDR(1)=$$SETSTR^VALM1(USRCNT,VALMHDR(1),(IOM-$L(USRCNT)),$L(USRCNT)) "RTN","USRMLST",57,0) Q "RTN","USRMLST",58,0) CLEAN ; "Joel...Clean up your mess!" "RTN","USRMLST",59,0) K ^TMP("USRMMBR",$J),^TMP("USRMMBRIDX",$J),^TMP("USRM",$J) "RTN","USRMLST",60,0) Q "RTN","USRP3INI") 0^^B188999 "RTN","USRP3INI",1,0) USRP3INI ; SLC/PKR - Inits for patch USR*1.0*3 ;5/06/1998 "RTN","USRP3INI",2,0) ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3**;Jun 20, 1997 "RTN","USRP3INI",3,0) ;====================================================================== "RTN","USRP3INI",4,0) POST ;Patch USR*1.0*2 post-inits. "RTN","USRP3INI",5,0) D XREF "RTN","USRP3INI",6,0) Q "RTN","USRP3INI",7,0) ; "RTN","USRP3INI",8,0) ;====================================================================== "RTN","USRP3INI",9,0) XREF ;Rebuild the cross-references for file 8930.3. "RTN","USRP3INI",10,0) N DIK "RTN","USRP3INI",11,0) ;First delete all the old cross-references. "RTN","USRP3INI",12,0) K ^USR(8930.3,"ACU") "RTN","USRP3INI",13,0) K ^USR(8930.3,"AUC") "RTN","USRP3INI",14,0) K ^USR(8930.3,"AUHX") "RTN","USRP3INI",15,0) K ^USR(8930.3,"B") "RTN","USRP3INI",16,0) ;Now rebuild them. "RTN","USRP3INI",17,0) S DIK="^USR(8930.3," "RTN","USRP3INI",18,0) D IXALL^DIK "RTN","USRP3INI",19,0) Q "RTN","USRRUL") 0^4^B8593668 "RTN","USRRUL",1,0) USRRUL ; SLC/JER - Business Rule Browser ; 2/9/1998 "RTN","USRRUL",2,0) ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3**;Jun 20, 1997 "RTN","USRRUL",3,0) EN ; -- main entry point for USR RULE BROWSER "RTN","USRRUL",4,0) D EN^VALM("USR RULE BROWSER") "RTN","USRRUL",5,0) Q "RTN","USRRUL",6,0) ; "RTN","USRRUL",7,0) HDR ; -- header code "RTN","USRRUL",8,0) N USRCNT S USRCNT=$P(@VALMAR@(0),U,5)_" Rule" "RTN","USRRUL",9,0) S:+USRCNT'=1 USRCNT=USRCNT_"s" "RTN","USRRUL",10,0) S VALMHDR(1)=$$CENTER^USRLS("List Business Rules by "_$P(@VALMAR@(0),U,3)) "RTN","USRRUL",11,0) S VALMHDR(1)=$$SETSTR^VALM1(USRCNT,VALMHDR(1),(IOM-$L(USRCNT)),$L(USRCNT)) "RTN","USRRUL",12,0) S VALMHDR(2)=$$CENTER^USRLS("for "_$P(@VALMAR@(0),U,4)) "RTN","USRRUL",13,0) Q "RTN","USRRUL",14,0) ; "RTN","USRRUL",15,0) INIT ; -- init variables and list array "RTN","USRRUL",16,0) N USRDA,USRCAT,USRXREF,USRVAL,USRCNT,USRPICK "RTN","USRRUL",17,0) D CLEAN^VALM10 "RTN","USRRUL",18,0) S USRPICK=+$O(^ORD(101,"B","USR ACTION SELECT LIST ELEMENT",0)) "RTN","USRRUL",19,0) S (USRDA,USRCNT,VALMCNT)=0,USRCAT=$G(USRRBLD) K USRRBLD "RTN","USRRUL",20,0) S:'+$G(USRCAT) USRCAT=$$SELCAT "RTN","USRRUL",21,0) I +USRCAT'>0 S VALMQUIT=1 Q "RTN","USRRUL",22,0) S USRVAL=$P(USRCAT,U),USRXREF=$P(USRCAT,U,2) "RTN","USRRUL",23,0) F S USRDA=$O(^USR(8930.1,USRXREF,USRVAL,USRDA)) Q:+USRDA'>0 D ADD(USRDA) "RTN","USRRUL",24,0) I 'VALMCNT D "RTN","USRRUL",25,0) . S @VALMAR@(1,0)=" " "RTN","USRRUL",26,0) . S @VALMAR@(2,0)="No Business Rules currently exist for "_$S($P(USRCAT,U,3)'["DOCUMENT":$P(USRCAT,U,3)_" ",1:"")_$P(USRCAT,U,4),VALMCNT=2 "RTN","USRRUL",27,0) S @VALMAR@(0)=USRCAT_U_USRCNT "RTN","USRRUL",28,0) S @VALMAR@("#")=USRPICK_U_"1:"_USRCNT "RTN","USRRUL",29,0) Q "RTN","USRRUL",30,0) ADD(USRDA) ; -- add an element to the list "RTN","USRRUL",31,0) N USRRULE,USRPAD "RTN","USRRUL",32,0) S VALMCNT=+$G(VALMCNT)+1,USRCNT=+$G(USRCNT)+1 "RTN","USRRUL",33,0) D XLATE^USRAEDT(.USRRULE,+USRDA) "RTN","USRRUL",34,0) S $P(USRPAD," ",6-$L(USRCNT))="" "RTN","USRRUL",35,0) D SET^VALM10(VALMCNT,USRCNT_USRPAD_$P(USRRULE,"|"),USRCNT) "RTN","USRRUL",36,0) S @VALMAR@("PICK",USRCNT,VALMCNT)="" "RTN","USRRUL",37,0) S @VALMAR@("INDEX",USRCNT,USRDA)="" "RTN","USRRUL",38,0) I $L(USRRULE,"|")>1 D "RTN","USRRUL",39,0) . N USRI,USRX "RTN","USRRUL",40,0) . F USRI=2:1:$L(USRRULE,"|") D "RTN","USRRUL",41,0) . . S USRX=$P(USRRULE,"|",USRI),VALMCNT=VALMCNT+1 "RTN","USRRUL",42,0) . . D SET^VALM10(VALMCNT," "_USRX,USRCNT) "RTN","USRRUL",43,0) . . S @VALMAR@("PICK",USRCNT,VALMCNT)="" "RTN","USRRUL",44,0) Q "RTN","USRRUL",45,0) ; "RTN","USRRUL",46,0) SELCAT() ; Select search category "RTN","USRRUL",47,0) N DIC,X,Y,USRY "RTN","USRRUL",48,0) S DIC=8930.4,DIC(0)="AEMQZ",DIC("A")="Select SEARCH CATEGORY: " "RTN","USRRUL",49,0) S DIC("B")="DOCUMENT" "RTN","USRRUL",50,0) D ^DIC K DIC "RTN","USRRUL",51,0) I +Y'>0 S USRY=Y G SELX "RTN","USRRUL",52,0) I $G(Y(0))]"" S USRY=$$ASKCAT(+Y,Y(0)) "RTN","USRRUL",53,0) SELX Q USRY "RTN","USRRUL",54,0) ASKCAT(USRCAT,USRX) ; Given a search category, ask its value "RTN","USRRUL",55,0) N DIC,X,Y,USRY "RTN","USRRUL",56,0) S DIC=$P(USRX,U,2),DIC("A")="Select "_$P(USRX,U)_": " "RTN","USRRUL",57,0) I $G(^USR(8930.4,+USRCAT,1))]"" X ^USR(8930.4,+USRCAT,1) "RTN","USRRUL",58,0) S DIC(0)="AEMQZ" D ^DIC K DIC I +Y'>0 S USRY=Y G ASKX "RTN","USRRUL",59,0) S USRY=+Y_U_$P(USRX,U,3)_U_$P(USRX,U)_U_$S($P(USRX,U,2)=8925.1:$$DDHLEV($P(Y(0),U,4)),1:"")_$P(Y,U,2) "RTN","USRRUL",60,0) ASKX Q USRY "RTN","USRRUL",61,0) DDHLEV(USRDTYP) ; External value of Document Definition Type "RTN","USRRUL",62,0) N USRY "RTN","USRRUL",63,0) S USRY=$S(USRDTYP="CL":"CLASS ",USRDTYP="DC":"DOCUMENT CLASS ",USRDTYP="DOC":"TITLE ",1:"") "RTN","USRRUL",64,0) Q $G(USRY) "RTN","USRRUL",65,0) HELP ; -- help code "RTN","USRRUL",66,0) D PROTOCOL^USRHELP "RTN","USRRUL",67,0) Q "RTN","USRRUL",68,0) ; "RTN","USRRUL",69,0) EXIT ; -- exit code "RTN","USRRUL",70,0) D CLEAN^VALM10 "RTN","USRRUL",71,0) Q "RTN","USRRUL",72,0) ; "RTN","USRRUL",73,0) EXPND ; -- expand code "RTN","USRRUL",74,0) Q "RTN","USRRUL",75,0) ; "RTN","USRRULA") 0^16^B12235287 "RTN","USRRULA",1,0) USRRULA ; SLC/JER - Rule Browser actions ;2/6/98 "RTN","USRRULA",2,0) ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3**;Jun 20, 1997 "RTN","USRRULA",3,0) EDIT ; Edit an existing rule "RTN","USRRULA",4,0) N USRDA,USRI,DIROUT,USRCHNG,USRLST,USRRBLD "RTN","USRRULA",5,0) I '$D(VALMY) D EN^VALM2(XQORNOD(0)) "RTN","USRRULA",6,0) S (USRCHNG,USRI)=0 "RTN","USRRULA",7,0) F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT) "RTN","USRRULA",8,0) . S USRDA=+$O(^TMP("USRRUL",$J,"INDEX",USRI,0)) Q:+USRDA'>0 "RTN","USRRULA",9,0) . W !!,"Editing #",+USRI,! "RTN","USRRULA",10,0) . D EDIT1 "RTN","USRRULA",11,0) . I +$G(USRCHNG) S USRLST=$S($L($G(USRLST)):$G(USRLST)_", ",1:"")_USRI "RTN","USRRULA",12,0) W !,"Refreshing the list." "RTN","USRRULA",13,0) I $L($G(USRLST)) D "RTN","USRRULA",14,0) . S USRRBLD=$P($G(@VALMAR@(0)),U,1,4) D INIT^USRRUL,HDR^USRRUL "RTN","USRRULA",15,0) S VALMSG="** "_$S($L($G(USRLST)):"Item"_$S($L($G(USRLST),",")>1:"s ",1:" ")_$G(USRLST),1:"Nothing")_" Edited **" "RTN","USRRULA",16,0) K VALMY S VALMBCK="R" "RTN","USRRULA",17,0) Q "RTN","USRRULA",18,0) EDIT1 ; Single record edit "RTN","USRRULA",19,0) ; Receives USRDA "RTN","USRRULA",20,0) N DA,DIE,DR "RTN","USRRULA",21,0) I '+$G(USRDA) W !,"No Classes selected." H 2 S USRCHNG=0 Q "RTN","USRRULA",22,0) S DIE="^USR(8930.1,",DA=USRDA,DR="[USR DEFINE AUTHORIZATIONS]" "RTN","USRRULA",23,0) D FULL^VALM1,^DIE S USRCHNG=1 "RTN","USRRULA",24,0) I '$D(DA) W !!,"" H 3 Q "RTN","USRRULA",25,0) Q "RTN","USRRULA",26,0) ADD ; Add a member to the class "RTN","USRRULA",27,0) N DA,DR,DIC,DLAYGO,X,Y,USRRBLD,USRCNT D FULL^VALM1 "RTN","USRRULA",28,0) W !,"Please Enter a New Business Rule:",! "RTN","USRRULA",29,0) S (DIC,DLAYGO)=8930.1,DIC(0)="NL",X=$$DOCPICK "RTN","USRRULA",30,0) Q:+X'>0 "RTN","USRRULA",31,0) S X=""""_"`"_+X_"""" "RTN","USRRULA",32,0) D ^DIC K DLAYGO Q:+Y'>0 S DA=+Y "RTN","USRRULA",33,0) S DIE=8930.1,DR="[USR DEFINE AUTHORIZATIONS]" "RTN","USRRULA",34,0) D ^DIE "RTN","USRRULA",35,0) I '$D(DA) S VALMSG="" Q "RTN","USRRULA",36,0) S USRCNT=+$P($G(@VALMAR@(0)),U,5) "RTN","USRRULA",37,0) I +USRCNT D ADD^USRRUL(DA) S $P(@VALMAR@(0),U,5)=+USRCNT D HDR^USRRUL I 1 "RTN","USRRULA",38,0) E S USRRBLD=$P($G(@VALMAR@(0)),U,1,4) D INIT^USRRUL,HDR^USRRUL "RTN","USRRULA",39,0) S USRCNT=+$P($G(@VALMAR@(0)),U,5) "RTN","USRRULA",40,0) S $P(@VALMAR@("#"),":",2)=+USRCNT "RTN","USRRULA",41,0) S VALMSG="** Item "_+USRCNT_" Added **" "RTN","USRRULA",42,0) S USRCHNG=1,VALMBCK="R" "RTN","USRRULA",43,0) Q "RTN","USRRULA",44,0) DOCPICK() ; Function to pick a document for which rule will be created "RTN","USRRULA",45,0) N DIC,X,Y "RTN","USRRULA",46,0) I +$G(^TMP("USRRUL",$J,0)) S DIC("B")=$P($G(^TIU(8925.1,+$G(^TMP("USRRUL",$J,0)),0)),U) "RTN","USRRULA",47,0) S DIC=8925.1,DIC(0)="AEMQ",DIC("A")="Select DOCUMENT DEFINITION: " "RTN","USRRULA",48,0) S DIC("S")="I +$$CANPICK^TIULP(+Y),$S($P($G(^TIU(8925.1,+Y,0)),U,4)=""CO"":0,$P($G(^TIU(8925.1,+Y,0)),U,4)=""O"":0,$P($G(^TIU(8925.1,+Y,0)),U)[""ADDENDUM"":0,1:1)" "RTN","USRRULA",49,0) D ^DIC K DIC("S") "RTN","USRRULA",50,0) Q Y "RTN","USRRULA",51,0) DELETE ; Delete a member to the class "RTN","USRRULA",52,0) N USRDA,USRCHNG,USRI,USRLST,DIE,X,Y,USRRBLD K DIROUT "RTN","USRRULA",53,0) D FULL^VALM1 "RTN","USRRULA",54,0) I '$D(VALMY) D EN^VALM2(XQORNOD(0)) "RTN","USRRULA",55,0) S USRI=0 "RTN","USRRULA",56,0) F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT) "RTN","USRRULA",57,0) . S USRDA=+$O(^TMP("USRRUL",$J,"INDEX",USRI,0)) Q:+USRDA'>0 "RTN","USRRULA",58,0) . W !!,"Deleting #",+USRI,! "RTN","USRRULA",59,0) . D DELETE1(USRDA) "RTN","USRRULA",60,0) . S:+USRCHNG USRLST=$S(+$G(USRLST):USRLST_", ",1:"")_+USRI "RTN","USRRULA",61,0) I +$G(USRLST) D "RTN","USRRULA",62,0) . S USRRBLD=$P($G(@VALMAR@(0)),U,1,4) D INIT^USRRUL,HDR^USRRUL "RTN","USRRULA",63,0) K VALMY S VALMBCK="R" "RTN","USRRULA",64,0) S VALMSG="** "_$S($L($G(USRLST)):"Item"_$S($L($G(USRLST),",")>1:"s ",1:" ")_$G(USRLST),1:"Nothing")_" deleted **" "RTN","USRRULA",65,0) Q "RTN","USRRULA",66,0) DELETE1(DA) ; Delete one member from a class "RTN","USRRULA",67,0) N DIE,DR,USRI,USRULE D XLATE^USRAEDT(.USRULE,+DA) "RTN","USRRULA",68,0) I $G(USRULE)']"" W !,"Record #",DA," NOT FOUND!" Q "RTN","USRRULA",69,0) W !,"Removing the rule:",! "RTN","USRRULA",70,0) F USRI=1:1:$L(USRULE,"|") W !,$P(USRULE,"|",USRI) "RTN","USRRULA",71,0) W ! "RTN","USRRULA",72,0) I '$$READ^USRU("Y","Are you SURE","NO") S USRCHNG=0 W !,"Business Rule NOT Removed." Q "RTN","USRRULA",73,0) W !,"Deleting Business Rule" "RTN","USRRULA",74,0) S USRCHNG=1 "RTN","USRRULA",75,0) S DIK="^USR(8930.1," D ^DIK K DIK W "." "RTN","USRRULA",76,0) Q "RTN","USRU") 0^1^B1811292 "RTN","USRU",1,0) USRU ; SLC/PKR - Utility subroutines for USR ;2/9/98 "RTN","USRU",2,0) ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3**;Jun 20, 1997 "RTN","USRU",3,0) ;====================================================================== "RTN","USRU",4,0) ;This routine is a direct copy from TIUU. "RTN","USRU",5,0) READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN) ; Calls reader, returns response "RTN","USRU",6,0) N DIR,X,Y "RTN","USRU",7,0) S DIR(0)=TYPE "RTN","USRU",8,0) I $D(SCREEN) S DIR("S")=SCREEN "RTN","USRU",9,0) I $G(PROMPT)]"" S DIR("A")=PROMPT "RTN","USRU",10,0) I $G(DEFAULT)]"" S DIR("B")=DEFAULT "RTN","USRU",11,0) I $D(HELP) S DIR("?")=HELP "RTN","USRU",12,0) D ^DIR "RTN","USRU",13,0) I $G(X)="@" S Y="@" G READX "RTN","USRU",14,0) I Y]"",($L($G(Y),U)'=2) S Y=Y_U_$G(Y(0),Y) "RTN","USRU",15,0) READX Q Y "RTN","USRU",16,0) ; "RTN","USRU",17,0) ;====================================================================== "RTN","USRU",18,0) STOP(PROMPT,SCROLL) ; Call DIR at bottom of screen "RTN","USRU",19,0) N DIR,X,Y "RTN","USRU",20,0) I $E(IOST)'="C" S Y="" G STOPX "RTN","USRU",21,0) I +$G(SCROLL),(IOSL>($Y+5)) F W ! Q:IOSL<($Y+6) "RTN","USRU",22,0) S DIR(0)="FO^1:1",DIR("A")=$S($G(PROMPT)]"":PROMPT,1:"Press RETURN to continue or '^' to exit") "RTN","USRU",23,0) S DIR("?")="Enter '^' to quit present action or '^^' to quit to menu" "RTN","USRU",24,0) D ^DIR I $D(DIRUT),(Y="") K DIRUT "RTN","USRU",25,0) S Y=$S(Y="^":0,Y="^^":0,$D(DTOUT):"",Y="":1,1:1_U_Y) "RTN","USRU",26,0) STOPX Q Y "RTN","USRULST") 0^10^B6922025 "RTN","USRULST",1,0) USRULST ; SLC/JER - List Class Membership by user ;2/6/98 "RTN","USRULST",2,0) ;;1.0;AUTHORIZATION/SUBSCRIPTION;**2,3**;Jun 20, 1997 "RTN","USRULST",3,0) MAIN ; Control Branching "RTN","USRULST",4,0) N DIC,X,Y,USRDUZ "RTN","USRULST",5,0) S DIC=200,DIC(0)="AEMQ",DIC("A")="Select USER: " "RTN","USRULST",6,0) D ^DIC Q:+Y'>0 "RTN","USRULST",7,0) S USRDUZ=+Y "RTN","USRULST",8,0) D EN^VALM("USR LIST MEMBERSHIP BY USER") "RTN","USRULST",9,0) Q "RTN","USRULST",10,0) MAKELIST ; Build review screen list "RTN","USRULST",11,0) W !,"Searching for the User Classes." "RTN","USRULST",12,0) D BUILD(USRDUZ) "RTN","USRULST",13,0) Q "RTN","USRULST",14,0) BUILD(USRDUZ) ; Build List "RTN","USRULST",15,0) N USRCNT,USRNAME,USRPICK "RTN","USRULST",16,0) S (USRCNT,VALMCNT)=0 "RTN","USRULST",17,0) S USRPICK=+$O(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0)) "RTN","USRULST",18,0) K ^TMP("USRUSER",$J),^TMP("USRUSERIDX",$J),^TMP("USRU",$J) "RTN","USRULST",19,0) D WHATIS^USRLM(USRDUZ,"^TMP(""USRU"",$J)") "RTN","USRULST",20,0) S USRNAME=0 "RTN","USRULST",21,0) F S USRNAME=$O(^TMP("USRU",$J,USRNAME)) Q:USRNAME="" D "RTN","USRULST",22,0) . N USRDA,USREFF,USREXP,USRMEM,USRREC,USRCLNM "RTN","USRULST",23,0) . S USRMEM=$G(^TMP("USRU",$J,USRNAME)) "RTN","USRULST",24,0) . S USRDA=+$P(USRMEM,U,2),USRSIGNM=$$SIGNAME^USRLS(+USRDUZ) "RTN","USRULST",25,0) . S USRCLNM=$P(USRMEM,U,3) "RTN","USRULST",26,0) . S USREFF=$$DATE^USRLS(+$P(USRMEM,U,4),"MM/DD/YY") "RTN","USRULST",27,0) . S USREXP=$$DATE^USRLS(+$P(USRMEM,U,5),"MM/DD/YY") "RTN","USRULST",28,0) . S USRCNT=+$G(USRCNT)+1 "RTN","USRULST",29,0) . S USRREC=$$SETFLD^VALM1(USRCNT,"","NUMBER") "RTN","USRULST",30,0) . S USRREC=$$SETFLD^VALM1(USRCLNM,USRREC,"CLASS") "RTN","USRULST",31,0) . S USRREC=$$SETFLD^VALM1(USREFF,USRREC,"EFFECTIVE") "RTN","USRULST",32,0) . S USRREC=$$SETFLD^VALM1(USREXP,USRREC,"EXPIRES") "RTN","USRULST",33,0) . S VALMCNT=+$G(VALMCNT)+1 "RTN","USRULST",34,0) . S ^TMP("USRUSER",$J,VALMCNT,0)=USRREC "RTN","USRULST",35,0) . S ^TMP("USRUSER",$J,"IDX",VALMCNT,USRCNT)="" "RTN","USRULST",36,0) . S ^TMP("USRUSERIDX",$J,USRCNT)=VALMCNT_U_USRDA W:VALMCNT#10'>0 "." "RTN","USRULST",37,0) S ^TMP("USRUSER",$J,0)=+$G(USRCNT)_U_$P(^TMP("USRU",$J,0),U,2) "RTN","USRULST",38,0) S ^TMP("USRUSER",$J,"#")=USRPICK_"^0:"_+$G(USRCNT) "RTN","USRULST",39,0) I $D(VALMHDR)>9 D HDR "RTN","USRULST",40,0) I +$G(USRCNT)'>0 D "RTN","USRULST",41,0) . S ^TMP("USRUSER",$J,1,0)="",VALMCNT=2 "RTN","USRULST",42,0) . S ^TMP("USRUSER",$J,2,0)="No Class Memberships found for "_$P(^TMP("USRU",$J,0),U,2) "RTN","USRULST",43,0) Q "RTN","USRULST",44,0) HDR ; Initialize header for review screen "RTN","USRULST",45,0) N BY,USRX,USRCNT,TITLE,USRNAME "RTN","USRULST",46,0) S USRX=$G(^TMP("USRUSER",$J,0)),USRNAME=$P(USRX,U,2) "RTN","USRULST",47,0) S TITLE=USRNAME "RTN","USRULST",48,0) ;==== START USR*1.0*2 PKR ============================================= "RTN","USRULST",49,0) ;If this user has been terminated change the title to reflect this. "RTN","USRULST",50,0) I $$ISTERM^USRLM(USRDUZ) S TITLE=TITLE_" (terminated)" "RTN","USRULST",51,0) ;=== END USR*1.0*2 ==================================================== "RTN","USRULST",52,0) S USRCNT=$J(+USRX,4)_" Class"_$S(+USRX=1:"",1:"es") "RTN","USRULST",53,0) S VALMHDR(1)=$$CENTER^USRLS(TITLE) "RTN","USRULST",54,0) S VALMHDR(1)=$$SETSTR^VALM1(USRCNT,VALMHDR(1),(IOM-$L(USRCNT)),$L(USRCNT)) "RTN","USRULST",55,0) Q "RTN","USRULST",56,0) CLEAN ; "Joel...Clean up your mess!" "RTN","USRULST",57,0) K ^TMP("USRUSER",$J),^TMP("USRUSERIDX",$J),^TMP("USRU",$J) "RTN","USRULST",58,0) Q "RTN","USRUM") 0^5^B1465384 "RTN","USRUM",1,0) USRUM ; SLC/JER - User class membership by User library ;2/6/98 "RTN","USRUM",2,0) ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3**;Jun 20, 1997 "RTN","USRUM",3,0) UPDATE(ITEM) ; Updates list following edit "RTN","USRUM",4,0) N USRDA,USRDUZ,USRSIGNM,USREFF,USREXP,USRMEM,USRREC,USRCLNM "RTN","USRUM",5,0) S USRDA=$P(ITEM,U,2) "RTN","USRUM",6,0) S USRMEM=$G(^USR(8930.3,+USRDA,0)) "RTN","USRUM",7,0) S USRDUZ=+USRMEM,USRSIGNM=$$SIGNAME^USRLS(+USRDUZ) "RTN","USRUM",8,0) S USRCLNM=$$CLNAME^USRLM(+$P(USRMEM,U,2)) "RTN","USRUM",9,0) S USREFF=$$DATE^USRLS(+$P(USRMEM,U,3),"MM/DD/YY") "RTN","USRUM",10,0) S USREXP=$$DATE^USRLS(+$P(USRMEM,U,4),"MM/DD/YY") "RTN","USRUM",11,0) S USRREC=$$SETFLD^VALM1(+ITEM,"","NUMBER") "RTN","USRUM",12,0) S USRREC=$$SETFLD^VALM1(USRCLNM,USRREC,"CLASS") "RTN","USRUM",13,0) S USRREC=$$SETFLD^VALM1(USREFF,USRREC,"EFFECTIVE") "RTN","USRUM",14,0) S USRREC=$$SETFLD^VALM1(USREXP,USRREC,"EXPIRES") "RTN","USRUM",15,0) S ^TMP("USRUSER",$J,+ITEM,0)=USRREC "RTN","USRUM",16,0) D RESTORE^VALM10(+ITEM),CNTRL^VALM10(+ITEM,1,VALM("RM"),IOINHI,IOINORM) "RTN","USRUM",17,0) Q "RTN","USRUMMBR") 0^14^B13626324 "RTN","USRUMMBR",1,0) USRUMMBR ; SLC/JER - User Class Membership by User actions ;2/11/98 "RTN","USRUMMBR",2,0) ;;1.0;AUTHORIZATION/SUBSCRIPTION;**2,3**;Jun 20, 1997 "RTN","USRUMMBR",3,0) EDIT ; Edit user's class membership "RTN","USRUMMBR",4,0) N USRDA,USRDATA,USREXPND,USRI,USRSTAT,DIROUT,USRCHNG,USRLST "RTN","USRUMMBR",5,0) I '$D(VALMY) D EN^VALM2(XQORNOD(0)) "RTN","USRUMMBR",6,0) S (USRCHNG,USRI)=0 "RTN","USRUMMBR",7,0) F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT) "RTN","USRUMMBR",8,0) . S USRDATA=$G(^TMP("USRUSERIDX",$J,USRI)) "RTN","USRUMMBR",9,0) . W !!,"Editing #",+USRDATA,! "RTN","USRUMMBR",10,0) . S USRDA=+$P(USRDATA,U,2) D EDIT1 "RTN","USRUMMBR",11,0) . I +$G(USRCHNG) S USRLST=$S($L($G(USRLST)):$G(USRLST)_", ",1:"")_USRI "RTN","USRUMMBR",12,0) . I $D(USRDATA) D UPDATE^USRUM(USRDATA) "RTN","USRUMMBR",13,0) W !,"Refreshing the list." "RTN","USRUMMBR",14,0) S VALMSG="** "_$S($L($G(USRLST)):"Item"_$S($L($G(USRLST),",")>1:"s ",1:" ")_$G(USRLST),1:"Nothing")_" Edited **" "RTN","USRUMMBR",15,0) K VALMY S VALMBCK="R" "RTN","USRUMMBR",16,0) Q "RTN","USRUMMBR",17,0) EDIT1 ; Single record edit "RTN","USRUMMBR",18,0) ; Receives USRDA "RTN","USRUMMBR",19,0) N DA,DIE,DR "RTN","USRUMMBR",20,0) I '+$G(USRDA) W !,"No Member selected." H 2 S USRCHNG=0 Q "RTN","USRUMMBR",21,0) S DIE="^USR(8930.3,",DA=USRDA,DR="[USR MEMBERSHIP EDIT]" "RTN","USRUMMBR",22,0) D FULL^VALM1,^DIE S USRCHNG=1 "RTN","USRUMMBR",23,0) Q "RTN","USRUMMBR",24,0) ADD ; Add a membership to selected classes for current user "RTN","USRUMMBR",25,0) N DIC,DLAYGO,X,Y,USRCLASS,USRUSER,USRCNT,USRQUIT D FULL^VALM1 "RTN","USRUMMBR",26,0) I $$ISTERM^USRLM(USRDUZ) D Q "RTN","USRUMMBR",27,0) . W !,"You cannot add class memberships, this user is terminated!" "RTN","USRUMMBR",28,0) . H 2 "RTN","USRUMMBR",29,0) S USRCNT=0 "RTN","USRUMMBR",30,0) F D Q:+$G(USRQUIT) "RTN","USRUMMBR",31,0) . W ! "RTN","USRUMMBR",32,0) . S DIC=8930,DIC(0)="AEMQ" "RTN","USRUMMBR",33,0) . S DIC("A")="Select "_$S(USRCNT'>0:"",1:"Another ")_"USER CLASS: " "RTN","USRUMMBR",34,0) . D ^DIC I +Y'>0 S USRQUIT=1 Q "RTN","USRUMMBR",35,0) . S USRCLASS=+Y "RTN","USRUMMBR",36,0) . S DIC=200,DIC(0)="NMX",X="`"_USRDUZ "RTN","USRUMMBR",37,0) . S DIC("S")="I ('$$ISA^USRLM(USRDUZ,USRCLASS))" ;USR*1.0*2 PKR "RTN","USRUMMBR",38,0) . D ^DIC I +Y'>0 S USRQUIT=1 Q "RTN","USRUMMBR",39,0) . S (DIC,DLAYGO)=8930.3,DIC(0)="LM",X=""""_$P(Y,U,2)_"""" "RTN","USRUMMBR",40,0) . D ^DIC I +Y'>0 S USRQUIT=1 Q "RTN","USRUMMBR",41,0) . S USRCREAT=+$P(Y,U,3),USRCNT=USRCNT+1 "RTN","USRUMMBR",42,0) . S DA=+Y,DIE=DIC,DIE("NO^")="BACK",DR="[USR MEMBERSHIP EDIT]" D ^DIE "RTN","USRUMMBR",43,0) . I $D(Y) D "RTN","USRUMMBR",44,0) . . S DIK=DIC D ^DIK K DIK "RTN","USRUMMBR",45,0) . . S:USRCNT'>1 VALMSG="** Nothing Added **" "RTN","USRUMMBR",46,0) . . S VALMBCK="R",USRQUIT=1 "RTN","USRUMMBR",47,0) . S USRDUZ=+$G(^TMP("USRU",$J,0)) "RTN","USRUMMBR",48,0) . I 'USRCREAT D Q "RTN","USRUMMBR",49,0) . . S:+USRCNT'>1 VALMSG="** Nothing Added **" "RTN","USRUMMBR",50,0) . . S VAMLBCK="R",USRQUIT=1 "RTN","USRUMMBR",51,0) W !,"Rebuilding membership list." "RTN","USRUMMBR",52,0) D BUILD^USRULST(USRDUZ) "RTN","USRUMMBR",53,0) I USRCNT'>1,+$G(DA) D "RTN","USRUMMBR",54,0) . S USRUSER=$$SIGNAME^USRLS(+$G(USRDUZ)) "RTN","USRUMMBR",55,0) . S USRCLASS=$$CLNAME^USRLM(+$P($G(^USR(8930.3,+DA,0)),U,2)) "RTN","USRUMMBR",56,0) . S VALMSG="** "_USRUSER_" Added to "_USRCLASS_" **" "RTN","USRUMMBR",57,0) S VALMCNT=+$G(@VALMAR@(0)) "RTN","USRUMMBR",58,0) S VALMBCK="R" "RTN","USRUMMBR",59,0) Q "RTN","USRUMMBR",60,0) DELETE ; Delete a member to the class "RTN","USRUMMBR",61,0) N DIE,X,Y,USRCLASS D FULL^VALM1 "RTN","USRUMMBR",62,0) N USRCLASS,USRDA,USRCHNG,USRDATA,USRI,USRLST,DIROUT "RTN","USRUMMBR",63,0) I '$D(VALMY) D EN^VALM2(XQORNOD(0)) "RTN","USRUMMBR",64,0) S USRI=0 "RTN","USRUMMBR",65,0) F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT) "RTN","USRUMMBR",66,0) . S USRDATA=$G(^TMP("USRUSERIDX",$J,USRI)) "RTN","USRUMMBR",67,0) . S USRDA=+$P(USRDATA,U,2) D DELETE1(USRDA) "RTN","USRUMMBR",68,0) . S:+USRCHNG USRLST=$S(+$G(USRLST):USRLST_", ",1:"")_+USRDATA "RTN","USRUMMBR",69,0) . I $D(USRDATA) D UPDATE^USRUM(USRDATA) "RTN","USRUMMBR",70,0) W !,"Rebuilding the list." "RTN","USRUMMBR",71,0) S USRCLASS=+$G(^TMP("USRU",$J,0)) "RTN","USRUMMBR",72,0) D BUILD^USRULST(USRDUZ) "RTN","USRUMMBR",73,0) S VALMCNT=+$G(@VALMAR@(0)) "RTN","USRUMMBR",74,0) K VALMY S VALMBCK="R" "RTN","USRUMMBR",75,0) S VALMSG="** "_$S($L($G(USRLST)):"Item"_$S($L($G(USRLST),",")>1:"s ",1:" ")_$G(USRLST),1:"Nothing")_" removed **" "RTN","USRUMMBR",76,0) Q "RTN","USRUMMBR",77,0) DELETE1(DA) ; Delete one member from a class "RTN","USRUMMBR",78,0) N DIE,DR,USER,CLASS,USRMEM S USRMEM=$G(^USR(8930.3,+DA,0)) "RTN","USRUMMBR",79,0) I USRMEM']"" W !,"Record #",DA," NOT FOUND!" Q "RTN","USRUMMBR",80,0) S USER=$P($G(^VA(200,+USRMEM,0)),U) "RTN","USRUMMBR",81,0) S CLASS=$P($G(^USR(8930,+$P(USRMEM,U,2),0)),U) "RTN","USRUMMBR",82,0) W !,"Removing ",USER," from ",CLASS "RTN","USRUMMBR",83,0) I '$$READ^USRU("Y","Are you SURE","NO") S USRCHNG=0 W !,USER," NOT Removed from ",CLASS,"." H 2 Q "RTN","USRUMMBR",84,0) S USRCHNG=1 "RTN","USRUMMBR",85,0) S DIK="^USR(8930.3," D ^DIK W "." "RTN","USRUMMBR",86,0) Q "VER") 8.0^21.0 "^DD",8930.3,8930.3,.01,0) MEMBER^RP200'^VA(200,^0;1^Q "^DD",8930.3,8930.3,.01,.1) NEW PERSON NAME "^DD",8930.3,8930.3,.01,1,0) ^.1 "^DD",8930.3,8930.3,.01,1,1,0) 8930.3^B "^DD",8930.3,8930.3,.01,1,1,1) S ^USR(8930.3,"B",$E(X,1,30),DA)="" "^DD",8930.3,8930.3,.01,1,1,2) K ^USR(8930.3,"B",$E(X,1,30),DA) "^DD",8930.3,8930.3,.01,1,2,0) 8930.3^AUC^MUMPS "^DD",8930.3,8930.3,.01,1,2,1) I +$P(^USR(8930.3,+DA,0),U,2) S ^USR(8930.3,"AUC",+X,+$P(^USR(8930.3,+DA,0),U,2),+DA)="" "^DD",8930.3,8930.3,.01,1,2,2) I +$P(^USR(8930.3,+DA,0),U,2) K ^USR(8930.3,"AUC",+X,+$P(^USR(8930.3,+DA,0),U,2),+DA) "^DD",8930.3,8930.3,.01,1,2,"%D",0) ^^2^2^2980506^^^^ "^DD",8930.3,8930.3,.01,1,2,"%D",1,0) This Multi-field, MUMPS type cross-reference on Person and User Class will "^DD",8930.3,8930.3,.01,1,2,"%D",2,0) help to identify the classes to which a given person belongs. "^DD",8930.3,8930.3,.01,1,2,"DT") 2980506 "^DD",8930.3,8930.3,.01,1,3,0) 8930.3^ACU^MUMPS "^DD",8930.3,8930.3,.01,1,3,1) I +$P(^USR(8930.3,+DA,0),U,2) S ^USR(8930.3,"ACU",+$P(^USR(8930.3,+DA,0),U,2),+X,+DA)="" "^DD",8930.3,8930.3,.01,1,3,2) I +$P(^USR(8930.3,+DA,0),U,2) K ^USR(8930.3,"ACU",+$P(^USR(8930.3,+DA,0),U,2),+X,+DA) "^DD",8930.3,8930.3,.01,1,3,"%D",0) ^^2^2^2980506^^^^ "^DD",8930.3,8930.3,.01,1,3,"%D",1,0) This multi-field, MUMPS-type cross-reference by User Class and person will "^DD",8930.3,8930.3,.01,1,3,"%D",2,0) help to identify the members of a particular class. "^DD",8930.3,8930.3,.01,1,3,"DT") 2980506 "^DD",8930.3,8930.3,.01,1,4,0) 8930.3^AUHX^MUMPS "^DD",8930.3,8930.3,.01,1,4,1) I +$P($G(^USR(8930.3,+DA,0)),U,2) S ^USR(8930.3,"AUHX",+X,+$P(^USR(8930.3,+DA,0),U,2),+$P(^USR(8930.3,+DA,0),U,3),+DA)="" "^DD",8930.3,8930.3,.01,1,4,2) I +$P($G(^USR(8930.3,+DA,0)),U,2) K ^USR(8930.3,"AUHX",+X,+$P(^USR(8930.3,+DA,0),U,2),+$P(^USR(8930.3,+DA,0),U,3),+DA) "^DD",8930.3,8930.3,.01,1,4,"%D",0) ^^3^3^2950523^ "^DD",8930.3,8930.3,.01,1,4,"%D",1,0) This Multi-field, MUMPS type cross-reference on Person, User Class, and "^DD",8930.3,8930.3,.01,1,4,"%D",2,0) EFFECTIVE DATE will help to list the history of a given user's membership "^DD",8930.3,8930.3,.01,1,4,"%D",3,0) in various classes. "^DD",8930.3,8930.3,.01,1,4,"DT") 2950523 "^DD",8930.3,8930.3,.01,3) Select a User Class member. "^DD",8930.3,8930.3,.01,21,0) ^^2^2^2950515^ "^DD",8930.3,8930.3,.01,21,1,0) This is the name of the person to whom membership in a given User Class is "^DD",8930.3,8930.3,.01,21,2,0) being ascribed. "^DD",8930.3,8930.3,.01,"DT") 2980506 "^DD",8930.3,8930.3,.02,0) USER CLASS^P8930'^USR(8930,^0;2^Q "^DD",8930.3,8930.3,.02,1,0) ^.1 "^DD",8930.3,8930.3,.02,1,1,0) 8930.3^AUC1^MUMPS "^DD",8930.3,8930.3,.02,1,1,1) I +$G(^USR(8930.3,+DA,0)) S ^USR(8930.3,"AUC",+$G(^USR(8930.3,+DA,0)),+X,+DA)="" "^DD",8930.3,8930.3,.02,1,1,2) I +$G(^USR(8930.3,+DA,0)) K ^USR(8930.3,"AUC",+$G(^USR(8930.3,+DA,0)),+X,+DA) "^DD",8930.3,8930.3,.02,1,1,"%D",0) ^^2^2^2980506^^^^ "^DD",8930.3,8930.3,.02,1,1,"%D",1,0) This Multi-field, MUMPS type cross-reference on Person and User Class help "^DD",8930.3,8930.3,.02,1,1,"%D",2,0) to identify the classes to which a given person belongs. "^DD",8930.3,8930.3,.02,1,1,"DT") 2980506 "^DD",8930.3,8930.3,.02,1,2,0) 8930.3^ACU1^MUMPS "^DD",8930.3,8930.3,.02,1,2,1) I +$G(^USR(8930.3,+DA,0)) S ^USR(8930.3,"ACU",+X,+$G(^USR(8930.3,+DA,0)),+DA)="" "^DD",8930.3,8930.3,.02,1,2,2) I +$G(^USR(8930.3,+DA,0)) K ^USR(8930.3,"ACU",+X,+$G(^USR(8930.3,+DA,0)),+DA) "^DD",8930.3,8930.3,.02,1,2,"%D",0) ^^2^2^2980506^^^^ "^DD",8930.3,8930.3,.02,1,2,"%D",1,0) This multi-field, MUMPS-type cross-reference by User Class and person will help "^DD",8930.3,8930.3,.02,1,2,"%D",2,0) to identify the members of a particular User Class. "^DD",8930.3,8930.3,.02,1,2,"DT") 2980506 "^DD",8930.3,8930.3,.02,1,3,0) 8930.3^AUHX1^MUMPS "^DD",8930.3,8930.3,.02,1,3,1) I +$P($G(^USR(8930.3,+DA,0)),U) S ^USR(8930.3,"AUHX",+$P($G(^USR(8930.3,+DA,0)),U),+X,+$P(^USR(8930.3,+DA,0),U,3),+DA)="" "^DD",8930.3,8930.3,.02,1,3,2) I +$P($G(^USR(8930.3,+DA,0)),U) K ^USR(8930.3,"AUHX",+$P($G(^USR(8930.3,+DA,0)),U),+X,+$P(^USR(8930.3,+DA,0),U,3),+DA) "^DD",8930.3,8930.3,.02,1,3,"%D",0) ^^3^3^2950523^ "^DD",8930.3,8930.3,.02,1,3,"%D",1,0) This Multi-field, MUMPS type cross-reference on Person, User Class, and "^DD",8930.3,8930.3,.02,1,3,"%D",2,0) EFFECTIVE DATE will help to list the history of a given user's membership "^DD",8930.3,8930.3,.02,1,3,"%D",3,0) in various classes. "^DD",8930.3,8930.3,.02,1,3,"DT") 2950523 "^DD",8930.3,8930.3,.02,3) Enter the User Class to which the User is being given membership. "^DD",8930.3,8930.3,.02,21,0) ^^2^2^2950515^ "^DD",8930.3,8930.3,.02,21,1,0) This is the User Class to which the User in question is being grated "^DD",8930.3,8930.3,.02,21,2,0) membership. "^DD",8930.3,8930.3,.02,"DT") 2980506 **END** **END**