Released XU*8*483 SEQ #389 Extracted from mail message **KIDS**:XU*8.0*483^ **INSTALL NAME** XU*8.0*483 "BLD",1054,0) XU*8.0*483^KERNEL^0^3080130^y "BLD",1054,1,0) ^^1^1^3080123^ "BLD",1054,1,1,0) See the description for patch XU*8*483 in the patch module on Forum. "BLD",1054,4,0) ^9.64PA^8989.3^1 "BLD",1054,4,8989.3,0) 8989.3 "BLD",1054,4,8989.3,2,0) ^9.641^8989.3^1 "BLD",1054,4,8989.3,2,8989.3,0) KERNEL SYSTEM PARAMETERS (File-top level) "BLD",1054,4,8989.3,2,8989.3,1,0) ^9.6411^321.02^2 "BLD",1054,4,8989.3,2,8989.3,1,321.01,0) SITE ISO "BLD",1054,4,8989.3,2,8989.3,1,321.02,0) SITE IRM CHIEF "BLD",1054,4,8989.3,222) y^n^p^^^^n^^n "BLD",1054,4,8989.3,224) "BLD",1054,4,"APDD",8989.3,8989.3) "BLD",1054,4,"APDD",8989.3,8989.3,321.01) "BLD",1054,4,"APDD",8989.3,8989.3,321.02) "BLD",1054,4,"B",8989.3,8989.3) "BLD",1054,6.3) 15 "BLD",1054,"INID") ^n "BLD",1054,"INIT") XU8P483 "BLD",1054,"KRN",0) ^9.67PA^779.2^20 "BLD",1054,"KRN",.4,0) .4 "BLD",1054,"KRN",.401,0) .401 "BLD",1054,"KRN",.402,0) .402 "BLD",1054,"KRN",.403,0) .403 "BLD",1054,"KRN",.5,0) .5 "BLD",1054,"KRN",.84,0) .84 "BLD",1054,"KRN",3.6,0) 3.6 "BLD",1054,"KRN",3.8,0) 3.8 "BLD",1054,"KRN",9.2,0) 9.2 "BLD",1054,"KRN",9.8,0) 9.8 "BLD",1054,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",1054,"KRN",9.8,"NM",1,0) XQ55^^0^B31081771 "BLD",1054,"KRN",9.8,"NM",2,0) XQ55SPEC^^0^B77810456 "BLD",1054,"KRN",9.8,"NM","B","XQ55",1) "BLD",1054,"KRN",9.8,"NM","B","XQ55SPEC",2) "BLD",1054,"KRN",19,0) 19 "BLD",1054,"KRN",19,"NM",0) ^9.68A^1^1 "BLD",1054,"KRN",19,"NM",1,0) XQOCGCANALYSIS^^0 "BLD",1054,"KRN",19,"NM","B","XQOCGCANALYSIS",1) "BLD",1054,"KRN",19.1,0) 19.1 "BLD",1054,"KRN",19.1,"NM",0) ^9.68A^^ "BLD",1054,"KRN",101,0) 101 "BLD",1054,"KRN",409.61,0) 409.61 "BLD",1054,"KRN",771,0) 771 "BLD",1054,"KRN",779.2,0) 779.2 "BLD",1054,"KRN",870,0) 870 "BLD",1054,"KRN",8989.51,0) 8989.51 "BLD",1054,"KRN",8989.52,0) 8989.52 "BLD",1054,"KRN",8994,0) 8994 "BLD",1054,"KRN","B",.4,.4) "BLD",1054,"KRN","B",.401,.401) "BLD",1054,"KRN","B",.402,.402) "BLD",1054,"KRN","B",.403,.403) "BLD",1054,"KRN","B",.5,.5) "BLD",1054,"KRN","B",.84,.84) "BLD",1054,"KRN","B",3.6,3.6) "BLD",1054,"KRN","B",3.8,3.8) "BLD",1054,"KRN","B",9.2,9.2) "BLD",1054,"KRN","B",9.8,9.8) "BLD",1054,"KRN","B",19,19) "BLD",1054,"KRN","B",19.1,19.1) "BLD",1054,"KRN","B",101,101) "BLD",1054,"KRN","B",409.61,409.61) "BLD",1054,"KRN","B",771,771) "BLD",1054,"KRN","B",779.2,779.2) "BLD",1054,"KRN","B",870,870) "BLD",1054,"KRN","B",8989.51,8989.51) "BLD",1054,"KRN","B",8989.52,8989.52) "BLD",1054,"KRN","B",8994,8994) "BLD",1054,"QDEF") ^^^^NO^^^^NO^^NO "BLD",1054,"QUES",0) ^9.62^2^2 "BLD",1054,"QUES",1,0) POS1 "BLD",1054,"QUES",1,1) P^200:EMZ "BLD",1054,"QUES",1,"A") Enter the name of the Facility ISO "BLD",1054,"QUES",1,"Q") Enter the last name, first name of the facility Information Security Officer "BLD",1054,"QUES",2,0) POS2 "BLD",1054,"QUES",2,1) P^200:EMZ "BLD",1054,"QUES",2,"A") Enter name of the Facility CIO "BLD",1054,"QUES",2,"Q") Enter the name of the Facility Chief Information Officer, last name first "BLD",1054,"QUES","B","POS1",1) "BLD",1054,"QUES","B","POS2",2) "BLD",1054,"REQB",0) ^9.611^^ "FIA",8989.3) KERNEL SYSTEM PARAMETERS "FIA",8989.3,0) ^XTV(8989.3, "FIA",8989.3,0,0) 8989.3P "FIA",8989.3,0,1) y^n^p^^^^n^^n "FIA",8989.3,0,10) "FIA",8989.3,0,11) "FIA",8989.3,0,"RLRO") "FIA",8989.3,0,"VR") 8.0^XU "FIA",8989.3,8989.3) 1 "FIA",8989.3,8989.3,321.01) "FIA",8989.3,8989.3,321.02) "INIT") XU8P483 "KRN",19,1347,-1) 0^1 "KRN",19,1347,0) XQOCGCANALYSIS^CPRS GUI CHART DISTRIBUTION ANALYSIS^^S^^^^^^^^ "KRN",19,1347,1,0) ^^9^9^3080122^ "KRN",19,1347,1,1,0) This option is a SERVER option which will run the routine XQ55SPEC when "KRN",19,1347,1,2,0) a mail message is received with this option name. The routine XQ55SPEC "KRN",19,1347,1,3,0) generates a summary mail message indicating the number of active users "KRN",19,1347,1,4,0) with the OR CPRS GUI CHART option and the total number of active users. "KRN",19,1347,1,5,0) This mail message is sent to Field Operations and the local Information "KRN",19,1347,1,6,0) Security Officer (ISO) and the local IRM Chief. A detailed mail message "KRN",19,1347,1,7,0) indicating all users who have access to the option and the paths by which "KRN",19,1347,1,8,0) they can access is also generated and is sent to the local ISO and IRM "KRN",19,1347,1,9,0) Chief (it is not sent to Field Operations). "KRN",19,1347,25) XQ55SPEC "KRN",19,1347,220) ^R^ "KRN",19,1347,"U") CPRS GUI CHART DISTRIBUTION AN "MBREQ") 0 "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "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^3051215^2970507^.5 "PKG",3,22,1,"PAH",1,0) 483^3080130 "PKG",3,22,1,"PAH",1,1,0) ^^1^1^3080130 "PKG",3,22,1,"PAH",1,1,1,0) See the description for patch XU*8*483 in the patch module on Forum. "QUES","POS1",0) P^200:EMZ "QUES","POS1","?") Enter the last name, first name of the facility Information Security Officer "QUES","POS1","A") Enter the name of the Facility ISO "QUES","POS2",0) P^200:EMZ "QUES","POS2","?") Enter the name of the Facility Chief Information Officer, last name first "QUES","POS2","A") Enter name of the Facility CIO "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") 3 "RTN","XQ55") 0^1^B31081771^B21861426 "RTN","XQ55",1,0) XQ55 ; SEA/AMF,MJM,JLI - SEARCH FOR USERS ACCESS TO AN OPTION [4/12/04 4:36am] ;1/29/08 09:50 "RTN","XQ55",2,0) ;;8.0;KERNEL;**140,342,483**;Jul 10, 1995;Build 15 "RTN","XQ55",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified "RTN","XQ55",4,0) INIT ; "RTN","XQ55",5,0) S XQDSH="-------------------------------------------------------------------------------" "RTN","XQ55",6,0) D ^XQDATE S XQDT=%Y "RTN","XQ55",7,0) OPT W ! S DIC=19,DIC(0)="AEQM" D ^DIC G:Y=-1 OUT S XQOPT=+Y "RTN","XQ55",8,0) MPAT W !!,"Show menu paths" S %=2 D YN^DICN G:%<0 OUT S XQMP=2-% I '% W !!,"If you answer 'YES', the listing will include the menu path(s) each user has",!,"to access the specified option." G MPAT "RTN","XQ55",9,0) K ^TMP($J),XQR,XQP "RTN","XQ55",10,0) S K=^DIC(19,XQOPT,0),XQHDR="Access to '"_$P(K,U,2)_"' ["_$P(K,U,1)_"]",XQSCD=0,XQCOM=0,XQNOPRNT=0 "RTN","XQ55",11,0) LOOP1 S K=XQOPT,(L,X(0))=0,XQD=K K XQR,XQA,XQK,XQRV S XQR(K)="" I '$L($P(^DIC(19,K,0),U,3)) D TREE1 "RTN","XQ55",12,0) G LOOP2 "RTN","XQ55",13,0) Q "RTN","XQ55",14,0) TREE S X(L)=$O(^DIC(19,"AD",XQD,X(L))) Q:X(L)'>0 S K=X(L) G:$D(XQR(K)) TREE S XQR(K)="" "RTN","XQ55",15,0) TREE1 ; "RTN","XQ55",16,0) S Y(0)=^DIC(19,K,0) G:$L($P(Y(0),U,3)) TREE S:$L($P(Y(0),U,6)) XQK(L)=$P(Y(0),U,6) S XQA(L)=K I $P(Y(0),U,16) S XQRV(L)=^DIC(19,K,3) "RTN","XQ55",17,0) D SETGLO S L=L+1,X(L)=0,(XQD,XQD(L))=K D TREE "RTN","XQ55",18,0) Q:L=1 K XQR(XQD(L)) S L=L-1 K XQA(L),XQK(L),XQRV(L) S XQD=XQD(L) G TREE "RTN","XQ55",19,0) Q "RTN","XQ55",20,0) SETGLO ; "RTN","XQ55",21,0) S XQK="" F I=L:-1:0 I $D(XQK(I)),$L(XQK(I)) S XQK=XQK_XQK(I)_"," "RTN","XQ55",22,0) S XQRV="" F I=L:-1:0 I $D(XQRV(I)),$L(XQRV(I)) S XQRV=XQRV_XQRV(I)_"," "RTN","XQ55",23,0) S XQA="" F I=L:-1:1 I $D(XQA(I)) S XQA=XQA_XQA(I)_"," "RTN","XQ55",24,0) S XQA=XQA_XQOPT,J=0 S:$D(^TMP($J,K,0)) J=^(0) S J=J+1,^(0)=J,^TMP($J,K,J)=XQK_U_XQA_U_XQRV "RTN","XQ55",25,0) Q "RTN","XQ55",26,0) LOOP2 ; "RTN","XQ55",27,0) S XQPA(0)=0,XQP=0 F S XQP=$O(^TMP($J,XQP)) Q:XQP="" S XQN=^TMP($J,XQP,0) S XQPS="AP" D USERS S XQPS="AD" D USERS "RTN","XQ55",28,0) D USERS1 I XQNOPRNT G MUS ; 080115 - add in options from the common menu "RTN","XQ55",29,0) G LOOP3 "RTN","XQ55",30,0) USERS ; "RTN","XQ55",31,0) S XQU=0 F S XQU=$O(^VA(200,XQPS,XQP,XQU)) Q:XQU'>0 I $D(^VA(200,XQU,.1)),+$$ACTIVE^XUSER(XQU) D EACHU "RTN","XQ55",32,0) Q "RTN","XQ55",33,0) USERS1 ; 080115 code added to handle options on the COMMON (XUCOMMAND) menu "RTN","XQ55",34,0) N XUCOMMON "RTN","XQ55",35,0) S XUCOMMON=$O(^DIC(19,"B","XUCOMMAND",0)) "RTN","XQ55",36,0) S XQP=0 F S XQP=$O(^TMP($J,XQP)) Q:XQP="" S XQN=^TMP($J,XQP,0) F J=1:1:XQN Q:'$D(^TMP($J,XQP,J)) I $P($P(^TMP($J,XQP,J),U,2),",")=XUCOMMON D "RTN","XQ55",37,0) . D Q:'Y "RTN","XQ55",38,0) . . W !,"***" "RTN","XQ55",39,0) . . W !,"*** This option is available from the 'SYSTEM COMMAND OPTIONS' ***" "RTN","XQ55",40,0) . . W !,"*** (XUCOMMAND) menu available to all active users unless ***" "RTN","XQ55",41,0) . . W !,"*** protected by a KEY - DO YOU REALLY WANT THE ENTIRE LIST ***" "RTN","XQ55",42,0) . . W !,"*** OF THESE USERS??? ***",! "RTN","XQ55",43,0) . . N DIR S DIR(0)="Y" D ^DIR S:'Y XQNOPRNT=1 Q:'Y "RTN","XQ55",44,0) . . Q "RTN","XQ55",45,0) . S XQU=0,XQPS="(C)" F S XQU=$O(^VA(200,XQU)) Q:XQU'>0 I $D(^VA(200,XQU,.1)),+$$ACTIVE^XUSER(XQU),$$KEYCHECK() S II=1 D SETU "RTN","XQ55",46,0) Q "RTN","XQ55",47,0) ; "RTN","XQ55",48,0) EACHU ; "RTN","XQ55",49,0) S II=1 "RTN","XQ55",50,0) F J=1:1:XQN Q:'$D(^TMP($J,XQP,J)) I $$KEYCHECK() D SETU ; 080115 "RTN","XQ55",51,0) Q "RTN","XQ55",52,0) ; "RTN","XQ55",53,0) KEYCHECK() ; 080115 extracted common code "RTN","XQ55",54,0) ; returns 1 if user has access to the option, 0 if the user does not have access "RTN","XQ55",55,0) S XQK=$P(^TMP($J,XQP,J),U,1),XX=$L(XQK,",")-1,XQGO=1 "RTN","XQ55",56,0) I XX F X=1:1:XX S Y=$P(XQK,",",X) I Y'="",('$D(^XUSEC(Y,XQU))) S XQGO=0 "RTN","XQ55",57,0) S XQK=$P(^TMP($J,XQP,J),U,3),XX=$L(XQK,",")-1 "RTN","XQ55",58,0) I XX F X=1:1:XX S Y=$P(XQK,",",X) I Y'="",($D(^XUSEC(Y,XQU))) S XQGO=0 "RTN","XQ55",59,0) Q XQGO "RTN","XQ55",60,0) ; "RTN","XQ55",61,0) SETU ; "RTN","XQ55",62,0) S XQPA=$P(^TMP($J,XQP,J),U,2) "RTN","XQ55",63,0) I '$D(XQPA(XQPA)) S I=XQPA(0)+1,XQPA(0)=I,XQPA(0,I)=XQPA,XQPA(XQPA)=I "RTN","XQ55",64,0) S XQPA=XQPA(XQPA) S:XQPS="AD" XQPA=XQPA_"(S)",XQSCD=1 S:XQPS="(C)" XQPA=XQPA_"(C)",XQCOM=1 ; 080115 "RTN","XQ55",65,0) S I=$P(^VA(200,XQU,0),U,1)_U_XQU S:$D(^TMP($J,0,I)) II=$O(^TMP($J,0,I,"A"),-1)+1 S ^TMP($J,0,I,II)=XQPA "RTN","XQ55",66,0) Q "RTN","XQ55",67,0) LOOP3 ; "RTN","XQ55",68,0) I $O(^TMP($J,0,0))="" W !!,"** NO USERS CAN ACCESS THIS OPTION **" G OUT "RTN","XQ55",69,0) S %ZIS="MFQ" D ^%ZIS G OUT:POP I $D(IO("Q")) K IO("Q") S ZTRTN="DQ^XQ55",ZTDESC="OPTION ACCESS BY USER",ZTSAVE("XQ*")="",ZTSAVE("^TMP($J,")="" D ^%ZTLOAD K ZTSK,ZTRTN,ZTSAVE,ZTDESC G OUT "RTN","XQ55",70,0) ; "RTN","XQ55",71,0) DQ ;Entry point for queued job "RTN","XQ55",72,0) U IO "RTN","XQ55",73,0) S:'XQMP XQPA(0)=-4 S XQPG=0,XQUI=0 D NEWPG G:XQUI MUS "RTN","XQ55",74,0) S XQU=0 F S XQU=$O(^TMP($J,0,XQU)) Q:XQU="" D PRTU G:XQUI MUS "RTN","XQ55",75,0) D:XQMP MENUPAT G MUS "RTN","XQ55",76,0) NEWPG ; "RTN","XQ55",77,0) S X="" I XQPG,$E(IOST,1)="C" D CON S XQUI=(X="^") Q:XQUI "RTN","XQ55",78,0) D HDR Q "RTN","XQ55",79,0) CON ; "RTN","XQ55",80,0) W !!,"Press return to continue or '^' to escape " R X:DTIME S:'$T X=U "RTN","XQ55",81,0) Q "RTN","XQ55",82,0) HDR ; "RTN","XQ55",83,0) W @IOF S XQPG=XQPG+1 "RTN","XQ55",84,0) W "Page ",XQPG,?62,XQDT,!! S XQTAB=(76-$L(XQHDR))/2 W ?XQTAB,XQHDR "RTN","XQ55",85,0) W !!,"USER NAME",?27,"LAST ON",?37,"PRIMARY MENU" W:XQMP ?63,"PATH(S)" "RTN","XQ55",86,0) W !,$E(XQDSH,1,25),?27,$E(XQDSH,1,8),?37,$E(XQDSH,1,$S(XQMP:24,1:40)) W:XQMP ?63,$E(XQDSH,1,14) "RTN","XQ55",87,0) Q "RTN","XQ55",88,0) PRTU ; "RTN","XQ55",89,0) I $Y>(IOSL-XQPA(0)-8) D:XQMP MENUPAT D NEWPG Q:XQUI "RTN","XQ55",90,0) S J=$P(XQU,U,2),K="" S:$D(^VA(200,J,1.1)) K=$P(^(1.1),"^") S:$L(K) K=$E(K,4,5)_"/"_$E(K,6,7)_"/"_$E(K,2,3) W !,$E($P(XQU,U,1),1,27),?27,K "RTN","XQ55",91,0) I $D(^VA(200,J,201)) S K=+^(201) I K>0,$D(^DIC(19,K,0)) W ?37,$E($P(^(0),U,1),1,24) "RTN","XQ55",92,0) I XQMP D "RTN","XQ55",93,0) .W ?63,"" "RTN","XQ55",94,0) .S JJ=$O(^TMP($J,0,XQU,"A"),-1) "RTN","XQ55",95,0) .F II=1:1:JJ W $G(^TMP($J,0,XQU,II)) I II'=JJ W "," "RTN","XQ55",96,0) I 'XQMP D "RTN","XQ55",97,0) .S II=0 F S II=$O(^TMP($J,0,XQU,II)) Q:II'>0 D "RTN","XQ55",98,0) ..I ^TMP($J,0,XQU,II)["(S)" W " (Secondary menu)" S II="A" "RTN","XQ55",99,0) Q "RTN","XQ55",100,0) MENUPAT ; "RTN","XQ55",101,0) W !!,$E(XQDSH,1,27)," MENU PATH(S) ",$E(XQDSH,1,29),! "RTN","XQ55",102,0) F I=1:1:XQPA(0) S K=XQPA(0,I) W !,I,".",?4 F N=1:1 Q:'$L($P(K,",",N)) W:N>1 " ... " W $P(^DIC(19,$P(K,",",N),0),U,1) "RTN","XQ55",103,0) I XQSCD W !,"(S) - secondary menu pathway" "RTN","XQ55",104,0) I XQCOM W !,"(C) - SYSTEM COMMAND OPTIONS (XUCOMMAND) menu pathway" "RTN","XQ55",105,0) Q "RTN","XQ55",106,0) MUS G:X="^" OUT I XQPG,$E(IOST,1)="C" W !!,"Press return when finished viewing " R X:DTIME W @IOF G OUT "RTN","XQ55",107,0) I $D(ZTSK) K ^%ZTSK(ZTSK) "RTN","XQ55",108,0) OUT ; "RTN","XQ55",109,0) D ^%ZISC "RTN","XQ55",110,0) KILL K XQDT,XQGO,XQN,XQP,XQR,XQRV,XQOPT,XQPA,XQUI,XQSCD,XQDSH,XQU,N,K,J,X,XQA,XQD,XQHDR,XQK,XQP,XQPS,XQMP,XQPG,XX "RTN","XQ55",111,0) K DIC,I,II,JJ,L,POP,Y,XQNOPRNT I $D(ZTQUEUED),$D(ZTSK),ZTSK>0 K ^%ZTSK(ZTSK) "RTN","XQ55",112,0) Q "RTN","XQ55SPEC") 0^2^B77810456^n/a "RTN","XQ55SPEC",1,0) XQ55SPEC ; SEA/JLI - SEARCH FOR USERS WITH ACCESS TO 'OR CPRS GUI CHART' ;1/29/08 15:02 "RTN","XQ55SPEC",2,0) ;;8.0;KERNEL;**483**;Jul 10, 1995;Build 15 "RTN","XQ55SPEC",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified "RTN","XQ55SPEC",4,0) ; "RTN","XQ55SPEC",5,0) ; ROUTINE XQ55 modified to be run from a server option to identify all "RTN","XQ55SPEC",6,0) ; users with access to the OR CPRS GUI CHART option "RTN","XQ55SPEC",7,0) ; "RTN","XQ55SPEC",8,0) INIT ; "RTN","XQ55SPEC",9,0) N XQDT,XQERR,XQISO,XQCOMMNT,XQQUIET,XQLINES,XQOUTPUT,XQPA,XQTOTUSR,XQSELUSR "RTN","XQ55SPEC",10,0) N XQMAIL,XQIRM "RTN","XQ55SPEC",11,0) N DIFROM ; THIS, IF PRESENT, PREVENTS MAIL FROM GOING OUT DURING INSTALLATION "RTN","XQ55SPEC",12,0) S XQMAIL("VAITFOExecLeads@va.gov")="" "RTN","XQ55SPEC",13,0) S XQDSH="-------------------------------------------------------------------------------" "RTN","XQ55SPEC",14,0) D ^XQDATE S XQDT=%Y S XQERR="",XQCOMMNT="",XQQUIET=1,XQLINES=0,XQOUTPUT=$NA(^TMP("XQ55SPEC",$J)) "RTN","XQ55SPEC",15,0) S XQTOTUSR=0,XQSELUSR=0 "RTN","XQ55SPEC",16,0) S XQISO=+$$GET1^DIQ(8989.3,"1,",321.01,"I") D "RTN","XQ55SPEC",17,0) . I +XQISO'>0 S XQERR="NO ENTRY FOR SITE ISO IN FILE 8989.3" Q "RTN","XQ55SPEC",18,0) . I '$$ACTIVE^XUSER(+XQISO) S XQERR="SITE ISO ENTRY IS NOT AN ACTIVE USER" S XQISO=0 "RTN","XQ55SPEC",19,0) . Q "RTN","XQ55SPEC",20,0) S XQIRM=+$$GET1^DIQ(8989.3,"1,",321.02,"I") D "RTN","XQ55SPEC",21,0) . I +XQIRM'>0,XQERR'="" S XQERR=XQERR_" - NO ENTRY FOR IRM CHIEF IN FILE 8989.3" Q "RTN","XQ55SPEC",22,0) . I +XQIRM'>0 S XQERR=XQERR_"NO ENTRY FOR IRM CHIEF IN FILE 8989.3" "RTN","XQ55SPEC",23,0) . I '$$ACTIVE^XUSER(+XQIRM) S XQERR=XQERR_$S(XQERR'="":" - ",1:"")_"SITE IRM CHIEF ENTRY IS NOT AN ACTIVE USER" S XQIRM=0 I +XQISO'>0 Q "RTN","XQ55SPEC",24,0) . S:+XQISO'>0 XQCOMMNT=XQERR_" - SENDING TO SITE IRM CHIEF INSTEAD" S XQERR="" "RTN","XQ55SPEC",25,0) . Q "RTN","XQ55SPEC",26,0) OPT S Y=$$FIND1^DIC(19,"","","OR CPRS GUI CHART") S XQOPT=+Y I XQOPT'>0 S XQERR=XQERR_" - COULD NOT FIND 'OR CPRS GUI CHART' OPTION IN OPTION FILE" G NOOPT "RTN","XQ55SPEC",27,0) MPAT S XQMP=1 ; FORCE listing of paths "RTN","XQ55SPEC",28,0) K ^TMP($J),XQR,XQP,@XQOUTPUT "RTN","XQ55SPEC",29,0) S K=^DIC(19,XQOPT,0),XQHDR="Access to '"_$P(K,U,2)_"' ["_$P(K,U,1)_"]",XQSCD=0,XQCOM=0 ;080115 "RTN","XQ55SPEC",30,0) LOOP1 S K=XQOPT,(L,X(0))=0,XQD=K K XQR,XQA,XQK,XQRV S XQR(K)="" I '$L($P(^DIC(19,K,0),U,3)) D TREE1 "RTN","XQ55SPEC",31,0) G LOOP2 "RTN","XQ55SPEC",32,0) Q "RTN","XQ55SPEC",33,0) TREE S X(L)=$O(^DIC(19,"AD",XQD,X(L))) Q:X(L)'>0 S K=X(L) G:$D(XQR(K)) TREE S XQR(K)="" "RTN","XQ55SPEC",34,0) TREE1 ; "RTN","XQ55SPEC",35,0) S Y(0)=^DIC(19,K,0) G:$L($P(Y(0),U,3)) TREE S:$L($P(Y(0),U,6)) XQK(L)=$P(Y(0),U,6) S XQA(L)=K I $P(Y(0),U,16) S XQRV(L)=^DIC(19,K,3) "RTN","XQ55SPEC",36,0) D SETGLO S L=L+1,X(L)=0,(XQD,XQD(L))=K D TREE "RTN","XQ55SPEC",37,0) Q:L=1 K XQR(XQD(L)) S L=L-1 K XQA(L),XQK(L),XQRV(L) S XQD=XQD(L) G TREE "RTN","XQ55SPEC",38,0) Q "RTN","XQ55SPEC",39,0) SETGLO ; "RTN","XQ55SPEC",40,0) S XQK="" F I=L:-1:0 I $D(XQK(I)),$L(XQK(I)) S XQK=XQK_XQK(I)_"," "RTN","XQ55SPEC",41,0) S XQRV="" F I=L:-1:0 I $D(XQRV(I)),$L(XQRV(I)) S XQRV=XQRV_XQRV(I)_"," "RTN","XQ55SPEC",42,0) S XQA="" F I=L:-1:1 I $D(XQA(I)) S XQA=XQA_XQA(I)_"," "RTN","XQ55SPEC",43,0) S XQA=XQA_XQOPT,J=0 S:$D(^TMP($J,K,0)) J=^(0) S J=J+1,^(0)=J,^TMP($J,K,J)=XQK_U_XQA_U_XQRV "RTN","XQ55SPEC",44,0) Q "RTN","XQ55SPEC",45,0) LOOP2 ; "RTN","XQ55SPEC",46,0) S XQPA(0)=0,XQP=0 F S XQP=$O(^TMP($J,XQP)) Q:XQP="" S XQN=^TMP($J,XQP,0) S XQPS="AP" D USERS S XQPS="AD" D USERS "RTN","XQ55SPEC",47,0) D USERS1 ; 080115 - add in options from the common menu "RTN","XQ55SPEC",48,0) F I=0:0 S I=$O(^VA(200,I)) Q:I'>0 I $$ACTIVE^XUSER(I) S XQTOTUSR=XQTOTUSR+1 "RTN","XQ55SPEC",49,0) G LOOP3 "RTN","XQ55SPEC",50,0) USERS ; "RTN","XQ55SPEC",51,0) S XQU=0 F S XQU=$O(^VA(200,XQPS,XQP,XQU)) Q:XQU'>0 I $D(^VA(200,XQU,.1)),+$$ACTIVE^XUSER(XQU) D EACHU "RTN","XQ55SPEC",52,0) Q "RTN","XQ55SPEC",53,0) ; "RTN","XQ55SPEC",54,0) USERS1 ; 080115 code added to handle options on the COMMON (XUCOMMAND) menu "RTN","XQ55SPEC",55,0) N XUCOMMON "RTN","XQ55SPEC",56,0) S XUCOMMON=$O(^DIC(19,"B","XUCOMMAND",0)) "RTN","XQ55SPEC",57,0) S XQP=0 F S XQP=$O(^TMP($J,XQP)) Q:XQP="" S XQN=^TMP($J,XQP,0) F J=1:1:XQN Q:'$D(^TMP($J,XQP,J)) I $P($P(^TMP($J,XQP,J),U,2),",")=XUCOMMON D "RTN","XQ55SPEC",58,0) . S XQU=0,XQPS="(C)" F S XQU=$O(^VA(200,XQU)) Q:XQU'>0 I $D(^VA(200,XQU,.1)),+$$ACTIVE^XUSER(XQU),$$KEYCHECK() S II=1 D SETU "RTN","XQ55SPEC",59,0) Q "RTN","XQ55SPEC",60,0) ; "RTN","XQ55SPEC",61,0) EACHU ; "RTN","XQ55SPEC",62,0) S II=1 "RTN","XQ55SPEC",63,0) F J=1:1:XQN Q:'$D(^TMP($J,XQP,J)) I $$KEYCHECK() D SETU ; 080115 "RTN","XQ55SPEC",64,0) Q "RTN","XQ55SPEC",65,0) ; "RTN","XQ55SPEC",66,0) KEYCHECK() ; 080115 extracted common code "RTN","XQ55SPEC",67,0) ; returns 1 if user has access to the option, 0 if the user does not have access "RTN","XQ55SPEC",68,0) S XQK=$P(^TMP($J,XQP,J),U,1),XX=$L(XQK,",")-1,XQGO=1 "RTN","XQ55SPEC",69,0) I XX F X=1:1:XX S Y=$P(XQK,",",X) I Y'="",('$D(^XUSEC(Y,XQU))) S XQGO=0 "RTN","XQ55SPEC",70,0) S XQK=$P(^TMP($J,XQP,J),U,3),XX=$L(XQK,",")-1 "RTN","XQ55SPEC",71,0) I XX F X=1:1:XX S Y=$P(XQK,",",X) I Y'="",($D(^XUSEC(Y,XQU))) S XQGO=0 "RTN","XQ55SPEC",72,0) Q XQGO "RTN","XQ55SPEC",73,0) ; "RTN","XQ55SPEC",74,0) SETU ; "RTN","XQ55SPEC",75,0) S XQPA=$P(^TMP($J,XQP,J),U,2) "RTN","XQ55SPEC",76,0) I '$D(XQPA(XQPA)) S I=XQPA(0)+1,XQPA(0)=I,XQPA(0,I)=XQPA,XQPA(XQPA)=I "RTN","XQ55SPEC",77,0) S XQPA(0,XQPA(XQPA),"CNT")=$G(XQPA(0,XQPA(XQPA),"CNT"))+1 "RTN","XQ55SPEC",78,0) S XQPA=XQPA(XQPA) S:XQPS="AD" XQPA=XQPA_"(S)",XQSCD=1 S:XQPS="(C)" XQPA=XQPA_"(C)",XQCOM=1 ; 080115 "RTN","XQ55SPEC",79,0) S I=$P(^VA(200,XQU,0),U,1)_U_XQU S:$D(^TMP($J,0,I)) II=$O(^TMP($J,0,I,"A"),-1)+1 S ^TMP($J,0,I,II)=XQPA "RTN","XQ55SPEC",80,0) Q "RTN","XQ55SPEC",81,0) LOOP3 ; "RTN","XQ55SPEC",82,0) I $O(^TMP($J,0,0))="" D G MUS "RTN","XQ55SPEC",83,0) . N XMY M XMY=XQMAIL S:+XQISO>0 XMY(+XQISO)="" S:+XQIRM>0 XMY(+XQIRM)="" "RTN","XQ55SPEC",84,0) . S XQLINES=XQLINES+1,@XQOUTPUT@(1)="** NO USERS CAN ACCESS THIS OPTION **" "RTN","XQ55SPEC",85,0) . D SEND("SUMMARY",$E(XQOUTPUT,1,$L(XQOUTPUT)-1)_",",.XMY) "RTN","XQ55SPEC",86,0) . Q "RTN","XQ55SPEC",87,0) ; "RTN","XQ55SPEC",88,0) N XQTEXT,XMY "RTN","XQ55SPEC",89,0) S XQTEXT=$E(XQOUTPUT,1,$L(XQOUTPUT)-1)_"," "RTN","XQ55SPEC",90,0) S XQU=0,XQWRITE=0 F S XQU=$O(^TMP($J,0,XQU)) Q:XQU="" D PRTU "RTN","XQ55SPEC",91,0) D SUMMARY M XMY=XQMAIL S:+XQISO>0 XMY(+XQISO)="" S:+XQIRM>0 XMY(+XQIRM)="" D SEND("SUMMARY",XQTEXT,.XMY) "RTN","XQ55SPEC",92,0) D SUMMARY1 "RTN","XQ55SPEC",93,0) I (+XQISO>0)!(+XQIRM>0) D "RTN","XQ55SPEC",94,0) . D HDR "RTN","XQ55SPEC",95,0) . S XQU=0,XQWRITE=1 F S XQU=$O(^TMP($J,0,XQU)) Q:XQU="" D PRTU "RTN","XQ55SPEC",96,0) . K XMY S:+XQISO>0 XMY(+XQISO)="" S:+XQIRM>0 XMY(+XQIRM)="" D SEND("DETAILED",XQTEXT,.XMY) "RTN","XQ55SPEC",97,0) I (+XQISO'>0)&(+XQIRM'>0) D NOISO "RTN","XQ55SPEC",98,0) G MUS "RTN","XQ55SPEC",99,0) HDR ; "RTN","XQ55SPEC",100,0) F I=1:1:4 S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES) "RTN","XQ55SPEC",101,0) S XQTAB=(76-$L(XQHDR))/2,XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,$$SETLINE("?"_XQTAB,XQHDR)) "RTN","XQ55SPEC",102,0) S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES),XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES) "RTN","XQ55SPEC",103,0) S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,$$SETLINE("USER NAME","?27","LAST ON","?37","PRIMARY MENU",$S(XQMP:"?63",1:""),$S(XQMP:"PATH(S)",1:""))) "RTN","XQ55SPEC",104,0) S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,$$SETLINE($E(XQDSH,1,25),"?27",$E(XQDSH,1,8),"?37",$E(XQDSH,1,$S(XQMP:24,1:40)),$S(XQMP:"?63",1:""),$S(XQMP:$E(XQDSH,1,14),1:""))) "RTN","XQ55SPEC",105,0) Q "RTN","XQ55SPEC",106,0) ; "RTN","XQ55SPEC",107,0) WRITEOUT(GLOBAL,LINES,DATALINE) ; GLOBAL CLOSED REF TO GLOBAL "RTN","XQ55SPEC",108,0) S LINES=LINES+1,@GLOBAL@(LINES)=$G(DATALINE) "RTN","XQ55SPEC",109,0) Q LINES "RTN","XQ55SPEC",110,0) ; "RTN","XQ55SPEC",111,0) SETLINE(ARG1,ARG2,ARG3,ARG4,ARG5,ARG6,ARG7,ARG8,ARG9,ARG10) ; "RTN","XQ55SPEC",112,0) N LINE,I,VAR,VAR1 "RTN","XQ55SPEC",113,0) S LINE="" "RTN","XQ55SPEC",114,0) F I=1:1:10 S VAR="ARG"_I X "S VAR1=$G(@VAR)" S:$E(VAR1)="?" VAR1=$$SPACES(LINE,VAR1) S LINE=LINE_VAR1 "RTN","XQ55SPEC",115,0) Q LINE "RTN","XQ55SPEC",116,0) ; "RTN","XQ55SPEC",117,0) SPACES(LINE,SPACNUM) ; "RTN","XQ55SPEC",118,0) N CURLEN,SPACLINE,NSPACES "RTN","XQ55SPEC",119,0) S CURLEN=$L(LINE),SPACLINE="" "RTN","XQ55SPEC",120,0) S NSPACES=$E(SPACNUM,2,99)-CURLEN "RTN","XQ55SPEC",121,0) S $P(SPACLINE," ",NSPACES)=" " "RTN","XQ55SPEC",122,0) Q SPACLINE "RTN","XQ55SPEC",123,0) ; "RTN","XQ55SPEC",124,0) PRTU ; "RTN","XQ55SPEC",125,0) N LINE,J,JJ,K,LINE "RTN","XQ55SPEC",126,0) S LINE="" "RTN","XQ55SPEC",127,0) S J=$P(XQU,U,2),K="" S:$D(^VA(200,J,1.1)) K=$P(^(1.1),"^") S:$L(K) K=$E(K,4,5)_"/"_$E(K,6,7)_"/"_$E(K,2,3) S LINE=$$SETLINE($E($P(XQU,U,1),1,27),"?27",K) "RTN","XQ55SPEC",128,0) I $D(^VA(200,J,201)) S K=+^(201) I K>0,$D(^DIC(19,K,0)) S LINE=$$SETLINE(LINE,"?37",$E($P(^(0),U,1),1,24)) "RTN","XQ55SPEC",129,0) I XQMP D "RTN","XQ55SPEC",130,0) . S LINE=$$SETLINE(LINE,"?63","") "RTN","XQ55SPEC",131,0) . S JJ=$O(^TMP($J,0,XQU,"A"),-1) "RTN","XQ55SPEC",132,0) . F II=1:1:JJ I $G(^TMP($J,0,XQU,II)) S LINE=LINE_$$SETLINE(^TMP($J,0,XQU,II),$S(II'=JJ:",",1:"")) ; 080115 "RTN","XQ55SPEC",133,0) . Q "RTN","XQ55SPEC",134,0) S:XQWRITE XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,LINE) "RTN","XQ55SPEC",135,0) Q "RTN","XQ55SPEC",136,0) SUMMARY ; "RTN","XQ55SPEC",137,0) N I,K,N,LINE "RTN","XQ55SPEC",138,0) S I="" F S I=$O(^TMP($J,0,I)) Q:I="" S XQSELUSR=XQSELUSR+1 "RTN","XQ55SPEC",139,0) ; "RTN","XQ55SPEC",140,0) I '$$PROD^XUPROD(1) D "RTN","XQ55SPEC",141,0) . F I=1:1:4 S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,$$SETLINE("?25","*** TEST ACCOUNT DATA ***")) "RTN","XQ55SPEC",142,0) . F I=1:1:4 S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES) "RTN","XQ55SPEC",143,0) . Q "RTN","XQ55SPEC",144,0) S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,$$SETLINE("'OR CPRS GUI CHART' DISTRIBUTION ANALYSIS FOR: ")) "RTN","XQ55SPEC",145,0) S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES," "_$$STATION()) "RTN","XQ55SPEC",146,0) F I=1:1:4 S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES) "RTN","XQ55SPEC",147,0) I XQERR'="" S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,XQERR),XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES) "RTN","XQ55SPEC",148,0) I XQCOMMNT'="" S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,XQCOMMNT),XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES) "RTN","XQ55SPEC",149,0) S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,XQSELUSR_" USERS WITH ACCESS TO 'OR CPRS GUI CHART'") "RTN","XQ55SPEC",150,0) S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,XQTOTUSR_" ACTIVE USERS TOTAL") "RTN","XQ55SPEC",151,0) Q "RTN","XQ55SPEC",152,0) SUMMARY1 ; "RTN","XQ55SPEC",153,0) F I=1:1:4 S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES) "RTN","XQ55SPEC",154,0) S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,$$SETLINE($E(XQDSH,1,27)," MENU PATH(S) ",$E(XQDSH,1,29))) "RTN","XQ55SPEC",155,0) S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES) "RTN","XQ55SPEC",156,0) S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,"PATH INSTANCES MENU PATH") "RTN","XQ55SPEC",157,0) F I=1:1:XQPA(0) S K=XQPA(0,I) S LINE=$$SETLINE(I,".","?6",XQPA(0,I,"CNT"),"?18") D "RTN","XQ55SPEC",158,0) . F N=1:1 S:'$L($P(K,",",N)) XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,LINE) Q:'$L($P(K,",",N)) S:N>1 LINE=$$SETLINE(LINE," ... ") S LINE=$$SETLINE(LINE,$P(^DIC(19,$P(K,",",N),0),U,1)) "RTN","XQ55SPEC",159,0) . Q "RTN","XQ55SPEC",160,0) I XQSCD S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,"(S) - secondary menu pathway") "RTN","XQ55SPEC",161,0) I XQCOM S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,"(C) - COMMON (XUCOMMAND) menu pathway") "RTN","XQ55SPEC",162,0) Q "RTN","XQ55SPEC",163,0) ; "RTN","XQ55SPEC",164,0) SEND(MSGTYPE,XMTEXT,XMY) ; "RTN","XQ55SPEC",165,0) N XMSUB,XMDUZ "RTN","XQ55SPEC",166,0) S XMSUB=MSGTYPE_" 'GUI CHART' DATA FOR "_$$STATION() "RTN","XQ55SPEC",167,0) I '$$PROD^XUPROD(1) S XMSUB="** TEST ** "_XMSUB "RTN","XQ55SPEC",168,0) S XMDUZ=0.5 "RTN","XQ55SPEC",169,0) D ^XMD "RTN","XQ55SPEC",170,0) Q "RTN","XQ55SPEC",171,0) ; "RTN","XQ55SPEC",172,0) NOOPT ; "RTN","XQ55SPEC",173,0) N XMSUB,XMDUZ,XMY,XQMSG,XMTEXT "RTN","XQ55SPEC",174,0) S XQMSG(1)=XQERR "RTN","XQ55SPEC",175,0) S XMSUB="ERROR 'GUI CHART' DATA FOR "_$$STATION() "RTN","XQ55SPEC",176,0) S XMTEXT="XQMSG(" "RTN","XQ55SPEC",177,0) M XMY=XQMAIL S:+XQISO>0 XMY(+XQISO)="" S:+XQIRM>0 XMY(+XQIRM)="" "RTN","XQ55SPEC",178,0) S XMDUZ=0.5 D ^XMD "RTN","XQ55SPEC",179,0) G MUS "RTN","XQ55SPEC",180,0) ; "RTN","XQ55SPEC",181,0) NOISO ; "RTN","XQ55SPEC",182,0) N XMSUB,XMDUZ,XMY,XQMSG,XQGROUP,XMTEXT "RTN","XQ55SPEC",183,0) S XQMSG(1)="There is no valid entry in file 8989.3 for fields 321.01 OR 321.02" "RTN","XQ55SPEC",184,0) S XQMSG(2)="" "RTN","XQ55SPEC",185,0) S XQMSG(3)="Please correct this since the data is necessary to send a detailed" "RTN","XQ55SPEC",186,0) S XQMSG(4)="report to the local Information Security Officer." "RTN","XQ55SPEC",187,0) S XQMSG(5)="" "RTN","XQ55SPEC",188,0) S XQMSG(6)="Thank you" "RTN","XQ55SPEC",189,0) S XMSUB="ERROR 'GUI CHART' DATA FOR "_$$STATION() "RTN","XQ55SPEC",190,0) S XMTEXT="XQMSG(" "RTN","XQ55SPEC",191,0) M XMY=XQMAIL "RTN","XQ55SPEC",192,0) S XQGROUP=$$FIND1^DIC(3.8,"","","PATCHES") "RTN","XQ55SPEC",193,0) I XQGROUP'>0 S XQGROUP=$$FIND1^DIC(3.8,"","","PATCH") "RTN","XQ55SPEC",194,0) I XQGROUP>0 S XQGROUP=$$GET1^DIQ(3.8,XQGROUP_",",.01),XMY("G."_XQGROUP)="" "RTN","XQ55SPEC",195,0) S XMDUZ=0.5 D ^XMD "RTN","XQ55SPEC",196,0) Q "RTN","XQ55SPEC",197,0) ; "RTN","XQ55SPEC",198,0) STATION() ; "RTN","XQ55SPEC",199,0) Q $$GET1^DIQ(4.2,(+^XTV(8989.3,1,0))_",",.01)_" ("_$$GET1^DIQ(4.2,(+^XTV(8989.3,1,0))_",",5.5)_")" "RTN","XQ55SPEC",200,0) ; "RTN","XQ55SPEC",201,0) MUS ; "RTN","XQ55SPEC",202,0) OUT ; "RTN","XQ55SPEC",203,0) KILL K XQDT,XQGO,XQN,XQP,XQR,XQRV,XQOPT,XQPA,XQUI,XQSCD,XQDSH,XQU,N,K,J,X,XQA,XQD,XQHDR,XQK,XQP,XQPS,XQMP,XQPG,XX "RTN","XQ55SPEC",204,0) K DIC,I,II,JJ,L,POP,Y "RTN","XQ55SPEC",205,0) K D,DG,D0,D1,D2,DICR,DIW,XMDUN,XMZ,XQCOM,XQTAB,XQWRITE "RTN","XQ55SPEC",206,0) Q "RTN","XU8P483") 0^^B648006^n/a "RTN","XU8P483",1,0) XU8P483 ;FO-OAK/JLI-Post-init routine for patch XU*8*483 ;1/30/08 14:20 "RTN","XU8P483",2,0) ;;8.0;KERNEL;**483**;Jul 10, 1995;Build 15 "RTN","XU8P483",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified "RTN","XU8P483",4,0) ; "RTN","XU8P483",5,0) EN ; "RTN","XU8P483",6,0) N XUFDA "RTN","XU8P483",7,0) I +$G(XPDQUES("POS1"))>0 S XUFDA(8989.3,"1,",321.01)=+XPDQUES("POS1") "RTN","XU8P483",8,0) I +$G(XPDQUES("POS2"))>0 S XUFDA(8989.3,"1,",321.02)=+XPDQUES("POS2") "RTN","XU8P483",9,0) I $D(XUFDA) D UPDATE^DIE("","XUFDA") "RTN","XU8P483",10,0) D ^XQ55SPEC "RTN","XU8P483",11,0) Q "VER") 8.0^22.0 "^DD",8989.3,8989.3,321.01,0) FACILITY ISO^*P200'^VA(200,^321;1^S DIC("S")="I $$ACTIVE^XUSER(+Y)>0" D ^DIC K DIC S DIC=$G(DIE),X=+Y K:Y<0 X "^DD",8989.3,8989.3,321.01,3) Select the Facility Information Security Officer "^DD",8989.3,8989.3,321.01,12) ONLY AN ACTIVE USER MAY BE SELECTED "^DD",8989.3,8989.3,321.01,12.1) S DIC("S")="I $$ACTIVE^XUSER(+Y)>0" "^DD",8989.3,8989.3,321.01,21,0) ^^2^2^3080130^ "^DD",8989.3,8989.3,321.01,21,1,0) This field holds a pointer to the facility Information Security Officer in "^DD",8989.3,8989.3,321.01,21,2,0) the NEW PERSON file (#200). "^DD",8989.3,8989.3,321.01,"DT") 3080130 "^DD",8989.3,8989.3,321.02,0) FACILITY CIO^*P200'^VA(200,^321;2^S DIC("S")="I $$ACTIVE^XUSER(+Y)>0" D ^DIC K DIC S DIC=$G(DIE),X=+Y K:Y<0 X "^DD",8989.3,8989.3,321.02,3) Enter the name of the Facility CIO. "^DD",8989.3,8989.3,321.02,12) ONLY AN ACTIVE USER MAY BE SELECTED "^DD",8989.3,8989.3,321.02,12.1) S DIC("S")="I $$ACTIVE^XUSER(+Y)>0" "^DD",8989.3,8989.3,321.02,21,0) ^^2^2^3080130^ "^DD",8989.3,8989.3,321.02,21,1,0) This field holds a pointer to the facility CIO in the NEW PERSON file "^DD",8989.3,8989.3,321.02,21,2,0) (#200) "^DD",8989.3,8989.3,321.02,"DT") 3080130 "BLD",1054,6) ^389 **END** **END**