Released XU*8*497 SEQ #409 Extracted from mail message **KIDS**:XU*8.0*497^ **INSTALL NAME** XU*8.0*497 "BLD",1079,0) XU*8.0*497^KERNEL^0^3081023^y^^ "BLD",1079,1,0) ^^2^2^3080410^ "BLD",1079,1,1,0) Kernel patch XU*8.0*497; Update Person Class file. Please refer to the "BLD",1079,1,2,0) Description in Forum Patch Module for details. "BLD",1079,4,0) ^9.64PA^^ "BLD",1079,6) 2^ "BLD",1079,6.3) 5 "BLD",1079,"ABPKG") n "BLD",1079,"INID") ^n "BLD",1079,"INIT") INACTIVE^XU8P497 "BLD",1079,"KRN",0) ^9.67PA^779.2^20 "BLD",1079,"KRN",.4,0) .4 "BLD",1079,"KRN",.401,0) .401 "BLD",1079,"KRN",.402,0) .402 "BLD",1079,"KRN",.403,0) .403 "BLD",1079,"KRN",.5,0) .5 "BLD",1079,"KRN",.84,0) .84 "BLD",1079,"KRN",3.6,0) 3.6 "BLD",1079,"KRN",3.8,0) 3.8 "BLD",1079,"KRN",9.2,0) 9.2 "BLD",1079,"KRN",9.8,0) 9.8 "BLD",1079,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",1079,"KRN",9.8,"NM",1,0) XU8P497^^0^B17128456 "BLD",1079,"KRN",9.8,"NM",2,0) XU8P497A^^0^B9051470 "BLD",1079,"KRN",9.8,"NM","B","XU8P497",1) "BLD",1079,"KRN",9.8,"NM","B","XU8P497A",2) "BLD",1079,"KRN",19,0) 19 "BLD",1079,"KRN",19.1,0) 19.1 "BLD",1079,"KRN",101,0) 101 "BLD",1079,"KRN",409.61,0) 409.61 "BLD",1079,"KRN",771,0) 771 "BLD",1079,"KRN",779.2,0) 779.2 "BLD",1079,"KRN",870,0) 870 "BLD",1079,"KRN",8989.51,0) 8989.51 "BLD",1079,"KRN",8989.52,0) 8989.52 "BLD",1079,"KRN",8994,0) 8994 "BLD",1079,"KRN","B",.4,.4) "BLD",1079,"KRN","B",.401,.401) "BLD",1079,"KRN","B",.402,.402) "BLD",1079,"KRN","B",.403,.403) "BLD",1079,"KRN","B",.5,.5) "BLD",1079,"KRN","B",.84,.84) "BLD",1079,"KRN","B",3.6,3.6) "BLD",1079,"KRN","B",3.8,3.8) "BLD",1079,"KRN","B",9.2,9.2) "BLD",1079,"KRN","B",9.8,9.8) "BLD",1079,"KRN","B",19,19) "BLD",1079,"KRN","B",19.1,19.1) "BLD",1079,"KRN","B",101,101) "BLD",1079,"KRN","B",409.61,409.61) "BLD",1079,"KRN","B",771,771) "BLD",1079,"KRN","B",779.2,779.2) "BLD",1079,"KRN","B",870,870) "BLD",1079,"KRN","B",8989.51,8989.51) "BLD",1079,"KRN","B",8989.52,8989.52) "BLD",1079,"KRN","B",8994,8994) "BLD",1079,"QDEF") ^^^^NO^^^^NO^^NO "BLD",1079,"QUES",0) ^9.62^^ "BLD",1079,"REQB",0) ^9.611^1^1 "BLD",1079,"REQB",1,0) XU*8.0*487^0 "BLD",1079,"REQB","B","XU*8.0*487",1) "INIT") INACTIVE^XU8P497 "MBREQ") 0 "PKG",3,-1) 1^1 "PKG",3,0) KERNEL^XU^SIGN-ON, SECURITY, MENU DRIVER, DEVICES, TASKMAN^ "PKG",3,20,0) ^9.402P^^0 "PKG",3,22,0) ^9.49I^1^1 "PKG",3,22,1,0) 8.0^3080616^3080616^6 "PKG",3,22,1,"PAH",1,0) 497^3081023^82 "PKG",3,22,1,"PAH",1,1,0) ^^2^2^3081023 "PKG",3,22,1,"PAH",1,1,1,0) Kernel patch XU*8.0*497; Update Person Class file. Please refer to the "PKG",3,22,1,"PAH",1,1,2,0) Description in Forum Patch Module for details. "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") NO "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") NO "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") NO "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") 2 "RTN","XU8P497") 0^1^B17128456^n/a "RTN","XU8P497",1,0) XU8P497 ;BP/BT - UPDATE PERSON CLASS FILE; 10/23/08 "RTN","XU8P497",2,0) ;;8.0;KERNEL;**497**;July 10, 1995;Build 5 "RTN","XU8P497",3,0) ;;"Per VHA Directive 2004-038, this routine should not be modified." "RTN","XU8P497",4,0) ; "RTN","XU8P497",5,0) Q "RTN","XU8P497",6,0) POST ; entry point of Post-Initi Routine "RTN","XU8P497",7,0) D LOOP,INACTIVE "RTN","XU8P497",8,0) Q "RTN","XU8P497",9,0) LOOP ; loop through New Person file. And map new Person Classes for users "RTN","XU8P497",10,0) N XUIEN,XUPC,XUEFDATE,XUEXDATE "RTN","XU8P497",11,0) K ^TMP("XU8P497") "RTN","XU8P497",12,0) S XUIEN=0 F S XUIEN=$O(^VA(200,XUIEN)) Q:XUIEN'>0 D "RTN","XU8P497",13,0) . I $P($$ACTIVE^XUSER(XUIEN),"^",2)="TERMINATED" Q "RTN","XU8P497",14,0) . S XUPC=$$GETPC(XUIEN) "RTN","XU8P497",15,0) . I +XUPC>522 Q "RTN","XU8P497",16,0) . I +XUPC<187 Q "RTN","XU8P497",17,0) . S XUEFDATE=$P(XUPC,"^",2) I XUEFDATE<$$DT^XLFDT S XUEFDATE=$$DT^XLFDT "RTN","XU8P497",18,0) . S XUEXDATE=$P(XUPC,"^",3) "RTN","XU8P497",19,0) . I +XUPC=187 D REPOINT(XUIEN,181,XUEFDATE,XUEXDATE),PRINT(XUIEN,181) Q "RTN","XU8P497",20,0) . I +XUPC=247 D REPOINT(XUIEN,1135,XUEFDATE,XUEXDATE),PRINT(XUIEN,1135) Q "RTN","XU8P497",21,0) . I +XUPC=353 D REPOINT(XUIEN,675,XUEFDATE,XUEXDATE),PRINT(XUIEN,675) Q "RTN","XU8P497",22,0) . I +XUPC=515 D REPOINT(XUIEN,352,XUEFDATE,XUEXDATE),PRINT(XUIEN,352) Q "RTN","XU8P497",23,0) . I +XUPC=517 D REPOINT(XUIEN,352,XUEFDATE,XUEXDATE),PRINT(XUIEN,352) Q "RTN","XU8P497",24,0) . I +XUPC=519 D REPOINT(XUIEN,354,XUEFDATE,XUEXDATE),PRINT(XUIEN,354) Q "RTN","XU8P497",25,0) . I +XUPC=522 D REPOINT(XUIEN,352,XUEFDATE,XUEXDATE),PRINT(XUIEN,352) Q "RTN","XU8P497",26,0) Q "RTN","XU8P497",27,0) ; "RTN","XU8P497",28,0) REPOINT(USERIEN,NEWPC,EFDATE,EXDATE) ;Use FM so to fire X-ref's "RTN","XU8P497",29,0) N RX1,RX2,DA1 "RTN","XU8P497",30,0) S DA1=USERIEN "RTN","XU8P497",31,0) I $G(EFDATE)="" S EFDATE=$$DT^XLFDT "RTN","XU8P497",32,0) S RX1(200.05,"+1,"_DA1_",",.01)=NEWPC "RTN","XU8P497",33,0) S RX1(200.05,"+1,"_DA1_",",2)=$G(EFDATE) "RTN","XU8P497",34,0) S RX1(200.05,"+1,"_DA1_",",3)=$G(EXDATE) "RTN","XU8P497",35,0) L +^VA(200,DA1,"USC1"):2 I '$T D Q "RTN","XU8P497",36,0) .S XUA(1)="",XUA(2)=">>>User # "_DA1_" is locked at this time." D MES^XPDUTL(.XUA) "RTN","XU8P497",37,0) D UPDATE^DIE("S","RX1","RX2") "RTN","XU8P497",38,0) L -^VA(200,DA1,"USC1") "RTN","XU8P497",39,0) Q "RTN","XU8P497",40,0) ; "RTN","XU8P497",41,0) INACTIVE ; inactivate Person Class entries "RTN","XU8P497",42,0) N XUI "RTN","XU8P497",43,0) F XUI=187,247,353,515,517,519,522 D INAC(XUI) "RTN","XU8P497",44,0) Q "RTN","XU8P497",45,0) ; "RTN","XU8P497",46,0) INAC(PCIEN) ; inactivate single Person Class entry "RTN","XU8P497",47,0) I +$G(PCIEN)'=$G(PCIEN) Q "RTN","XU8P497",48,0) I $G(PCIEN)'>0 Q "RTN","XU8P497",49,0) N XUA,XUDT S XUDT=$$DT^XLFDT "RTN","XU8P497",50,0) L +^USC(8932.1,PCIEN,0):10 I '$T D Q "RTN","XU8P497",51,0) .S XUA(1)="",XUA(2)=">>>Record # "_PCIEN_" locked at time of patch installation. Could not inactivate." D MES^XPDUTL(.XUA) "RTN","XU8P497",52,0) N DR,DIE,DA S DR="3////i",DIE="^USC(8932.1,",DA=PCIEN D ^DIE "RTN","XU8P497",53,0) N DR,DIE,DA S DR="4///^S X=XUDT",DIE="^USC(8932.1,",DA=PCIEN D ^DIE "RTN","XU8P497",54,0) L -^USC(8932.1,PCIEN,0) "RTN","XU8P497",55,0) Q "RTN","XU8P497",56,0) ; "RTN","XU8P497",57,0) PRINT(USERIEN,PCNEW) ; print a user who is assigned the replacement Person Class "RTN","XU8P497",58,0) N XUA,XUY "RTN","XU8P497",59,0) S XUY=+$O(^TMP("XU8P497",$J,"A"),-1) "RTN","XU8P497",60,0) S XUA(1)=">>> The user "_$P($G(^VA(200,USERIEN,0)),"^")_" is assigned to the Person Class IEN: "_PCNEW "RTN","XU8P497",61,0) S XUA(2)="" "RTN","XU8P497",62,0) S ^TMP("XU8P497",$J,XUY+1)=XUA(1) "RTN","XU8P497",63,0) D MES^XPDUTL(.XUA) "RTN","XU8P497",64,0) Q "RTN","XU8P497",65,0) ; "RTN","XU8P497",66,0) GETPC(XUIEN) ;Get Person Class for a single user "RTN","XU8P497",67,0) N XUEXDA,XUPCIEN "RTN","XU8P497",68,0) I +$G(XUIEN)'>0 Q "" "RTN","XU8P497",69,0) I '$D(^VA(200,XUIEN,"USC1")) Q "" "RTN","XU8P497",70,0) S XUPCIEN=$O(^VA(200,XUIEN,"USC1","A"),-1) "RTN","XU8P497",71,0) I $G(XUPCIEN)'>0 Q "" "RTN","XU8P497",72,0) S XUEXDA=$P($G(^VA(200,XUIEN,"USC1",XUPCIEN,0)),"^",3) "RTN","XU8P497",73,0) I XUEXDA'="",(XUEXDA<$$DT^XLFDT) Q "" "RTN","XU8P497",74,0) Q $G(^VA(200,XUIEN,"USC1",XUPCIEN,0)) "RTN","XU8P497",75,0) ; "RTN","XU8P497",76,0) SETDATE(USERIEN,PCIEN,XUEFDA,XUEXDA) ;set eff and exp date for the privious Person Class entry. "RTN","XU8P497",77,0) I +$G(XUEFDA)>$$DT^XLFDT D SETEFDA(USERIEN,PCIEN,$$DT^XLFDT) "RTN","XU8P497",78,0) I +$G(XUEXDA)>$$DT^XLFDT D SETEXDA(USERIEN,PCIEN,$$DT^XLFDT) "RTN","XU8P497",79,0) Q "RTN","XU8P497",80,0) ; "RTN","XU8P497",81,0) SETEXDA(USERIEN,PCIEN,EXDATE) ; set exp date "RTN","XU8P497",82,0) N DIE,DA,DR "RTN","XU8P497",83,0) S DA(1)=USERIEN ; "RTN","XU8P497",84,0) S DA=PCIEN ; entry number in subfile "RTN","XU8P497",85,0) S DIE="^VA(200,"_DA(1)_","_"""USC1"""_"," ; global root of subfile "RTN","XU8P497",86,0) S DR="3///^S X=EXDATE" ; fields in subfile to edit "RTN","XU8P497",87,0) L +^VA(200,USERIEN,"USC1"):2 I '$T D Q "RTN","XU8P497",88,0) .S XUA(1)="",XUA(2)=">>>User # "_DA1_" is locked at this time." D MES^XPDUTL(.XUA) "RTN","XU8P497",89,0) D ^DIE "RTN","XU8P497",90,0) L -^VA(200,USERIEN,"USC1") "RTN","XU8P497",91,0) Q "RTN","XU8P497",92,0) SETEFDA(USERIEN,PCIEN,EFDATE) ; set eff date "RTN","XU8P497",93,0) N DIE,DA,DR "RTN","XU8P497",94,0) S DA(1)=USERIEN ; "RTN","XU8P497",95,0) S DA=PCIEN ; entry number in subfile "RTN","XU8P497",96,0) S DIE="^VA(200,"_DA(1)_","_"""USC1"""_"," ; global root of subfile "RTN","XU8P497",97,0) S DR="2///^S X=EFDATE" ; fields in subfile to edit "RTN","XU8P497",98,0) L +^VA(200,USERIEN,"USC1"):2 I '$T D Q "RTN","XU8P497",99,0) .S XUA(1)="",XUA(2)=">>>User # "_DA1_" is locked at this time." D MES^XPDUTL(.XUA) "RTN","XU8P497",100,0) D ^DIE "RTN","XU8P497",101,0) L -^VA(200,USERIEN,"USC1") "RTN","XU8P497",102,0) Q "RTN","XU8P497A") 0^2^B9051470^n/a "RTN","XU8P497A",1,0) XU8P497A ;BP/BT - UPDATE PERSON CLASS FILE; 4/7/2008 "RTN","XU8P497A",2,0) ;;8.0;KERNEL;**497**;July 10, 1995;Build 5 "RTN","XU8P497A",3,0) ;;"Per VHA Directive 2004-038, this routine should not be modified." "RTN","XU8P497A",4,0) ; "RTN","XU8P497A",5,0) EN ; "RTN","XU8P497A",6,0) N XU1,XU2,XUPCIEN,XUDATA "RTN","XU8P497A",7,0) F XU1=1:1:1 S XUDATA=$P($T(INAC+XU1),";",3,99) D "RTN","XU8P497A",8,0) . F XU2=1:1 S XUPCIEN=$P(XUDATA,";",XU2) Q:XUPCIEN="$END$" D CHCK "RTN","XU8P497A",9,0) Q "RTN","XU8P497A",10,0) INAC ;; "RTN","XU8P497A",11,0) ;;187;247;353;515;517;519;522;$END$ "RTN","XU8P497A",12,0) ;;$END$;; "RTN","XU8P497A",13,0) ;; "RTN","XU8P497A",14,0) ;; "RTN","XU8P497A",15,0) LOOP N XUIEN,XUIEN2,XUEXDA,XUDIUSR,XUACTIVE,XUACONLY,% "RTN","XU8P497A",16,0) W !,"This report will run immediately (no device asked)." "RTN","XU8P497A",17,0) W !,"Users may turn 'screen capture' for this report." "RTN","XU8P497A",18,0) R !,"Do you want to list active users only? NO// ",%:20 Q:'$T "RTN","XU8P497A",19,0) S %=$TR($E(%),"YyNn","1100") I %="^" Q "RTN","XU8P497A",20,0) W ! "RTN","XU8P497A",21,0) K ^TMP("XU8P497") "RTN","XU8P497A",22,0) S XUIEN=0 F S XUIEN=$O(^VA(200,XUIEN)) Q:XUIEN'>0 D "RTN","XU8P497A",23,0) . I %=1,'(+$$ACTIVE^XUSER(XUIEN)) Q "RTN","XU8P497A",24,0) . S XUACTIVE=$P($$ACTIVE^XUSER(XUIEN),"^",2) "RTN","XU8P497A",25,0) . S XUDIUSR=XUACTIVE "RTN","XU8P497A",26,0) . D EN "RTN","XU8P497A",27,0) D PRNT "RTN","XU8P497A",28,0) Q "RTN","XU8P497A",29,0) CHCK ; "RTN","XU8P497A",30,0) I '$D(^VA(200,XUIEN,"USC1","B",XUPCIEN)) Q "RTN","XU8P497A",31,0) S XUIEN2=$O(^VA(200,XUIEN,"USC1","B",XUPCIEN,"A"),-1) "RTN","XU8P497A",32,0) S XUEXDA=$P($G(^VA(200,XUIEN,"USC1",XUIEN2,0)),"^",3) "RTN","XU8P497A",33,0) I ('XUEXDA)!(XUEXDA>DT) D "RTN","XU8P497A",34,0) . S ^TMP("XU8P497",$J,XUPCIEN,XUIEN)=$P($G(^VA(200,XUIEN,0)),"^",1)_"^"_XUDIUSR "RTN","XU8P497A",35,0) Q "RTN","XU8P497A",36,0) PRNT ; "RTN","XU8P497A",37,0) N XUI,XUY,XUV,XUCOUNT,XUC S XUC=0 "RTN","XU8P497A",38,0) S XUI=0 F S XUI=$O(^TMP("XU8P497",$J,XUI)) Q:XUI'>0 D "RTN","XU8P497A",39,0) . S XUV=$G(^USC(8932.1,XUI,0)) "RTN","XU8P497A",40,0) . W !,"PERSON CLASS ID: ",XUI,?28," NAME: ",$E($P(XUV,"^",1),1,40) "RTN","XU8P497A",41,0) . W !," VA CODE: ",$P(XUV,"^",6),?28,"X12 CODE: ",$P(XUV,"^",7) "RTN","XU8P497A",42,0) . S XUCOUNT=0 "RTN","XU8P497A",43,0) . W !!,"User Name",?34,"Status" "RTN","XU8P497A",44,0) . S XUY=0 F S XUY=$O(^TMP("XU8P497",$J,XUI,XUY)) Q:XUY'>0 D "RTN","XU8P497A",45,0) . . W !,?2,$P($G(^TMP("XU8P497",$J,XUI,XUY)),"^"),?36,$P($G(^TMP("XU8P497",$J,XUI,XUY)),"^",2) "RTN","XU8P497A",46,0) . . S XUCOUNT=XUCOUNT+1 "RTN","XU8P497A",47,0) . W !!,?10,"Number of users: ",XUCOUNT "RTN","XU8P497A",48,0) . W !,"------------------------------" "RTN","XU8P497A",49,0) . S XUC=XUC+1 "RTN","XU8P497A",50,0) I XUC=0 W !,"No users found. You are done!" "RTN","XU8P497A",51,0) I XUC>0 W !!," Please check and assign replacement Person Classes",!," for users listed on this report." "RTN","XU8P497A",52,0) D ^%ZISC "RTN","XU8P497A",53,0) Q "RTN","XU8P497A",54,0) ; "RTN","XU8P497A",55,0) PRINT ; "RTN","XU8P497A",56,0) N XUI,XUY,XUC S (XUI,XUC)=0 "RTN","XU8P497A",57,0) W !,"This report will run immediately (no device asked)." "RTN","XU8P497A",58,0) W !,"Users may turn 'screen capture' for this report." "RTN","XU8P497A",59,0) R !,"Enter any key to continue ",XUY:10 Q:'$T "RTN","XU8P497A",60,0) F S XUI=$O(^TMP("XU8P497",$J,XUI)) Q:XUI'>0 D "RTN","XU8P497A",61,0) . W !,$G(^TMP("XU8P497",$J,XUI)) S XUC=XUC+1 "RTN","XU8P497A",62,0) I XUC=0 W !!,"No replacement Person Class is assigned for users." "RTN","XU8P497A",63,0) Q "VER") 8.0^22.0 "BLD",1079,6) ^409 **END** **END**