Released USR*1*28 SEQ #29 Extracted from mail message **KIDS**:USR*1.0*28^ **INSTALL NAME** USR*1.0*28 "BLD",6544,0) USR*1.0*28^AUTHORIZATION/SUBSCRIPTION^0^3060511^y "BLD",6544,1,0) ^^11^11^3060509^^^ "BLD",6544,1,1,0) This patch corrects three issues with MEMBERHSIP by USER and USER CLASS. "BLD",6544,1,2,0) "BLD",6544,1,3,0) "BLD",6544,1,4,0) Issue #1-- When looking at Manage Business Rules you will notice "BLD",6544,1,5,0) when you hit "Add Rule" selection, notice the system defaults to "BLD",6544,1,6,0) a TIU Object / TITLE when nothing was selected. "BLD",6544,1,7,0) "BLD",6544,1,8,0) Issue #2-- In "List Membership by User" the dates are "BLD",6544,1,9,0) list from most current to oldest. "BLD",6544,1,10,0) In "List Membership by Class" only the Expired "BLD",6544,1,11,0) Member listed, not the Active Member. "BLD",6544,4,0) ^9.64PA^^ "BLD",6544,"ABPKG") n "BLD",6544,"KRN",0) ^9.67PA^8989.52^19 "BLD",6544,"KRN",.4,0) .4 "BLD",6544,"KRN",.4,"NM",0) ^9.68A^^ "BLD",6544,"KRN",.401,0) .401 "BLD",6544,"KRN",.401,"NM",0) ^9.68A^^ "BLD",6544,"KRN",.402,0) .402 "BLD",6544,"KRN",.403,0) .403 "BLD",6544,"KRN",.5,0) .5 "BLD",6544,"KRN",.84,0) .84 "BLD",6544,"KRN",3.6,0) 3.6 "BLD",6544,"KRN",3.8,0) 3.8 "BLD",6544,"KRN",9.2,0) 9.2 "BLD",6544,"KRN",9.8,0) 9.8 "BLD",6544,"KRN",9.8,"NM",0) ^9.68A^3^3 "BLD",6544,"KRN",9.8,"NM",1,0) USRRULA^^0^B11780179 "BLD",6544,"KRN",9.8,"NM",2,0) USRLM^^0^B62037293 "BLD",6544,"KRN",9.8,"NM",3,0) USRULST^^0^B9210791 "BLD",6544,"KRN",9.8,"NM","B","USRLM",2) "BLD",6544,"KRN",9.8,"NM","B","USRRULA",1) "BLD",6544,"KRN",9.8,"NM","B","USRULST",3) "BLD",6544,"KRN",19,0) 19 "BLD",6544,"KRN",19,"NM",0) ^9.68A^^ "BLD",6544,"KRN",19.1,0) 19.1 "BLD",6544,"KRN",101,0) 101 "BLD",6544,"KRN",409.61,0) 409.61 "BLD",6544,"KRN",771,0) 771 "BLD",6544,"KRN",870,0) 870 "BLD",6544,"KRN",8989.51,0) 8989.51 "BLD",6544,"KRN",8989.52,0) 8989.52 "BLD",6544,"KRN",8994,0) 8994 "BLD",6544,"KRN","B",.4,.4) "BLD",6544,"KRN","B",.401,.401) "BLD",6544,"KRN","B",.402,.402) "BLD",6544,"KRN","B",.403,.403) "BLD",6544,"KRN","B",.5,.5) "BLD",6544,"KRN","B",.84,.84) "BLD",6544,"KRN","B",3.6,3.6) "BLD",6544,"KRN","B",3.8,3.8) "BLD",6544,"KRN","B",9.2,9.2) "BLD",6544,"KRN","B",9.8,9.8) "BLD",6544,"KRN","B",19,19) "BLD",6544,"KRN","B",19.1,19.1) "BLD",6544,"KRN","B",101,101) "BLD",6544,"KRN","B",409.61,409.61) "BLD",6544,"KRN","B",771,771) "BLD",6544,"KRN","B",870,870) "BLD",6544,"KRN","B",8989.51,8989.51) "BLD",6544,"KRN","B",8989.52,8989.52) "BLD",6544,"KRN","B",8994,8994) "BLD",6544,"QUES",0) ^9.62^^ "BLD",6544,"REQB",0) ^9.611^3^2 "BLD",6544,"REQB",2,0) USR*1.0*22^2 "BLD",6544,"REQB",3,0) USR*1.0*25^2 "BLD",6544,"REQB","B","USR*1.0*22",2) "BLD",6544,"REQB","B","USR*1.0*25",3) "MBREQ") 0 "PKG",469,-1) 1^1 "PKG",469,0) AUTHORIZATION/SUBSCRIPTION^USR^User Authorization "PKG",469,20,0) ^9.402P^^ "PKG",469,22,0) ^9.49I^1^1 "PKG",469,22,1,0) 1.0^2970620^3010628^66481 "PKG",469,22,1,"PAH",1,0) 28^3060511 "PKG",469,22,1,"PAH",1,1,0) ^^11^11^3060511 "PKG",469,22,1,"PAH",1,1,1,0) This patch corrects three issues with MEMBERHSIP by USER and USER CLASS. "PKG",469,22,1,"PAH",1,1,2,0) "PKG",469,22,1,"PAH",1,1,3,0) "PKG",469,22,1,"PAH",1,1,4,0) Issue #1-- When looking at Manage Business Rules you will notice "PKG",469,22,1,"PAH",1,1,5,0) when you hit "Add Rule" selection, notice the system defaults to "PKG",469,22,1,"PAH",1,1,6,0) a TIU Object / TITLE when nothing was selected. "PKG",469,22,1,"PAH",1,1,7,0) "PKG",469,22,1,"PAH",1,1,8,0) Issue #2-- In "List Membership by User" the dates are "PKG",469,22,1,"PAH",1,1,9,0) list from most current to oldest. "PKG",469,22,1,"PAH",1,1,10,0) In "List Membership by Class" only the Expired "PKG",469,22,1,"PAH",1,1,11,0) Member listed, not the Active Member. "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","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") YES "QUES","XPI1","M") D XPI1^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","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") YES "QUES","XPO1","M") D XPO1^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") 3 "RTN","USRLM") 0^2^B62037293^B43938978 "RTN","USRLM",1,0) USRLM ; SLC/JER - User Class Membership functions and proc's ; Jan 1, 2004 "RTN","USRLM",2,0) ;;1.0;AUTHORIZATION/SUBSCRIPTION;**2,3,6,7,8,13,16,25,28**;Jun 20, 1997 "RTN","USRLM",3,0) ; 15 Dec 99 MA - Modified entry point TERM "RTN","USRLM",4,0) ; 14 Feb 00 MA - Add check to verify that x-ref AUC has valid 0 node. "RTN","USRLM",5,0) ; 27 Jun 00 MA - Changed WHOIS to build array in alphabetical order "RTN","USRLM",6,0) ; by subscriber name. "RTN","USRLM",7,0) ISA(USER,CLASS,ERR,USRDT) ; Boolean - Is USER a Member of CLASS? "RTN","USRLM",8,0) N USRY,USRI "RTN","USRLM",9,0) I $S(CLASS="USER":1,CLASS=+$O(^USR(8930,"B","USER",0)):1,1:0) S USRY=1 G ISAX "RTN","USRLM",10,0) I '+USER S USER=+$O(^VA(200,"B",USER,0)) "RTN","USRLM",11,0) I +USER'>0 S ERR="INVALID USER" Q 0 "RTN","USRLM",12,0) I '+CLASS S CLASS=+$O(^USR(8930,"B",CLASS,0)) "RTN","USRLM",13,0) I +CLASS'>0 S ERR="INVALID USER CLASS" Q 0 "RTN","USRLM",14,0) ; If USER is a member of CLASS return true "RTN","USRLM",15,0) S USRY=0 "RTN","USRLM",16,0) I +$D(^USR(8930.3,"AUC",USER,CLASS)) D "RTN","USRLM",17,0) . N USRMDA "RTN","USRLM",18,0) . S USRMDA=0 "RTN","USRLM",19,0) . F S USRMDA=+$O(^USR(8930.3,"AUC",USER,CLASS,USRMDA)) Q:((+USRMDA'>0)!(USRY)) D "RTN","USRLM",20,0) .. S USRY=+$$CURRENT(USRMDA,$G(USRDT)) "RTN","USRLM",21,0) I USRY Q USRY "RTN","USRLM",22,0) ; Otherwise, check to see if user is a member of any subclass of CLASS "RTN","USRLM",23,0) S USRI=0 "RTN","USRLM",24,0) F S USRI=$O(^USR(8930,+CLASS,1,USRI)) Q:+USRI'>0!+$G(USRY) D "RTN","USRLM",25,0) . N USRSUB S USRSUB=+$G(^USR(8930,+CLASS,1,USRI,0)) Q:+USRSUB'>0 "RTN","USRLM",26,0) . S USRY=$$ISA(USER,USRSUB,,+$G(USRDT)) ; Recurs to find members of subclass "RTN","USRLM",27,0) ISAX Q +$G(USRY) "RTN","USRLM",28,0) ;====================================================================== "RTN","USRLM",29,0) ISAWM(USER,CLASS) ; Boolean - Is USER a Member of CLASS, with message. "RTN","USRLM",30,0) I $$ISA(USER,CLASS) D Q 1 "RTN","USRLM",31,0) . W !,"Already a member of this class" "RTN","USRLM",32,0) . H 2 "RTN","USRLM",33,0) E Q 0 "RTN","USRLM",34,0) ; "RTN","USRLM",35,0) ;====================================================================== "RTN","USRLM",36,0) CURRENT(MEMBER,USRDT) ; Boolean - Is Membership current? "RTN","USRLM",37,0) N USRIN,USROUT,USRY "RTN","USRLM",38,0) I +$G(USRDT)'>0 S USRDT=DT "RTN","USRLM",39,0) S USRIN=+$P($G(^USR(8930.3,+MEMBER,0)),U,3) "RTN","USRLM",40,0) S USROUT=+$P($G(^USR(8930.3,+MEMBER,0)),U,4) "RTN","USRLM",41,0) I USRIN'>USRDT,$S(USROUT>0&(USROUT'0) D "RTN","USRLM",57,0) . I TERMDATE<$$NOW^XLFDT S TERM=1 "RTN","USRLM",58,0) Q TERM "RTN","USRLM",59,0) ; "RTN","USRLM",60,0) ;====================================================================== "RTN","USRLM",61,0) RESIZE(LONG,SHORT,SHRINK) ; Resizes list area "RTN","USRLM",62,0) N USRBM S USRBM=$S(VALMMENU:SHORT,+$G(SHRINK):SHORT,1:LONG) "RTN","USRLM",63,0) I VALM("BM")'=USRBM S VALMBCK="R" D "RTN","USRLM",64,0) . S VALM("BM")=USRBM,VALM("LINES")=(USRBM-VALM("TM"))+1 "RTN","USRLM",65,0) . I +$G(VALMCC) D RESET^VALM4 "RTN","USRLM",66,0) Q "RTN","USRLM",67,0) ;====================================================================== "RTN","USRLM",68,0) TERM ;Actions to be taken when a user is terminated. Invoked by "RTN","USRLM",69,0) ;XU USER TERMINATE. XUIFN is the user being terminated. "RTN","USRLM",70,0) ;15 DEC 99 MA - Replaced $$NOW^XLFDT with DT. Piece 4 does "RTN","USRLM",71,0) ;not need the time. Piece 4 is date only. "RTN","USRLM",72,0) N IND,OLDTERM,NOW "RTN","USRLM",73,0) S NOW=DT "RTN","USRLM",74,0) S IND="" "RTN","USRLM",75,0) F S IND=$O(^USR(8930.3,"B",XUIFN,IND)) Q:IND="" D "RTN","USRLM",76,0) . S OLDTERM=+$P($G(^USR(8930.3,IND,0)),U,4) "RTN","USRLM",77,0) . I (OLDTERM>0)&(OLDTERM0 D "RTN","USRLM",90,0) . S USRDA="" "RTN","USRLM",91,0) . F S USRDA=$O(^USR(8930.3,"ACU",CLASS,USER,USRDA)) Q:USRDA="" D "RTN","USRLM",92,0) .. S EFFCTV=$P($G(^USR(8930.3,+USRDA,0)),U,3) S:EFFCTV="" EFFCTV1="0000000" "RTN","USRLM",93,0) .. S EXPIRES=$P($G(^USR(8930.3,+USRDA,0)),U,4) S:EXPIRES="" EXPIRES1=9999999 "RTN","USRLM",94,0) .. S USRCLNM=$$CLNAME(+CLASS) "RTN","USRLM",95,0) .. S USRNAME=$$GET1^DIQ(200,USER,.01) "RTN","USRLM",96,0) .. S ^TMP("USRWHOIS",$J,USRNAME,$S(EFFCTV="":EFFCTV1,1:EFFCTV),$S(EXPIRES="":EXPIRES1,1:EXPIRES))=USER_U_USRDA_U_USRCLNM_U_EFFCTV_U_EXPIRES "RTN","USRLM",97,0) .. S USRCNT=+$G(USRCNT)+1 "RTN","USRLM",98,0) I $D(^TMP("USRWHOIS",$J)) D "RTN","USRLM",99,0) . S USRNAME="" F S USRNAME=$O(^TMP("USRWHOIS",$J,USRNAME)) Q:USRNAME="" D "RTN","USRLM",100,0) .. S EFFCTV="" F S EFFCTV=$O(^TMP("USRWHOIS",$J,USRNAME,EFFCTV)) Q:EFFCTV="" Q:EFFCTV>DT D "RTN","USRLM",101,0) ... S EXPIRES="" F S EXPIRES=$O(^TMP("USRWHOIS",$J,USRNAME,EFFCTV,EXPIRES),-1) Q:EXPIRES="" Q:EXPIRES
0 D "RTN","USRLM",106,0) . N USRSUB S USRSUB=+$G(^USR(8930,+CLASS,1,USRI,0)) Q:+USRSUB'>0 "RTN","USRLM",107,0) . D WHOIS(MEMBER,USRSUB) ; Recurs to find members of subclass "RTN","USRLM",108,0) K ^TMP("USRWHOIS",$J) "RTN","USRLM",109,0) Q "RTN","USRLM",110,0) WHOIS2(MEMBER,CLASS) ; Given a Class, return list of CURRENT members "RTN","USRLM",111,0) ; CLASS is pointer to file 8930 "RTN","USRLM",112,0) ; MEMBER is name of array (local or global) in which members are "RTN","USRLM",113,0) ; returned in alphabetical order by name - indexed by number "RTN","USRLM",114,0) ; i.e. @MEMBER@(1 ...n) "RTN","USRLM",115,0) ; @member@(0) = ien of8930^usr class name^count of members "RTN","USRLM",116,0) ; @member@(1..n)= "RTN","USRLM",117,0) ; 1 2 3 4 5 6 7 8 "RTN","USRLM",118,0) ; p200^p8930.3^classname^effectdate^inactdate^username^title^mailcode "RTN","USRLM",119,0) ; Note: For pieces 2,4 & 5 - Only one of potentially many is returned "RTN","USRLM",120,0) ; "RTN","USRLM",121,0) N USER,USRNM,USRCLNM,USRCNT,USRDA,USRNDX,EFFCTV,EXPIRES,USRI "RTN","USRLM",122,0) D WHOISTMP(.CLASS) "RTN","USRLM",123,0) S USRNM="",USRNDX=0 "RTN","USRLM",124,0) F S USRNM=$O(^TMP($J,"USRWHO2","B",USRNM)) Q:USRNM']"" D "RTN","USRLM",125,0) . S USER=0 F S USER=$O(^TMP($J,"USRWHO2","B",USRNM,USER)) Q:'USER D "RTN","USRLM",126,0) . . S USRNDX=USRNDX+1 "RTN","USRLM",127,0) . . S @MEMBER@(USRNDX)=^TMP($J,"USRWHO2",USER) "RTN","USRLM",128,0) S @MEMBER@(0)=^TMP($J,"USRWHO2",0) "RTN","USRLM",129,0) S $P(@MEMBER@(0),U,3)=USRNDX "RTN","USRLM",130,0) K ^TMP($J,"USRWHO2") "RTN","USRLM",131,0) Q "RTN","USRLM",132,0) WHOISTMP(CLASS) ; Given a Class, return list of CURRENT members into ^TMP "RTN","USRLM",133,0) ; CLASS is pointer to file 8930 "RTN","USRLM",134,0) ; MEMBER is name of array (local or global) in which members are "RTN","USRLM",135,0) ; returned in order by user/x-ref by name "RTN","USRLM",136,0) ; main = ^tmp($j,"USRWHO2",user) "RTN","USRLM",137,0) ; x-ref= ^tmp($j,"USRWHO2","b",usrnm,user) "RTN","USRLM",138,0) ; -- used by whois2 call "RTN","USRLM",139,0) N USER,USRNM,USRCLNM,USRCNT,USRDA,EFFCTV,EXPIRES,USRI,USRMC,USRTIT,USRX "RTN","USRLM",140,0) S USER=0,USRCNT=+$P($G(@MEMBER@(0)),U,3) "RTN","USRLM",141,0) F S USER=$O(^USR(8930.3,"ACU",CLASS,USER)) Q:+USER'>0 D "RTN","USRLM",142,0) . S USRDA=$O(^USR(8930.3,"ACU",CLASS,USER,0)) Q:+USRDA'>0 "RTN","USRLM",143,0) . S EFFCTV=$P($G(^USR(8930.3,+USRDA,0)),U,3) "RTN","USRLM",144,0) . S EXPIRES=$P($G(^USR(8930.3,+USRDA,0)),U,4) "RTN","USRLM",145,0) . S USRNM=$P($G(^VA(200,+USER,0)),U) "RTN","USRLM",146,0) . S USRX=$P($G(^VA(200,+USER,0)),U,9) "RTN","USRLM",147,0) . S USRTIT=$$EXTERNAL^DILFD(200,8,"",USRX) "RTN","USRLM",148,0) . S USRMC=$P($G(^VA(200,+USER,5)),U,2) "RTN","USRLM",149,0) . S USRCLNM=$$CLNAME(+CLASS) "RTN","USRLM",150,0) . S ^TMP($J,"USRWHO2",USER)=USER_U_USRDA_U_USRCLNM_U_EFFCTV_U_EXPIRES_U_USRNM_U_USRTIT_U_USRMC "RTN","USRLM",151,0) . S ^TMP($J,"USRWHO2","B",USRNM,USER)="" "RTN","USRLM",152,0) . S USRCNT=+$G(USRCNT)+1 "RTN","USRLM",153,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",154,0) S $P(^TMP($J,"USRWHO2",0),U,3)=USRCNT "RTN","USRLM",155,0) S USRI=0 F S USRI=$O(^USR(8930,+CLASS,1,USRI)) Q:+USRI'>0 D "RTN","USRLM",156,0) . N USRSUB S USRSUB=+$G(^USR(8930,+CLASS,1,USRI,0)) Q:+USRSUB'>0 "RTN","USRLM",157,0) . D WHOISTMP(USRSUB) ; Recurs to find members of subclass "RTN","USRLM",158,0) Q "RTN","USRLM",159,0) WHATIS(USER,CLASS) ; Given a User, return list of class memberships "RTN","USRLM",160,0) ; USER is pointer to file 200 "RTN","USRLM",161,0) ; CLASS is name of array (local or global) in which the list of "RTN","USRLM",162,0) ; classes to which the USER belongs will be returned in "RTN","USRLM",163,0) ; alphabetic order by class name "RTN","USRLM",164,0) N IND,GROUP,CLASSNM,CLASSCNT,USRCUR,USRDA,EFFCTV,EXPIRES,EFFCTV1 "RTN","USRLM",165,0) K ^TMP("USRWHATIS",$J) "RTN","USRLM",166,0) S (CLASSCNT,IND,GROUP)=0 "RTN","USRLM",167,0) F S GROUP=$O(^USR(8930.3,"AUC",USER,GROUP)) Q:+GROUP'>0 D "RTN","USRLM",168,0) . S USRDA=0 "RTN","USRLM",169,0) . F S USRDA=$O(^USR(8930.3,"AUC",USER,GROUP,USRDA)) Q:+USRDA'>0 D "RTN","USRLM",170,0) .. S USRCUR="E",EFFCTV1="" "RTN","USRLM",171,0) .. S EFFCTV=$P($G(^USR(8930.3,+USRDA,0)),U,3) S:EFFCTV="" EFFCTV1=DT "RTN","USRLM",172,0) .. S EXPIRES=$P($G(^USR(8930.3,+USRDA,0)),U,4) S:EXPIRES="" EXPIRES=9999999 "RTN","USRLM",173,0) .. I EFFCTV'>DT,EXPIRES'
DT S USRCUR="F" "RTN","USRLM",175,0) .. S CLASSNM=$$CLNAME(+GROUP) "RTN","USRLM",176,0) .. S ^TMP("USRWHATIS",$J,CLASSNM,USRCUR,$S(EFFCTV="":EFFCTV1,1:EFFCTV),EXPIRES)=GROUP_U_USRDA_U_CLASSNM_U_EFFCTV_U_$S(EXPIRES=9999999:"",1:EXPIRES) "RTN","USRLM",177,0) I $D(^TMP("USRWHATIS",$J)) D "RTN","USRLM",178,0) . S CLASSNM="" "RTN","USRLM",179,0) . F S CLASSNM=$O(^TMP("USRWHATIS",$J,CLASSNM)) Q:CLASSNM="" D "RTN","USRLM",180,0) .. F USRCUR="F","E","C" D "RTN","USRLM",181,0) ... S EFFCTV="" "RTN","USRLM",182,0) ... F S EFFCTV=$O(^TMP("USRWHATIS",$J,CLASSNM,USRCUR,EFFCTV)) Q:EFFCTV="" D "RTN","USRLM",183,0) .... S EXPIRES="" "RTN","USRLM",184,0) .... F S EXPIRES=$O(^TMP("USRWHATIS",$J,CLASSNM,USRCUR,EFFCTV,EXPIRES)) Q:EXPIRES="" D "RTN","USRLM",185,0) ..... S IND=IND+1 "RTN","USRLM",186,0) ..... S @CLASS@(CLASSNM_IND)=$G(^TMP("USRWHATIS",$J,CLASSNM,USRCUR,EFFCTV,EXPIRES)) "RTN","USRLM",187,0) ..... S CLASSCNT=+$G(CLASSCNT)+1 "RTN","USRLM",188,0) S @CLASS@(0)=USER_U_$$SIGNAME^USRLS(+USER)_U_CLASSCNT "RTN","USRLM",189,0) K ^TMP("USRWHATIS",$J) "RTN","USRLM",190,0) Q "RTN","USRLM",191,0) CLNAME(CLASS) ; Given a class, return the Display Name "RTN","USRLM",192,0) N USRREC,USRY "RTN","USRLM",193,0) S USRREC=$G(^USR(8930,+CLASS,0)) "RTN","USRLM",194,0) Q $S($P(USRREC,U,4)]"":$P(USRREC,U,4),1:$$MIXED^USRLS($P(USRREC,U))) "RTN","USRLM",195,0) PUT(USER,CLASS) ; Make user a member of a given class "RTN","USRLM",196,0) N DIC,DLAYGO,DA,DR,DIE,X,Y "RTN","USRLM",197,0) S (DIC,DLAYGO)=8930.3,DIC(0)="LXF",X=""""_"`"_USER_"""" D ^DIC Q:+Y'>0 "RTN","USRLM",198,0) S DIE=DIC,DA=+Y,DR=".02///"_CLASS_";.03///"_DT "RTN","USRLM",199,0) D ^DIE "RTN","USRLM",200,0) Q "RTN","USRLM",201,0) SUBCLASS(DA,CLASS) ; Evaluate whether a given USER CLASS is a DESCENDENT "RTN","USRLM",202,0) ; of another class "RTN","USRLM",203,0) ; Receives DA = record # of possible subclass in 8930, and "RTN","USRLM",204,0) ; CLASS = record # of possible descendent class in 8930 "RTN","USRLM",205,0) N USRI,USRY S (USRI,USRY)=0 "RTN","USRLM",206,0) I +$G(DA)'>0 S DA=+$O(^USR(8930,"B",DA,0)) "RTN","USRLM",207,0) I +$G(CLASS)'>0 S CLASS=+$O(^USR(8930,"B",CLASS,0)) "RTN","USRLM",208,0) F S USRI=$O(^USR(8930,"AD",DA,USRI)) Q:+USRI'>0!(USRY=1) D "RTN","USRLM",209,0) . I USRI=CLASS S USRY=1 Q "RTN","USRLM",210,0) . S USRY=$$SUBCLASS(USRI,CLASS) "RTN","USRLM",211,0) Q USRY "RTN","USRLM",212,0) CANDEL(USRCLDA) ; Evaluate whether user can delete a class "RTN","USRLM",213,0) N USRMLST,USRY S USRY=0 "RTN","USRLM",214,0) D WHOIS("USRMLST",USRCLDA) "RTN","USRLM",215,0) I +$P(USRMLST(0),U,3)>0 S USRY=1 W " There are members of the class ",$$CLNAME(USRCLDA) "RTN","USRLM",216,0) Q USRY "RTN","USRRULA") 0^1^B11780179^B12235287 "RTN","USRRULA",1,0) USRRULA ; SLC/JER - Rule Browser actions ;2/6/98 17:12 "RTN","USRRULA",2,0) ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3,28**;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)) "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","USRULST") 0^3^B9210791^B9111009 "RTN","USRULST",1,0) USRULST ; SLC/JER - List Class Membership by user ;9/6/01 14:47 "RTN","USRULST",2,0) ;;1.0;AUTHORIZATION/SUBSCRIPTION;**2,3,4,9,10,16,17,21,22,28**;Jun 20, 1997 "RTN","USRULST",3,0) ; 30 Jun 00 MA - Added MAIN2 to prevent stack overflow "RTN","USRULST",4,0) ; 20 Sep 00 MA - Removed MAIN2 and added GETUSER and chg protocol to "RTN","USRULST",5,0) ; avoid looping through MAIN when doing a "CHANGE VIEW". "RTN","USRULST",6,0) ; 7 Aug 01 MA - Removed line "S USRDUZ=+Y" from line tag GETUSER() "RTN","USRULST",7,0) ; 6 Sep 01 MA - Added line "I +Y>0 S USRDUZ=Y" in GETUSER "RTN","USRULST",8,0) ; to avoid adding USER Classes to the wrong person. "RTN","USRULST",9,0) MAIN ; Control Branching "RTN","USRULST",10,0) N DIC,X,Y,USRDUZ "RTN","USRULST",11,0) S DIC=200,DIC(0)="AEMQ",DIC("A")="Select USER: " "RTN","USRULST",12,0) D ^DIC Q:+Y'>0 "RTN","USRULST",13,0) S USRDUZ=+Y "RTN","USRULST",14,0) D EN^VALM(USRLTMPL) "RTN","USRULST",15,0) Q "RTN","USRULST",16,0) GETUSER() ; Get a new user "RTN","USRULST",17,0) N DIC,X,Y "RTN","USRULST",18,0) S DIC=200,DIC(0)="AEMQ",DIC("A")="Select USER: " "RTN","USRULST",19,0) D ^DIC ; If Y is not set then will use current USRDUZ "RTN","USRULST",20,0) I +Y>0 S USRDUZ=+Y "RTN","USRULST",21,0) Q USRDUZ "RTN","USRULST",22,0) MAKELIST ; Build review screen list "RTN","USRULST",23,0) W !,"Searching for the User Classes." "RTN","USRULST",24,0) D BUILD(USRDUZ) "RTN","USRULST",25,0) Q "RTN","USRULST",26,0) BUILD(USRDUZ) ; Build List "RTN","USRULST",27,0) ; DBIA 872 ^ORD(101) "RTN","USRULST",28,0) N USRCNT,USRNAME,USRPICK "RTN","USRULST",29,0) S (USRCNT,VALMCNT)=0 "RTN","USRULST",30,0) S USRPICK=+$O(^ORD(101,"B","USR ACTION SELECT LIST ELEMENT",0)) "RTN","USRULST",31,0) K ^TMP("USRUSER",$J),^TMP("USRUSERIDX",$J),^TMP("USRU",$J) "RTN","USRULST",32,0) D WHATIS^USRLM(USRDUZ,"^TMP(""USRU"",$J)") "RTN","USRULST",33,0) S USRNAME="" "RTN","USRULST",34,0) F S USRNAME=$O(^TMP("USRU",$J,USRNAME),-1) Q:USRNAME="" Q:USRNAME=0 D "RTN","USRULST",35,0) . N USRDA,USREFF,USREXP,USRMEM,USRREC,USRCLNM "RTN","USRULST",36,0) . S USRMEM=$G(^TMP("USRU",$J,USRNAME)) "RTN","USRULST",37,0) . S USRDA=+$P(USRMEM,U,2) "RTN","USRULST",38,0) . S USRCLNM=$P(USRMEM,U,3) "RTN","USRULST",39,0) . S USREFF=$$DATE^USRLS(+$P(USRMEM,U,4),"MM/DD/YY") "RTN","USRULST",40,0) . S USREXP=$$DATE^USRLS(+$P(USRMEM,U,5),"MM/DD/YY") "RTN","USRULST",41,0) . S USRCNT=+$G(USRCNT)+1 "RTN","USRULST",42,0) . S USRREC=$$SETFLD^VALM1(USRCNT,"","NUMBER") "RTN","USRULST",43,0) . S USRREC=$$SETFLD^VALM1(USRCLNM,USRREC,"CLASS") "RTN","USRULST",44,0) . S USRREC=$$SETFLD^VALM1(USREFF,USRREC,"EFFECTIVE") "RTN","USRULST",45,0) . S USRREC=$$SETFLD^VALM1(USREXP,USRREC,"EXPIRES") "RTN","USRULST",46,0) . S VALMCNT=+$G(VALMCNT)+1 "RTN","USRULST",47,0) . S ^TMP("USRUSER",$J,VALMCNT,0)=USRREC "RTN","USRULST",48,0) . S ^TMP("USRUSER",$J,"IDX",VALMCNT,USRCNT)="" "RTN","USRULST",49,0) . S ^TMP("USRUSERIDX",$J,USRCNT)=VALMCNT_U_USRDA W:VALMCNT#10'>0 "." "RTN","USRULST",50,0) S ^TMP("USRUSER",$J,0)=+$G(USRCNT)_U_$P(^TMP("USRU",$J,0),U,2) "RTN","USRULST",51,0) S ^TMP("USRUSER",$J,"#")=USRPICK_"^0:"_+$G(USRCNT) "RTN","USRULST",52,0) I $D(VALMHDR)>9 D HDR "RTN","USRULST",53,0) I +$G(USRCNT)'>0 D "RTN","USRULST",54,0) . S ^TMP("USRUSER",$J,1,0)="",VALMCNT=2 "RTN","USRULST",55,0) . S ^TMP("USRUSER",$J,2,0)="No Class Memberships found for "_$P(^TMP("USRU",$J,0),U,2) "RTN","USRULST",56,0) Q "RTN","USRULST",57,0) HDR ; Initialize header for review screen "RTN","USRULST",58,0) N BY,USRX,USRCNT,TITLE,USRNAME "RTN","USRULST",59,0) S USRX=$G(^TMP("USRUSER",$J,0)),USRNAME=$P(USRX,U,2) "RTN","USRULST",60,0) S TITLE=USRNAME "RTN","USRULST",61,0) I USRNAME["?SBPN" D "RTN","USRULST",62,0) . S VALMSG="(?SBPN) missing SIGNATURE BLOCK PRINTED NAME" "RTN","USRULST",63,0) ;If this user has been terminated change the title to reflect this. "RTN","USRULST",64,0) I $$ISTERM^USRLM(USRDUZ) S TITLE=TITLE_" (terminated)" "RTN","USRULST",65,0) S USRCNT=$J(+USRX,4)_" Class"_$S(+USRX=1:"",1:"es") "RTN","USRULST",66,0) S VALMHDR(1)=$$CENTER^USRLS(TITLE) "RTN","USRULST",67,0) S VALMHDR(1)=$$SETSTR^VALM1(USRCNT,VALMHDR(1),(IOM-$L(USRCNT)),$L(USRCNT)) "RTN","USRULST",68,0) Q "RTN","USRULST",69,0) CLEAN ; "Joel...Clean up your mess!" "RTN","USRULST",70,0) K ^TMP("USRUSER",$J),^TMP("USRUSERIDX",$J),^TMP("USRU",$J) "RTN","USRULST",71,0) Q "VER") 8.0^22.0 "BLD",6544,6) ^29 **END** **END**