XQ55SPEC ; SEA/JLI - SEARCH FOR USERS WITH ACCESS TO 'OR CPRS GUI CHART' ;1/29/08  15:02
 ;;8.0;KERNEL;**483**;Jul 10, 1995;Build 15
 ;;Per VHA Directive 2004-038, this routine should not be modified
 ;
 ; ROUTINE XQ55 modified to be run from a server option to identify all
 ; users with access to the OR CPRS GUI CHART option
 ;
INIT ;
 N XQDT,XQERR,XQISO,XQCOMMNT,XQQUIET,XQLINES,XQOUTPUT,XQPA,XQTOTUSR,XQSELUSR
 N XQMAIL,XQIRM
 N DIFROM ; THIS, IF PRESENT, PREVENTS MAIL FROM GOING OUT DURING INSTALLATION
 S XQMAIL("VAITFOExecLeads@va.gov")=""
 S XQDSH="-------------------------------------------------------------------------------"
 D ^XQDATE S XQDT=%Y S XQERR="",XQCOMMNT="",XQQUIET=1,XQLINES=0,XQOUTPUT=$NA(^TMP("XQ55SPEC",$J))
 S XQTOTUSR=0,XQSELUSR=0
 S XQISO=+$$GET1^DIQ(8989.3,"1,",321.01,"I") D
 . I +XQISO'>0 S XQERR="NO ENTRY FOR SITE ISO IN FILE 8989.3" Q
 . I '$$ACTIVE^XUSER(+XQISO) S XQERR="SITE ISO ENTRY IS NOT AN ACTIVE USER" S XQISO=0
 . Q
 S XQIRM=+$$GET1^DIQ(8989.3,"1,",321.02,"I") D
 . I +XQIRM'>0,XQERR'="" S XQERR=XQERR_" - NO ENTRY FOR IRM CHIEF IN FILE 8989.3" Q
 . I +XQIRM'>0 S XQERR=XQERR_"NO ENTRY FOR IRM CHIEF IN FILE 8989.3"
 . 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
 . S:+XQISO'>0 XQCOMMNT=XQERR_" - SENDING TO SITE IRM CHIEF INSTEAD" S XQERR=""
 . Q
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
MPAT S XQMP=1 ; FORCE listing of paths
 K ^TMP($J),XQR,XQP,@XQOUTPUT
 S K=^DIC(19,XQOPT,0),XQHDR="Access to '"_$P(K,U,2)_"'  ["_$P(K,U,1)_"]",XQSCD=0,XQCOM=0 ;080115
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
 G LOOP2
 Q
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)=""
TREE1 ;
 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)
 D SETGLO S L=L+1,X(L)=0,(XQD,XQD(L))=K D TREE
 Q:L=1  K XQR(XQD(L)) S L=L-1 K XQA(L),XQK(L),XQRV(L) S XQD=XQD(L) G TREE
 Q
SETGLO ;
 S XQK="" F I=L:-1:0 I $D(XQK(I)),$L(XQK(I)) S XQK=XQK_XQK(I)_","
 S XQRV="" F I=L:-1:0 I $D(XQRV(I)),$L(XQRV(I)) S XQRV=XQRV_XQRV(I)_","
 S XQA="" F I=L:-1:1 I $D(XQA(I)) S XQA=XQA_XQA(I)_","
 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
 Q
LOOP2 ;
 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
 D USERS1 ; 080115 - add in options from the common menu
 F I=0:0 S I=$O(^VA(200,I)) Q:I'>0  I $$ACTIVE^XUSER(I) S XQTOTUSR=XQTOTUSR+1
 G LOOP3
USERS ;
 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
 Q
 ;
USERS1 ; 080115 code added to handle options on the COMMON (XUCOMMAND) menu
 N XUCOMMON
 S XUCOMMON=$O(^DIC(19,"B","XUCOMMAND",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
 . 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
 Q
 ;
EACHU ;
 S II=1
 F J=1:1:XQN Q:'$D(^TMP($J,XQP,J))  I $$KEYCHECK() D SETU ; 080115
 Q
 ;
KEYCHECK() ; 080115 extracted common code
 ; returns 1 if user has access to the option, 0 if the user does not have access
 S XQK=$P(^TMP($J,XQP,J),U,1),XX=$L(XQK,",")-1,XQGO=1
 I XX F X=1:1:XX S Y=$P(XQK,",",X) I Y'="",('$D(^XUSEC(Y,XQU))) S XQGO=0
 S XQK=$P(^TMP($J,XQP,J),U,3),XX=$L(XQK,",")-1
 I XX F X=1:1:XX S Y=$P(XQK,",",X) I Y'="",($D(^XUSEC(Y,XQU))) S XQGO=0
 Q XQGO
 ;
SETU ;
 S XQPA=$P(^TMP($J,XQP,J),U,2)
 I '$D(XQPA(XQPA)) S I=XQPA(0)+1,XQPA(0)=I,XQPA(0,I)=XQPA,XQPA(XQPA)=I
 S XQPA(0,XQPA(XQPA),"CNT")=$G(XQPA(0,XQPA(XQPA),"CNT"))+1
 S XQPA=XQPA(XQPA) S:XQPS="AD" XQPA=XQPA_"(S)",XQSCD=1 S:XQPS="(C)" XQPA=XQPA_"(C)",XQCOM=1 ; 080115
 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
 Q
LOOP3 ;
 I $O(^TMP($J,0,0))="" D  G MUS
 . N XMY M XMY=XQMAIL S:+XQISO>0 XMY(+XQISO)="" S:+XQIRM>0 XMY(+XQIRM)=""
 . S XQLINES=XQLINES+1,@XQOUTPUT@(1)="** NO USERS CAN ACCESS THIS OPTION **"
 . D SEND("SUMMARY",$E(XQOUTPUT,1,$L(XQOUTPUT)-1)_",",.XMY)
 . Q
 ;
 N XQTEXT,XMY
 S XQTEXT=$E(XQOUTPUT,1,$L(XQOUTPUT)-1)_","
 S XQU=0,XQWRITE=0 F  S XQU=$O(^TMP($J,0,XQU)) Q:XQU=""  D PRTU
 D SUMMARY M XMY=XQMAIL S:+XQISO>0 XMY(+XQISO)="" S:+XQIRM>0 XMY(+XQIRM)="" D SEND("SUMMARY",XQTEXT,.XMY)
 D SUMMARY1
 I (+XQISO>0)!(+XQIRM>0) D
 . D HDR
 . S XQU=0,XQWRITE=1 F  S XQU=$O(^TMP($J,0,XQU)) Q:XQU=""  D PRTU
 . K XMY S:+XQISO>0 XMY(+XQISO)="" S:+XQIRM>0 XMY(+XQIRM)="" D SEND("DETAILED",XQTEXT,.XMY)
 I (+XQISO'>0)&(+XQIRM'>0) D NOISO
 G MUS
HDR ;
 F I=1:1:4 S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES)
 S XQTAB=(76-$L(XQHDR))/2,XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,$$SETLINE("?"_XQTAB,XQHDR))
 S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES),XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES)
 S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,$$SETLINE("USER NAME","?27","LAST ON","?37","PRIMARY MENU",$S(XQMP:"?63",1:""),$S(XQMP:"PATH(S)",1:"")))
 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:"")))
 Q
 ;
WRITEOUT(GLOBAL,LINES,DATALINE) ; GLOBAL CLOSED REF TO GLOBAL
 S LINES=LINES+1,@GLOBAL@(LINES)=$G(DATALINE)
 Q LINES
 ;
SETLINE(ARG1,ARG2,ARG3,ARG4,ARG5,ARG6,ARG7,ARG8,ARG9,ARG10) ;
 N LINE,I,VAR,VAR1
 S LINE=""
 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
 Q LINE
 ;
SPACES(LINE,SPACNUM) ;
 N CURLEN,SPACLINE,NSPACES
 S CURLEN=$L(LINE),SPACLINE=""
 S NSPACES=$E(SPACNUM,2,99)-CURLEN
 S $P(SPACLINE," ",NSPACES)=" "
 Q SPACLINE
 ;
PRTU ;
 N LINE,J,JJ,K,LINE
 S LINE=""
 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)
 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))
 I XQMP D
 . S LINE=$$SETLINE(LINE,"?63","")
 . S JJ=$O(^TMP($J,0,XQU,"A"),-1)
 . 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
 . Q
 S:XQWRITE XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,LINE)
 Q
SUMMARY ;
 N I,K,N,LINE
 S I="" F  S I=$O(^TMP($J,0,I)) Q:I=""  S XQSELUSR=XQSELUSR+1
 ;
 I '$$PROD^XUPROD(1) D
 . F I=1:1:4 S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,$$SETLINE("?25","***  TEST ACCOUNT DATA  ***"))
 . F I=1:1:4 S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES)
 . Q
 S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,$$SETLINE("'OR CPRS GUI CHART' DISTRIBUTION ANALYSIS FOR:  "))
 S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,"    "_$$STATION())
 F I=1:1:4 S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES)
 I XQERR'="" S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,XQERR),XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES)
 I XQCOMMNT'="" S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,XQCOMMNT),XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES)
 S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,XQSELUSR_" USERS WITH ACCESS TO 'OR CPRS GUI CHART'")
 S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,XQTOTUSR_" ACTIVE USERS TOTAL")
 Q
SUMMARY1 ;
 F I=1:1:4 S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES)
 S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,$$SETLINE($E(XQDSH,1,27),"     MENU PATH(S)     ",$E(XQDSH,1,29)))
 S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES)
 S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,"PATH  INSTANCES  MENU PATH")
 F I=1:1:XQPA(0) S K=XQPA(0,I) S LINE=$$SETLINE(I,".","?6",XQPA(0,I,"CNT"),"?18") D
 . 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))
 . Q
 I XQSCD S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,"(S) - secondary menu pathway")
 I XQCOM S XQLINES=$$WRITEOUT(XQOUTPUT,XQLINES,"(C) - COMMON (XUCOMMAND) menu pathway")
 Q
 ;
SEND(MSGTYPE,XMTEXT,XMY) ;
 N XMSUB,XMDUZ
 S XMSUB=MSGTYPE_" 'GUI CHART' DATA FOR "_$$STATION()
 I '$$PROD^XUPROD(1) S XMSUB="** TEST ** "_XMSUB
 S XMDUZ=0.5
 D ^XMD
 Q
 ;
NOOPT ;
 N XMSUB,XMDUZ,XMY,XQMSG,XMTEXT
 S XQMSG(1)=XQERR
 S XMSUB="ERROR 'GUI CHART' DATA FOR "_$$STATION()
 S XMTEXT="XQMSG("
 M XMY=XQMAIL S:+XQISO>0 XMY(+XQISO)="" S:+XQIRM>0 XMY(+XQIRM)=""
 S XMDUZ=0.5 D ^XMD
 G MUS
 ;
NOISO ;
 N XMSUB,XMDUZ,XMY,XQMSG,XQGROUP,XMTEXT
 S XQMSG(1)="There is no valid entry in file 8989.3 for fields 321.01 OR 321.02"
 S XQMSG(2)=""
 S XQMSG(3)="Please correct this since the data is necessary to send a detailed"
 S XQMSG(4)="report to the local Information Security Officer."
 S XQMSG(5)=""
 S XQMSG(6)="Thank you"
 S XMSUB="ERROR 'GUI CHART' DATA FOR "_$$STATION()
 S XMTEXT="XQMSG("
 M XMY=XQMAIL
 S XQGROUP=$$FIND1^DIC(3.8,"","","PATCHES")
 I XQGROUP'>0 S XQGROUP=$$FIND1^DIC(3.8,"","","PATCH")
 I XQGROUP>0 S XQGROUP=$$GET1^DIQ(3.8,XQGROUP_",",.01),XMY("G."_XQGROUP)=""
 S XMDUZ=0.5 D ^XMD
 Q
 ;
STATION() ;
 Q $$GET1^DIQ(4.2,(+^XTV(8989.3,1,0))_",",.01)_" ("_$$GET1^DIQ(4.2,(+^XTV(8989.3,1,0))_",",5.5)_")"
 ;
MUS ;
OUT ;
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
 K DIC,I,II,JJ,L,POP,Y
 K D,DG,D0,D1,D2,DICR,DIW,XMDUN,XMZ,XQCOM,XQTAB,XQWRITE
 Q