XQARPRT1 ;JLI/OAK_OIFO-ROUTINE TO PROVIDE COUNTS OF ALERTS ; Oct 03, 2022@03:26:24
;;8.0;KERNEL;**316,338,631,690,777**;Jul 10, 1995;Build 1
;Per VA Directive 6402, this routine should not be modified.
; based on an original routine AMNUALT
EN1 ; OPT - generates a listing of the number of alerts a user has as well as last sign-on date, number of critical and/or abnomal imaging alerts, and the date of the oldest alert
N XQACRIT S XQACRIT=0
EN2 ;
N XQASDT,XQAEDT,XQAC1,XQAORDER,Y,DIR,%ZIS,POP,ZTSAVE,ZTDESC,ZTRTN
N SHOWDIV,DIVISION,I,DATE,DIRUT,SERVICE,SERVSRT,ALLSERV,XQAWORDS,XQAQTVAR
I 'XQACRIT D WORDS^XQARPRT2("A") K Y
S DIR(0)="NO",DIR("A")="Display users whose "_$S(XQACRIT:"CRITICAL ",1:"")_"ALERT count is at least"
S DIR("B")=$S(XQACRIT:10,1:100) D ^DIR K DIR Q:Y'>0 S XQAC1=Y
D DATES Q:Y'>0
D QUERYDIV Q:$D(DIRUT) D ORDER Q:XQAORDER'>0
S %ZIS="MQ" D ^%ZIS Q:POP I $D(IO("Q")) K IO("Q") S ZTRTN="DQ1^XQARPRT1",ZTDESC="How Many "_$S(XQACRIT:"Critical ",1:"")_"Alerts",ZTSAVE("*")="" D ^%ZTLOAD W:$G(ZTSK)>0 !,"Task number is ",ZTSK K ZTSK Q
G DQ1
;
CRITICAL ; OPT - generates a listing of users with more than a specified number of alerts containing CRITICAL or ABNORMAL IMAGING
N XQACRIT S XQACRIT=1
G EN2
;
DATES ;
S DIR(0)="DO^::EX",DIR("A")="START DATE" ; Add "EX" to require eXact data and Echo input, XU*8*690
D ^DIR K DIR Q:Y'>0
S XQASDT=Y
S DIR(0)="DO^::EX"_XQASDT_":DT",DIR("A")="END DATE" ; Add "EX" to require eXact data and Echo input, XU*8*690
D ^DIR K DIR Q:Y'>0
S XQAEDT=Y_".24"
Q
;
QUERYDIV ;
S DIR(0)="Y",DIR("A")="Breakout by One or More Divisions",DIR("?")="Entering YES will result in the entries being grouped by DIVISION." D ^DIR K DIR S DIVISION=+Y Q:$D(DIRUT)
I DIVISION D Q:SHOWDIV'>0
. S DIR(0)="Y",DIR("A")="Show ALL Divisions",DIR("?",1)="Entering YES will result in the analysis being performed for ALL Divisons,",DIR("?")="A NO will result in prompts to select which division(S) you want listed."
. D ^DIR K DIR I +Y D I 1
. . S DIR(0)="S^1:Show only as 'Multiple Division';2:Show in EACH Division",DIR("A")="If a user has more than one division"
. . S DIR("?",1)="If New Person entries have multiple divisions, entering 1 will result in",DIR("?",2)="those entries being shown only under a heading of 'These users are assigned"
. . S DIR("?",3)="to multiple divisions', while entering 2 will result in the data for a",DIR("?",4)="specific New Person entry being shown under each division heading which",DIR("?")="that entry may select."
. . D ^DIR K DIR S SHOWDIV=+Y
. . Q
. E S SHOWDIV=2 D K DIRUT
. . F I=1:1 S DIR(0)="PO^4:EMZ",DIR("A")="Select "_$S(I>1:"Another ",1:"")_"Division: " D ^DIR K DIR Q:Y'>0 S DIVISION($P(Y,U,2))=""
. Q
Q
;
ORDER ;
S DIR(0)="SO^;1:By Name;2:By Number;3:By Service/Section;",DIR("A")="Select the ordering of results desired",DIR("?",1)="Select a number to indicate how you would like the selected entries to be"
S DIR("?",2)="listed by"_$S(DIVISION:" (Within Division)",1:"")_": the New Person entrie's Name; the Number of "_$S(DIVISION:"",1:$S(XQACRIT:"Critical ",1:"")_"Alerts,")
S DIR("?")=$S(DIVISION:$S(XQACRIT:"Critical ",1:"")_"Alerts, ",1:"")_"or by Service/Section"
D ^DIR K DIR S XQAORDER=+Y
I XQAORDER=3 D Q:$D(DIRUT)
. S DIR(0)="Y",DIR("A")="Show ALL Service/Sections",DIR("?",1)="Entering YES will result in the analysis being performed for ALL Services,",DIR("?")="A NO will result in prompts to select which Service(s) you want listed."
. D ^DIR K DIR Q:$D(DIRUT) S ALLSERV=+Y
. I 'ALLSERV D
. . S DIR(0)="PO^49:EMZ" F I=1:1 S DIR("A")="Select "_$S(I>1:"Another ",1:"")_"Service/Section" D ^DIR Q:Y'>0 S SERVICE($E($P(Y,U,2),1,17))=""
. . K DIR
. . Q
. S DIR(0)="S^;1:By Name;2:By Number;",DIR("A")="Within Service/Section order results by" D ^DIR K DIR S:$D(DIRUT) XQAORDER=0 Q:$D(DIRUT) S SERVSRT=+Y
. Q
Q
;
DQ1 ;
N XQAGLOB,XQAN1
S XQAGLOB=$NA(^TMP("XQARPRT1",$J)) K @XQAGLOB
U IO
D G1,PRT
I '$D(ZTQUEUED),+$G(XQAQTVAR)'>0 W ! U IO(0) S DIR(0)="E" D ^DIR K DIR W ! U IO ; XU*8*690 - Pause end of user terminal report
D ^%ZISC
K @XQAGLOB
Q
;
G1 ;gather
N COUNT,MSG,DATE,CRITMSG
F XQAN1=0:0 S XQAN1=$O(^XTV(8992,XQAN1)) Q:XQAN1'>0 D
. S COUNT=0,OLDEST=0,NCRIT=0 F I=0:0 S I=$O(^XTV(8992,XQAN1,"XQA",I)) Q:I'>0 D
. . S DATE=$P($P(^XTV(8992,XQAN1,"XQA",I,0),U,2),";",3) S:OLDEST=0 OLDEST=DATE\1 I (DATE<XQASDT)!(DATE>XQAEDT) Q
. . S MSG=$$UP^XLFSTR($P(^XTV(8992,XQAN1,"XQA",I,0),U,3))
. . S CRITMSG=$G(^XTV(8992,XQAN1,"XQA",I,0)) I CRITMSG'="" D ; begin P631
. . I $D(XQAWORDS)'>0 S COUNT=COUNT+1 I $$CHKCRIT^XQALSUR2(CRITMSG) S NCRIT=NCRIT+1
. . I $D(XQAWORDS)>1 D I MSG'="" S COUNT=COUNT+1
. . . N MSG1,I,J S MSG1=MSG F J=0:0 S J=$O(XQAWORDS(J)) Q:J'>0 S MSG=MSG1 D Q:MSG'=""
. . . . F I=0:0 S I=$O(XQAWORDS(J,I)) Q:I'>0 D I MSG'[XQAWORDS(J,I) S MSG="" Q
. . . . . I $D(XQAWORDS)>1,MSG[XQAWORDS(J,I),$$CHKCRIT^XQALSUR2(CRITMSG) S NCRIT=NCRIT+1
. . . . . Q
. . . . Q
. . . Q
. . Q ; end P631
. I $S(XQACRIT:NCRIT,1:COUNT)<XQAC1 Q
. S VALUE=COUNT_U_XQAN1_U_$$FMTE^XLFDT(OLDEST,"5DZ")_U_NCRIT_U_$$GET1^DIQ(200,XQAN1_",",.01)
. I DIVISION D I 1
. . K XQARRAY,XQADIV S XQADIV=0 D GETS^DIQ(200,XQAN1_",","16*","","XQARRAY") S:'$D(XQARRAY) XQADIV(0)="",XQADIV=1 I $D(XQARRAY) D
. . . N K,L S K="" F S K=$O(XQARRAY(200.02,K)) Q:K="" D
. . . . I $D(DIVISION)'>1 S XQADIV(XQARRAY(200.02,K,.01))="",XQADIV=XQADIV+1
. . . . E S L=XQARRAY(200.02,K,.01) I $D(DIVISION(L))>0 S XQADIV(L)="",XQADIV=XQADIV+1
. . . I XQADIV>1,SHOWDIV=1 K XQADIV S XQADIV(99999)="",XQADIV=1
. . . Q
. . S K=$S($D(DIVISION)'>1:"",1:0) F S K=$O(XQADIV(K)) Q:K="" S @XQAGLOB@("DIV",K,"NAME",$$GET1^DIQ(200,XQAN1_",",.01)_XQAN1)=VALUE
. . Q
. E S @XQAGLOB@("NAME",$$GET1^DIQ(200,XQAN1_",",.01)_XQAN1)=VALUE
. Q
Q
;
PRT ;print
N NAME,NUMBER,LSIGNON,VALUE,XQAGLOB1,DIVNAME,XQAFP,XQASVCFP
S (XQAFP,XQASVCFP)=1
S XQAGLOB1=XQAGLOB
I DIVISION D I 1
. S DIVNAME="" F S DIVNAME=$O(@XQAGLOB@("DIV",DIVNAME)) Q:DIVNAME="" S XQAGLOB1=$NA(@XQAGLOB@("DIV",DIVNAME)) D HEADER,PRTLOC
E D HEADER,PRTLOC
Q
;
PRTLOC ;
N PRTLOC
S PRTLOC=$S(XQAORDER=1:"PRTNAME",XQAORDER=2:"PRTNUMBR",1:"PRTSERVC") D @PRTLOC
Q
;
N XQACTR SET XQACTR=0 ; XU*8*690 - For WORDHDR^XQARPRT2
I '$D(ZTQUEUED) W @IOF ; XU*8*690 - Initial FormFeed for home device (screen)
I $D(ZTQUEUED),'XQAFP W @IOF ; XU*8*690 - FormFeed page when queued (Printer)
S XQAFP=0
W " COUNT of ",$S($D(XQAWORDS)>1:"SELECTED ",1:""),"ALERTS - users with more than ",XQAC1," on ",$$FMTE^XLFDT($$NOW^XLFDT())
W !," for date range ",$$FMTE^XLFDT(XQASDT,"5DZ")," to ",$$FMTE^XLFDT(XQAEDT,"5DZ")
W !,"CRIT column indicates number of alerts containing critical text"
D WORDHDR^XQARPRT2
W !!,?42,$S($D(XQAWORDS)>1:"Selected",1:" Total"),?70,"Oldest"
W !,"Name",?25,"Service/section",?43,"Alerts",?50,"Last Sign-on",?64,"CRIT Alert"
W !,"-----------------",?25,"-----------------",?43,"------",?50,"------------",?64,"---- ----------"
I $D(DIVNAME) D DIVPRINT
Q
;
PRTNAME ;
N NAME,NUMBER,VALUE,XQAN1,NCRIT,OLDEST,LSIGNON,FSTNOSVC
S FSTNOSVC=0 ; XU*8*690 - LIMIT ERROR tracking
S NAME="" F S NAME=$O(@XQAGLOB1@("NAME",NAME)) Q:NAME="" S VALUE=@XQAGLOB1@("NAME",NAME) D PRINTVAL(0,.FSTNOSVC) Q:+$G(XQAQTVAR)>0 ; XU*8*690 - Quit on Terminal pause
Q
;
PRTNUMBR ;
N NAME,NUMBER,NUMB,VALUE,XQAN1,NCRIT,OLDEST,LSIGNON,FSTNOSVC
S FSTNOSVC=0 ; XU*8*690 - LIMIT ERROR tracking
S NAME="" F S NAME=$O(@XQAGLOB1@("NAME",NAME)) Q:NAME="" Q:+$G(XQAQTVAR)>0 D ; XU*8*690 - Quit on Terminal pause
. S NUMBER=$S(XQACRIT:$P(@XQAGLOB1@("NAME",NAME),U,4),1:+@XQAGLOB1@("NAME",NAME))
. S @XQAGLOB1@("NUMB",100000-NUMBER,NAME)=@XQAGLOB1@("NAME",NAME)
. Q
N NUMB
S NUMB=""
F S NUMB=$O(@XQAGLOB1@("NUMB",NUMB)) Q:NUMB="" Q:+$G(XQAQTVAR)>0 S NAME="" DO
. F S NAME=$O(@XQAGLOB1@("NUMB",NUMB,NAME)) Q:NAME="" Q:+$G(XQAQTVAR)>0 DO
. . S VALUE=@XQAGLOB1@("NUMB",NUMB,NAME) D PRINTVAL(0,.FSTNOSVC) ; XU*8*690 - Quit on Terminal pause
Q
;
PRTSERVC ;
N NAME,NUMBER,NUMB,VALUE,XQAN1,NCRIT,OLDEST,LSIGNON,FSTNOSVC
S FSTNOSVC=0 ; XU*8*690 - LIMIT ERROR tracking
S NAME=""
F S NAME=$O(@XQAGLOB1@("NAME",NAME)) Q:NAME="" Q:+$G(XQAQTVAR)>0 D ; XU*8*690 - Quit on Terminal pause
. S XQAN1=$P(@XQAGLOB1@("NAME",NAME),U,2)
. S SERVICE=$E($$GET1^DIQ(200,XQAN1_",",29),1,17) I SERVICE="" S SERVICE="<No Service>"
. I ALLSERV!$D(SERVICE(SERVICE)) D
. . I SERVSRT=1 S @XQAGLOB1@("SERV",SERVICE,NAME)=@XQAGLOB1@("NAME",NAME) Q
. . I SERVSRT=2 S @XQAGLOB1@("SERV",SERVICE,"NUMB",100000-@XQAGLOB1@("NAME",NAME),NAME)=@XQAGLOB1@("NAME",NAME)
. . Q
. Q
S SERVICE=""
F S SERVICE=$O(@XQAGLOB1@("SERV",SERVICE)) Q:SERVICE="" Q:+$G(XQAQTVAR)>0 D ; XU*8*690 - Quit on Terminal pause
. SET XQASVCFP=0
. I SERVSRT=1 DO
. . S NAME=""
. . F S NAME=$O(@XQAGLOB1@("SERV",SERVICE,NAME)) Q:NAME="" Q:+$G(XQAQTVAR)>0 DO
. . . S VALUE=@XQAGLOB1@("SERV",SERVICE,NAME)
. . . D PRINTVAL($$CHKSRV(XQAGLOB1,SERVICE,NAME,"NAME"),.FSTNOSVC) ; XU*8*690 - Terminal pause last service item
. I SERVSRT=2 DO
. . F NUMB=0:0 S NUMB=$O(@XQAGLOB1@("SERV",SERVICE,"NUMB",NUMB)) Q:+NUMB'>0 Q:+$G(XQAQTVAR)>0 D ; XU*8*690 - Quit on Terminal pause
. . . S NAME=""
. . . F S NAME=$O(@XQAGLOB1@("SERV",SERVICE,"NUMB",NUMB,NAME)) Q:NAME="" Q:+$G(XQAQTVAR)>0 DO
. . . . S VALUE=@XQAGLOB1@("SERV",SERVICE,"NUMB",NUMB,NAME)
. . . . D PRINTVAL($$CHKSRV(XQAGLOB1,SERVICE,NAME,"NUMB",NUMB),.FSTNOSVC) ; XU*8*690 - Terminal pause last service item
. . Q
. Q
Q
;
CHKSRV(XQAGLOB1,XQASRVC,XQACNAME,XQATYPE,XQANUM) ; Determine change to SERVICE/SECTION, XU*8*690
; Input:
; XQAGLOB1 - Value of ^TMP global root
; XQASRVC - Current Service
; XQASNAME - Current Name
; XQATYPE - Type of Report ("NUMB", "NAME")
; XQANUM - Number of Alerts (For Service report on Number)
;
; Result:
; 0 - Service did not change
; 1 - Service changed
;
N RESULT,NXTSERV,XQANNAME,XQANNUM
S (CHKCNT,RESULT)=0
I XQATYPE="NAME" DO
. SET:$O(@XQAGLOB1@("SERV",XQASRVC,XQACNAME))="" RESULT=1
. IF RESULT=1 DO
. . SET:$O(@XQAGLOB1@("SERV",XQASRVC))="" RESULT=0
;
I XQATYPE="NUMB" DO
. SET XQANNAME=$O(@XQAGLOB1@("SERV",XQASRVC,"NUMB",XQANUM,XQACNAME))
. IF XQANNAME="" DO
. . SET XQANNUM=$O(@XQAGLOB1@("SERV",XQASRVC,"NUMB",XQANUM))
. . IF XQANNUM="" DO
. . . SET NXTSERVC=$O(@XQAGLOB1@("SERV",XQASRVC))
. . . IF (NXTSERVC'=XQASRVC),(NXTSERVC'="") SET RESULT=1
Q RESULT
;
PRINTVAL(XQAPAWS,FSTNOSVC) ;Print report value
; Input ; Add to indicate if report needs page break, XU*8*690
; XQAPAWS - 1: New Service
; 0: Same Service
; FSTNOSVC - 1: First line (No Service) written after ERROR LIMIT exceeded
; 0: First line NOT written after ERROR LIMIT exceeded
;
N NAME,SRVERRCT,XQAWRTER
S NUMBER=+VALUE,XQAN1=$P(VALUE,U,2),NCRIT=$P(VALUE,U,4),OLDEST=$P(VALUE,U,3),NAME=$P(VALUE,U,5)
S SERVICE=$E($$GET1^DIQ(200,XQAN1_",",29),1,17)
;
IF SERVICE="" DO ;XU*8*690 - Report <No Service> - SERVICE/SECTION not defined for user, Error Trap
. NEW XQANOTES,XQAZTR,XQAFCNT,XQAZTEN
. SET SERVICE="<No Service>"
. SET XQAZTEN=$O(^%ZTER(3.077,"B",$E("Undefined SERVICE/SECTION Err",1,30),0))
. IF 'XQAZTEN SET SRVERRCT=1
. IF XQAZTEN DO
. . SET SRVERRCT=0
. . SET XQAZTR=$G(^%ZTER(3.077,XQAZTEN,4,+$H,0))
. . FOR XQAFCNT=1:1:24 S SRVERRCT=SRVERRCT+$P(XQAZTR,"~",XQAFCNT)
. . SET SRVERRCT=SRVERRCT+1
. SET XQAWRTER=(SRVERRCT>$$XQZMAXER()) ;Error limit reached?
. ;XQANOTES array = "ERROR description for inclusion in ERROR trap"
. SET XQANOTES("PROGRAMMER",1,"WHAT HAPPENED")="Kernel Alerts Report included a user with a pending alert that did NOT have a SERVICE/SECTION in the New Person File."
. SET XQANOTES("PROGRAMMER",2,"MENU REPORT OPTION")=$P($G(XQY0),"^",1,2)
. SET XQANOTES("PROGRAMMER",3,"PROBLEM")="SERVICE/SECTION is a required field for all active VistA Users."
. SET XQANOTES("PROGRAMMER",4,"REPORT NOTES",1)="Rerunning the report with the parameters in this log may or may not report all of the users missing SERVICE/SECTION."
. SET XQANOTES("PROGRAMMER",4,"REPORT NOTES",2)="Users with alerts that have been processed since this log was recorded will not be reported."
. IF SRVERRCT=$$XQZMAXER() DO
. . SET XQANOTES("PROGRAMMER",4,"REPORT NOTES",3)="The MENU REPORT OPTION will only create an Error Trap log for the first "_$$XQZMAXER()_" users missing SERVICE/SECTION."
. . SET XQANOTES("PROGRAMMER",4,"REPORT NOTES",4)="The daily Error Trap limit of "_$$XQZMAXER()_" is determined by the KERNEL SYSTEM PARAMETERS file (#8989.3), ERROR LIMIT field(#520.1)."
. . SET XQANOTES("PROGRAMMER",4,"REPORT NOTES",5)="The MENU REPORT OPTION includes a message after the limit of "_$$XQZMAXER()_" users missing SERVICE/SECTION is reached."
. . SET XQANOTES("PROGRAMMER",4,"REPORT NOTES",6)="When user number "_($$XQZMAXER()+1)_" missing SERVICE/SECTION is reported, the message is printed on the report but Error Traps are not logged."
. . SET XQANOTES("PROGRAMMER",4,"REPORT NOTES",7)="1st Message on report: 'Daily Error Trap limit is "_$$XQZMAXER()_" errors for users missing SERVICE/SECTION.'"
. . SET XQANOTES("PROGRAMMER",4,"REPORT NOTES",8)="2nd Message on report: Limit Reached. 'No more entries will be added for '<No Service>' users today!'"
. . SET XQANOTES("PROGRAMMER",4,"REPORT NOTES",9)="Any users on the report following that message will not be recorded in the Error Trap."
. ;D APPERROR^%ZTER("Undefined SERVICE/SECTION Err") ;p777 comment out.
;
S LSIGNON=$$GET1^DIQ(200,XQAN1_",",202)
I LSIGNON["@" S LSIGNON=$P(LSIGNON,"@")
I $Y>(IOSL-5) DO
. I '$D(ZTQUEUED) W ! DO XQAPAUS(.XQAQTVAR)
. I +$G(XQAQTVAR)'>0 D HEADER
;
I +$G(XQAQTVAR)'>0 DO
. ;XU*8*690 - Error trap limit exceeded
. IF (SERVICE="<No Service>"),(+$$XQZMAXER()>0) DO ;Errors limited
. . IF (SRVERRCT=($$XQZMAXER()+1)) DO
. . . W !," Daily Error Trap limit is "_$$XQZMAXER()_" errors for users missing SERVICE/SECTION."
. . . W !," Limit Reached. No more entries will be added for '<No Service>' users today!"
. . . SET FSTNOSVC=1
. . IF XQAWRTER,'FSTNOSVC DO ;Error limit reached before report
. . . W !," Daily Error Trap limit is "_$$XQZMAXER()_" errors for users missing SERVICE/SECTION."
. . . W !," Limit Reached. No more entries will be added for '<No Service>' users today!"
. . . SET FSTNOSVC=1
. W !,NAME,?25,SERVICE,?43,NUMBER,?50,LSIGNON,?64,NCRIT,?69,OLDEST
;
I $G(XQAPAWS)>0 DO
. I '$D(ZTQUEUED) W ! DO XQAPAUS(.XQAQTVAR)
. I +$G(XQAQTVAR)'>0 D HEADER
Q
;
XQAPAUS(XQAQTVAR) ;; Pause API, XU*8*690
U IO(0) S DIR(0)="E" D ^DIR
IF $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) SET XQAQTVAR=1
KILL DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
Q
;
XQZMAXER() ;;Return KERNEL SYSTEM PARAMETER file (#8989.3) ERROR LIMIT field (#520.1), XU*8*690
Q +$P($G(^XTV(8989.3,1,"ZTER"),"10"),"^",1)
;
DIVPRINT ;
I $Y>(IOSL-6) D HEADER
W !,?5,"Division: ",$S(DIVNAME=0:"These users are not assigned to a division",DIVNAME=99999:"These users are assigned to multiple divisions",1:DIVNAME)
Q
;
OLDEST() ; Returns date of oldest entry in alert tracking file
N OLDEST,I,J,FND
; Use cross-ref, since if user data used to create entries in tracking file oldest may not be first in file
; Make sure cross-ref is valid
S FND=0 F I=0:0 Q:FND S I=$O(^XTV(8992.1,"D",I)) Q:I'>0 F J=0:0 S J=$O(^XTV(8992.1,"D",I,J)) Q:J'>0 I $D(^XTV(8992.1,J,0)) S FND=1 Q
S OLDEST=I S:OLDEST'>0 OLDEST=DT+1
Q OLDEST\1
;
VIEWTRAK ; OPT. View an entry in the Alert Tracking file in Captioned mode
N DIR,X0,X1,DAARRAY
S X0=$O(^XTV(8992.1,0)),X1=$P(^XTV(8992.1,0),U,3)
S DIR(0)="NO^"_X0_":"_X1
F I=1:1 S DIR("A")=$S(I>1:"Another ",1:"")_"Internal Entry number in Alert Tracking File" D ^DIR K DIRUT Q:Y'>0 S DAARRAY(I)=+Y
K DIR Q:$D(DAARRAY)'>1
S %ZIS="MQ" D ^%ZIS Q:POP I $D(IO("Q")) K IO("Q") S ZTRTN="VIEWDQ^XQARPRT1",ZTDESC="List data from Alert Tracking file",ZTSAVE("*")="" D ^%ZTLOAD W:$G(ZTSK)>0 !,"Task number is ",ZTSK K ZTSK Q
;
VIEWDQ ;
N DIC,DA,DIC,XQAI,DR,DIQ
W @IOF
S DIQ(0)="CR"
F XQAI=0:0 S XQAI=$O(DAARRAY(XQAI)) Q:XQAI'>0 D
. S DA=DAARRAY(XQAI),DIC="^XTV(8992.1," D EN^DIQ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQARPRT1 16412 printed Sep 23, 2025@19:41:38 Page 2
XQARPRT1 ;JLI/OAK_OIFO-ROUTINE TO PROVIDE COUNTS OF ALERTS ; Oct 03, 2022@03:26:24
+1 ;;8.0;KERNEL;**316,338,631,690,777**;Jul 10, 1995;Build 1
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ; based on an original routine AMNUALT
EN1 ; OPT - generates a listing of the number of alerts a user has as well as last sign-on date, number of critical and/or abnomal imaging alerts, and the date of the oldest alert
+1 NEW XQACRIT
SET XQACRIT=0
EN2 ;
+1 NEW XQASDT,XQAEDT,XQAC1,XQAORDER,Y,DIR,%ZIS,POP,ZTSAVE,ZTDESC,ZTRTN
+2 NEW SHOWDIV,DIVISION,I,DATE,DIRUT,SERVICE,SERVSRT,ALLSERV,XQAWORDS,XQAQTVAR
+3 IF 'XQACRIT
DO WORDS^XQARPRT2("A")
KILL Y
+4 SET DIR(0)="NO"
SET DIR("A")="Display users whose "_$SELECT(XQACRIT:"CRITICAL ",1:"")_"ALERT count is at least"
+5 SET DIR("B")=$SELECT(XQACRIT:10,1:100)
DO ^DIR
KILL DIR
if Y'>0
QUIT
SET XQAC1=Y
+6 DO DATES
if Y'>0
QUIT
+7 DO QUERYDIV
if $DATA(DIRUT)
QUIT
DO ORDER
if XQAORDER'>0
QUIT
+8 SET %ZIS="MQ"
DO ^%ZIS
if POP
QUIT
IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="DQ1^XQARPRT1"
SET ZTDESC="How Many "_$SELECT(XQACRIT:"Critical ",1:"")_"Alerts"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
if $GET(ZTSK)>0
WRITE !,"Task number is ",ZTSK
KILL ZTSK
QUIT
+9 GOTO DQ1
+10 ;
CRITICAL ; OPT - generates a listing of users with more than a specified number of alerts containing CRITICAL or ABNORMAL IMAGING
+1 NEW XQACRIT
SET XQACRIT=1
+2 GOTO EN2
+3 ;
DATES ;
+1 ; Add "EX" to require eXact data and Echo input, XU*8*690
SET DIR(0)="DO^::EX"
SET DIR("A")="START DATE"
+2 DO ^DIR
KILL DIR
if Y'>0
QUIT
+3 SET XQASDT=Y
+4 ; Add "EX" to require eXact data and Echo input, XU*8*690
SET DIR(0)="DO^::EX"_XQASDT_":DT"
SET DIR("A")="END DATE"
+5 DO ^DIR
KILL DIR
if Y'>0
QUIT
+6 SET XQAEDT=Y_".24"
+7 QUIT
+8 ;
QUERYDIV ;
+1 SET DIR(0)="Y"
SET DIR("A")="Breakout by One or More Divisions"
SET DIR("?")="Entering YES will result in the entries being grouped by DIVISION."
DO ^DIR
KILL DIR
SET DIVISION=+Y
if $DATA(DIRUT)
QUIT
+2 IF DIVISION
Begin DoDot:1
+3 SET DIR(0)="Y"
SET DIR("A")="Show ALL Divisions"
SET DIR("?",1)="Entering YES will result in the analysis being performed for ALL Divisons,"
SET DIR("?")="A NO will result in prompts to select which division(S) you want listed."
+4 DO ^DIR
KILL DIR
IF +Y
Begin DoDot:2
+5 SET DIR(0)="S^1:Show only as 'Multiple Division';2:Show in EACH Division"
SET DIR("A")="If a user has more than one division"
+6 SET DIR("?",1)="If New Person entries have multiple divisions, entering 1 will result in"
SET DIR("?",2)="those entries being shown only under a heading of 'These users are assigned"
+7 SET DIR("?",3)="to multiple divisions', while entering 2 will result in the data for a"
SET DIR("?",4)="specific New Person entry being shown under each division heading which"
SET DIR("?")="that entry may select."
+8 DO ^DIR
KILL DIR
SET SHOWDIV=+Y
+9 QUIT
End DoDot:2
IF 1
+10 IF '$TEST
SET SHOWDIV=2
Begin DoDot:2
+11 FOR I=1:1
SET DIR(0)="PO^4:EMZ"
SET DIR("A")="Select "_$SELECT(I>1:"Another ",1:"")_"Division: "
DO ^DIR
KILL DIR
if Y'>0
QUIT
SET DIVISION($PIECE(Y,U,2))=""
End DoDot:2
KILL DIRUT
+12 QUIT
End DoDot:1
if SHOWDIV'>0
QUIT
+13 QUIT
+14 ;
ORDER ;
+1 SET DIR(0)="SO^;1:By Name;2:By Number;3:By Service/Section;"
SET DIR("A")="Select the ordering of results desired"
SET DIR("?",1)="Select a number to indicate how you would like the selected entries to be"
+2 SET DIR("?",2)="listed by"_$SELECT(DIVISION:" (Within Division)",1:"")_": the New Person entrie's Name; the Number of "_$SELECT(DIVISION:"",1:$SELECT(XQACRIT:"Critical ",1:"")_"Alerts,")
+3 SET DIR("?")=$SELECT(DIVISION:$SELECT(XQACRIT:"Critical ",1:"")_"Alerts, ",1:"")_"or by Service/Section"
+4 DO ^DIR
KILL DIR
SET XQAORDER=+Y
+5 IF XQAORDER=3
Begin DoDot:1
+6 SET DIR(0)="Y"
SET DIR("A")="Show ALL Service/Sections"
SET DIR("?",1)="Entering YES will result in the analysis being performed for ALL Services,"
SET DIR("?")="A NO will result in prompts to select which Service(s) you want listed."
+7 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
SET ALLSERV=+Y
+8 IF 'ALLSERV
Begin DoDot:2
+9 SET DIR(0)="PO^49:EMZ"
FOR I=1:1
SET DIR("A")="Select "_$SELECT(I>1:"Another ",1:"")_"Service/Section"
DO ^DIR
if Y'>0
QUIT
SET SERVICE($EXTRACT($PIECE(Y,U,2),1,17))=""
+10 KILL DIR
+11 QUIT
End DoDot:2
+12 SET DIR(0)="S^;1:By Name;2:By Number;"
SET DIR("A")="Within Service/Section order results by"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
SET XQAORDER=0
if $DATA(DIRUT)
QUIT
SET SERVSRT=+Y
+13 QUIT
End DoDot:1
if $DATA(DIRUT)
QUIT
+14 QUIT
+15 ;
DQ1 ;
+1 NEW XQAGLOB,XQAN1
+2 SET XQAGLOB=$NAME(^TMP("XQARPRT1",$JOB))
KILL @XQAGLOB
+3 USE IO
+4 DO G1
DO PRT
+5 ; XU*8*690 - Pause end of user terminal report
IF '$DATA(ZTQUEUED)
IF +$GET(XQAQTVAR)'>0
WRITE !
USE IO(0)
SET DIR(0)="E"
DO ^DIR
KILL DIR
WRITE !
USE IO
+6 DO ^%ZISC
+7 KILL @XQAGLOB
+8 QUIT
+9 ;
G1 ;gather
+1 NEW COUNT,MSG,DATE,CRITMSG
+2 FOR XQAN1=0:0
SET XQAN1=$ORDER(^XTV(8992,XQAN1))
if XQAN1'>0
QUIT
Begin DoDot:1
+3 SET COUNT=0
SET OLDEST=0
SET NCRIT=0
FOR I=0:0
SET I=$ORDER(^XTV(8992,XQAN1,"XQA",I))
if I'>0
QUIT
Begin DoDot:2
+4 SET DATE=$PIECE($PIECE(^XTV(8992,XQAN1,"XQA",I,0),U,2),";",3)
if OLDEST=0
SET OLDEST=DATE\1
IF (DATE<XQASDT)!(DATE>XQAEDT)
QUIT
+5 SET MSG=$$UP^XLFSTR($PIECE(^XTV(8992,XQAN1,"XQA",I,0),U,3))
+6 ; begin P631
SET CRITMSG=$GET(^XTV(8992,XQAN1,"XQA",I,0))
IF CRITMSG'=""
Begin DoDot:3
End DoDot:3
+7 IF $DATA(XQAWORDS)'>0
SET COUNT=COUNT+1
IF $$CHKCRIT^XQALSUR2(CRITMSG)
SET NCRIT=NCRIT+1
+8 IF $DATA(XQAWORDS)>1
Begin DoDot:3
+9 NEW MSG1,I,J
SET MSG1=MSG
FOR J=0:0
SET J=$ORDER(XQAWORDS(J))
if J'>0
QUIT
SET MSG=MSG1
Begin DoDot:4
+10 FOR I=0:0
SET I=$ORDER(XQAWORDS(J,I))
if I'>0
QUIT
Begin DoDot:5
+11 IF $DATA(XQAWORDS)>1
IF MSG[XQAWORDS(J,I)
IF $$CHKCRIT^XQALSUR2(CRITMSG)
SET NCRIT=NCRIT+1
+12 QUIT
End DoDot:5
IF MSG'[XQAWORDS(J,I)
SET MSG=""
QUIT
+13 QUIT
End DoDot:4
if MSG'=""
QUIT
+14 QUIT
End DoDot:3
IF MSG'=""
SET COUNT=COUNT+1
+15 ; end P631
QUIT
End DoDot:2
+16 IF $SELECT(XQACRIT:NCRIT,1:COUNT)<XQAC1
QUIT
+17 SET VALUE=COUNT_U_XQAN1_U_$$FMTE^XLFDT(OLDEST,"5DZ")_U_NCRIT_U_$$GET1^DIQ(200,XQAN1_",",.01)
+18 IF DIVISION
Begin DoDot:2
+19 KILL XQARRAY,XQADIV
SET XQADIV=0
DO GETS^DIQ(200,XQAN1_",","16*","","XQARRAY")
if '$DATA(XQARRAY)
SET XQADIV(0)=""
SET XQADIV=1
IF $DATA(XQARRAY)
Begin DoDot:3
+20 NEW K,L
SET K=""
FOR
SET K=$ORDER(XQARRAY(200.02,K))
if K=""
QUIT
Begin DoDot:4
+21 IF $DATA(DIVISION)'>1
SET XQADIV(XQARRAY(200.02,K,.01))=""
SET XQADIV=XQADIV+1
+22 IF '$TEST
SET L=XQARRAY(200.02,K,.01)
IF $DATA(DIVISION(L))>0
SET XQADIV(L)=""
SET XQADIV=XQADIV+1
End DoDot:4
+23 IF XQADIV>1
IF SHOWDIV=1
KILL XQADIV
SET XQADIV(99999)=""
SET XQADIV=1
+24 QUIT
End DoDot:3
+25 SET K=$SELECT($DATA(DIVISION)'>1:"",1:0)
FOR
SET K=$ORDER(XQADIV(K))
if K=""
QUIT
SET @XQAGLOB@("DIV",K,"NAME",$$GET1^DIQ(200,XQAN1_",",.01)_XQAN1)=VALUE
+26 QUIT
End DoDot:2
IF 1
+27 IF '$TEST
SET @XQAGLOB@("NAME",$$GET1^DIQ(200,XQAN1_",",.01)_XQAN1)=VALUE
+28 QUIT
End DoDot:1
+29 QUIT
+30 ;
PRT ;print
+1 NEW NAME,NUMBER,LSIGNON,VALUE,XQAGLOB1,DIVNAME,XQAFP,XQASVCFP
+2 SET (XQAFP,XQASVCFP)=1
+3 SET XQAGLOB1=XQAGLOB
+4 IF DIVISION
Begin DoDot:1
+5 SET DIVNAME=""
FOR
SET DIVNAME=$ORDER(@XQAGLOB@("DIV",DIVNAME))
if DIVNAME=""
QUIT
SET XQAGLOB1=$NAME(@XQAGLOB@("DIV",DIVNAME))
DO HEADER
DO PRTLOC
End DoDot:1
IF 1
+6 IF '$TEST
DO HEADER
DO PRTLOC
+7 QUIT
+8 ;
PRTLOC ;
+1 NEW PRTLOC
+2 SET PRTLOC=$SELECT(XQAORDER=1:"PRTNAME",XQAORDER=2:"PRTNUMBR",1:"PRTSERVC")
DO @PRTLOC
+3 QUIT
+4 ;
+1 ; XU*8*690 - For WORDHDR^XQARPRT2
NEW XQACTR
SET XQACTR=0
+2 ; XU*8*690 - Initial FormFeed for home device (screen)
IF '$DATA(ZTQUEUED)
WRITE @IOF
+3 ; XU*8*690 - FormFeed page when queued (Printer)
IF $DATA(ZTQUEUED)
IF 'XQAFP
WRITE @IOF
+4 SET XQAFP=0
+5 WRITE " COUNT of ",$SELECT($DATA(XQAWORDS)>1:"SELECTED ",1:""),"ALERTS - users with more than ",XQAC1," on ",$$FMTE^XLFDT($$NOW^XLFDT())
+6 WRITE !," for date range ",$$FMTE^XLFDT(XQASDT,"5DZ")," to ",$$FMTE^XLFDT(XQAEDT,"5DZ")
+7 WRITE !,"CRIT column indicates number of alerts containing critical text"
+8 DO WORDHDR^XQARPRT2
+9 WRITE !!,?42,$SELECT($DATA(XQAWORDS)>1:"Selected",1:" Total"),?70,"Oldest"
+10 WRITE !,"Name",?25,"Service/section",?43,"Alerts",?50,"Last Sign-on",?64,"CRIT Alert"
+11 WRITE !,"-----------------",?25,"-----------------",?43,"------",?50,"------------",?64,"---- ----------"
+12 IF $DATA(DIVNAME)
DO DIVPRINT
+13 QUIT
+14 ;
PRTNAME ;
+1 NEW NAME,NUMBER,VALUE,XQAN1,NCRIT,OLDEST,LSIGNON,FSTNOSVC
+2 ; XU*8*690 - LIMIT ERROR tracking
SET FSTNOSVC=0
+3 ; XU*8*690 - Quit on Terminal pause
SET NAME=""
FOR
SET NAME=$ORDER(@XQAGLOB1@("NAME",NAME))
if NAME=""
QUIT
SET VALUE=@XQAGLOB1@("NAME",NAME)
DO PRINTVAL(0,.FSTNOSVC)
if +$GET(XQAQTVAR)>0
QUIT
+4 QUIT
+5 ;
PRTNUMBR ;
+1 NEW NAME,NUMBER,NUMB,VALUE,XQAN1,NCRIT,OLDEST,LSIGNON,FSTNOSVC
+2 ; XU*8*690 - LIMIT ERROR tracking
SET FSTNOSVC=0
+3 ; XU*8*690 - Quit on Terminal pause
SET NAME=""
FOR
SET NAME=$ORDER(@XQAGLOB1@("NAME",NAME))
if NAME=""
QUIT
if +$GET(XQAQTVAR)>0
QUIT
Begin DoDot:1
+4 SET NUMBER=$SELECT(XQACRIT:$PIECE(@XQAGLOB1@("NAME",NAME),U,4),1:+@XQAGLOB1@("NAME",NAME))
+5 SET @XQAGLOB1@("NUMB",100000-NUMBER,NAME)=@XQAGLOB1@("NAME",NAME)
+6 QUIT
End DoDot:1
+7 NEW NUMB
+8 SET NUMB=""
+9 FOR
SET NUMB=$ORDER(@XQAGLOB1@("NUMB",NUMB))
if NUMB=""
QUIT
if +$GET(XQAQTVAR)>0
QUIT
SET NAME=""
Begin DoDot:1
+10 FOR
SET NAME=$ORDER(@XQAGLOB1@("NUMB",NUMB,NAME))
if NAME=""
QUIT
if +$GET(XQAQTVAR)>0
QUIT
Begin DoDot:2
+11 ; XU*8*690 - Quit on Terminal pause
SET VALUE=@XQAGLOB1@("NUMB",NUMB,NAME)
DO PRINTVAL(0,.FSTNOSVC)
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
PRTSERVC ;
+1 NEW NAME,NUMBER,NUMB,VALUE,XQAN1,NCRIT,OLDEST,LSIGNON,FSTNOSVC
+2 ; XU*8*690 - LIMIT ERROR tracking
SET FSTNOSVC=0
+3 SET NAME=""
+4 ; XU*8*690 - Quit on Terminal pause
FOR
SET NAME=$ORDER(@XQAGLOB1@("NAME",NAME))
if NAME=""
QUIT
if +$GET(XQAQTVAR)>0
QUIT
Begin DoDot:1
+5 SET XQAN1=$PIECE(@XQAGLOB1@("NAME",NAME),U,2)
+6 SET SERVICE=$EXTRACT($$GET1^DIQ(200,XQAN1_",",29),1,17)
IF SERVICE=""
SET SERVICE="<No Service>"
+7 IF ALLSERV!$DATA(SERVICE(SERVICE))
Begin DoDot:2
+8 IF SERVSRT=1
SET @XQAGLOB1@("SERV",SERVICE,NAME)=@XQAGLOB1@("NAME",NAME)
QUIT
+9 IF SERVSRT=2
SET @XQAGLOB1@("SERV",SERVICE,"NUMB",100000-@XQAGLOB1@("NAME",NAME),NAME)=@XQAGLOB1@("NAME",NAME)
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 SET SERVICE=""
+13 ; XU*8*690 - Quit on Terminal pause
FOR
SET SERVICE=$ORDER(@XQAGLOB1@("SERV",SERVICE))
if SERVICE=""
QUIT
if +$GET(XQAQTVAR)>0
QUIT
Begin DoDot:1
+14 SET XQASVCFP=0
+15 IF SERVSRT=1
Begin DoDot:2
+16 SET NAME=""
+17 FOR
SET NAME=$ORDER(@XQAGLOB1@("SERV",SERVICE,NAME))
if NAME=""
QUIT
if +$GET(XQAQTVAR)>0
QUIT
Begin DoDot:3
+18 SET VALUE=@XQAGLOB1@("SERV",SERVICE,NAME)
+19 ; XU*8*690 - Terminal pause last service item
DO PRINTVAL($$CHKSRV(XQAGLOB1,SERVICE,NAME,"NAME"),.FSTNOSVC)
End DoDot:3
End DoDot:2
+20 IF SERVSRT=2
Begin DoDot:2
+21 ; XU*8*690 - Quit on Terminal pause
FOR NUMB=0:0
SET NUMB=$ORDER(@XQAGLOB1@("SERV",SERVICE,"NUMB",NUMB))
if +NUMB'>0
QUIT
if +$GET(XQAQTVAR)>0
QUIT
Begin DoDot:3
+22 SET NAME=""
+23 FOR
SET NAME=$ORDER(@XQAGLOB1@("SERV",SERVICE,"NUMB",NUMB,NAME))
if NAME=""
QUIT
if +$GET(XQAQTVAR)>0
QUIT
Begin DoDot:4
+24 SET VALUE=@XQAGLOB1@("SERV",SERVICE,"NUMB",NUMB,NAME)
+25 ; XU*8*690 - Terminal pause last service item
DO PRINTVAL($$CHKSRV(XQAGLOB1,SERVICE,NAME,"NUMB",NUMB),.FSTNOSVC)
End DoDot:4
End DoDot:3
+26 QUIT
End DoDot:2
+27 QUIT
End DoDot:1
+28 QUIT
+29 ;
CHKSRV(XQAGLOB1,XQASRVC,XQACNAME,XQATYPE,XQANUM) ; Determine change to SERVICE/SECTION, XU*8*690
+1 ; Input:
+2 ; XQAGLOB1 - Value of ^TMP global root
+3 ; XQASRVC - Current Service
+4 ; XQASNAME - Current Name
+5 ; XQATYPE - Type of Report ("NUMB", "NAME")
+6 ; XQANUM - Number of Alerts (For Service report on Number)
+7 ;
+8 ; Result:
+9 ; 0 - Service did not change
+10 ; 1 - Service changed
+11 ;
+12 NEW RESULT,NXTSERV,XQANNAME,XQANNUM
+13 SET (CHKCNT,RESULT)=0
+14 IF XQATYPE="NAME"
Begin DoDot:1
+15 if $ORDER(@XQAGLOB1@("SERV",XQASRVC,XQACNAME))=""
SET RESULT=1
+16 IF RESULT=1
Begin DoDot:2
+17 if $ORDER(@XQAGLOB1@("SERV",XQASRVC))=""
SET RESULT=0
End DoDot:2
End DoDot:1
+18 ;
+19 IF XQATYPE="NUMB"
Begin DoDot:1
+20 SET XQANNAME=$ORDER(@XQAGLOB1@("SERV",XQASRVC,"NUMB",XQANUM,XQACNAME))
+21 IF XQANNAME=""
Begin DoDot:2
+22 SET XQANNUM=$ORDER(@XQAGLOB1@("SERV",XQASRVC,"NUMB",XQANUM))
+23 IF XQANNUM=""
Begin DoDot:3
+24 SET NXTSERVC=$ORDER(@XQAGLOB1@("SERV",XQASRVC))
+25 IF (NXTSERVC'=XQASRVC)
IF (NXTSERVC'="")
SET RESULT=1
End DoDot:3
End DoDot:2
End DoDot:1
+26 QUIT RESULT
+27 ;
PRINTVAL(XQAPAWS,FSTNOSVC) ;Print report value
+1 ; Input ; Add to indicate if report needs page break, XU*8*690
+2 ; XQAPAWS - 1: New Service
+3 ; 0: Same Service
+4 ; FSTNOSVC - 1: First line (No Service) written after ERROR LIMIT exceeded
+5 ; 0: First line NOT written after ERROR LIMIT exceeded
+6 ;
+7 NEW NAME,SRVERRCT,XQAWRTER
+8 SET NUMBER=+VALUE
SET XQAN1=$PIECE(VALUE,U,2)
SET NCRIT=$PIECE(VALUE,U,4)
SET OLDEST=$PIECE(VALUE,U,3)
SET NAME=$PIECE(VALUE,U,5)
+9 SET SERVICE=$EXTRACT($$GET1^DIQ(200,XQAN1_",",29),1,17)
+10 ;
+11 ;XU*8*690 - Report <No Service> - SERVICE/SECTION not defined for user, Error Trap
IF SERVICE=""
Begin DoDot:1
+12 NEW XQANOTES,XQAZTR,XQAFCNT,XQAZTEN
+13 SET SERVICE="<No Service>"
+14 SET XQAZTEN=$ORDER(^%ZTER(3.077,"B",$EXTRACT("Undefined SERVICE/SECTION Err",1,30),0))
+15 IF 'XQAZTEN
SET SRVERRCT=1
+16 IF XQAZTEN
Begin DoDot:2
+17 SET SRVERRCT=0
+18 SET XQAZTR=$GET(^%ZTER(3.077,XQAZTEN,4,+$HOROLOG,0))
+19 FOR XQAFCNT=1:1:24
SET SRVERRCT=SRVERRCT+$PIECE(XQAZTR,"~",XQAFCNT)
+20 SET SRVERRCT=SRVERRCT+1
End DoDot:2
+21 ;Error limit reached?
SET XQAWRTER=(SRVERRCT>$$XQZMAXER())
+22 ;XQANOTES array = "ERROR description for inclusion in ERROR trap"
+23 SET XQANOTES("PROGRAMMER",1,"WHAT HAPPENED")="Kernel Alerts Report included a user with a pending alert that did NOT have a SERVICE/SECTION in the New Person File."
+24 SET XQANOTES("PROGRAMMER",2,"MENU REPORT OPTION")=$PIECE($GET(XQY0),"^",1,2)
+25 SET XQANOTES("PROGRAMMER",3,"PROBLEM")="SERVICE/SECTION is a required field for all active VistA Users."
+26 SET XQANOTES("PROGRAMMER",4,"REPORT NOTES",1)="Rerunning the report with the parameters in this log may or may not report all of the users missing SERVICE/SECTION."
+27 SET XQANOTES("PROGRAMMER",4,"REPORT NOTES",2)="Users with alerts that have been processed since this log was recorded will not be reported."
+28 IF SRVERRCT=$$XQZMAXER()
Begin DoDot:2
+29 SET XQANOTES("PROGRAMMER",4,"REPORT NOTES",3)="The MENU REPORT OPTION will only create an Error Trap log for the first "_$$XQZMAXER()_" users missing SERVICE/SECTION."
+30 SET XQANOTES("PROGRAMMER",4,"REPORT NOTES",4)="The daily Error Trap limit of "_$$XQZMAXER()_" is determined by the KERNEL SYSTEM PARAMETERS file (#8989.3), ERROR LIMIT field(#520.1)."
+31 SET XQANOTES("PROGRAMMER",4,"REPORT NOTES",5)="The MENU REPORT OPTION includes a message after the limit of "_$$XQZMAXER()_" users missing SERVICE/SECTION is reached."
+32 SET XQANOTES("PROGRAMMER",4,"REPORT NOTES",6)="When user number "_($$XQZMAXER()+1)_" missing SERVICE/SECTION is reported, the message is printed on the report but Error Traps are not logged."
+33 SET XQANOTES("PROGRAMMER",4,"REPORT NOTES",7)="1st Message on report: 'Daily Error Trap limit is "_$$XQZMAXER()_" errors for users missing SERVICE/SECTION.'"
+34 SET XQANOTES("PROGRAMMER",4,"REPORT NOTES",8)="2nd Message on report: Limit Reached. 'No more entries will be added for '<No Service>' users today!'"
+35 SET XQANOTES("PROGRAMMER",4,"REPORT NOTES",9)="Any users on the report following that message will not be recorded in the Error Trap."
End DoDot:2
+36 ;D APPERROR^%ZTER("Undefined SERVICE/SECTION Err") ;p777 comment out.
End DoDot:1
+37 ;
+38 SET LSIGNON=$$GET1^DIQ(200,XQAN1_",",202)
+39 IF LSIGNON["@"
SET LSIGNON=$PIECE(LSIGNON,"@")
+40 IF $Y>(IOSL-5)
Begin DoDot:1
+41 IF '$DATA(ZTQUEUED)
WRITE !
DO XQAPAUS(.XQAQTVAR)
+42 IF +$GET(XQAQTVAR)'>0
DO HEADER
End DoDot:1
+43 ;
+44 IF +$GET(XQAQTVAR)'>0
Begin DoDot:1
+45 ;XU*8*690 - Error trap limit exceeded
+46 ;Errors limited
IF (SERVICE="<No Service>")
IF (+$$XQZMAXER()>0)
Begin DoDot:2
+47 IF (SRVERRCT=($$XQZMAXER()+1))
Begin DoDot:3
+48 WRITE !," Daily Error Trap limit is "_$$XQZMAXER()_" errors for users missing SERVICE/SECTION."
+49 WRITE !," Limit Reached. No more entries will be added for '<No Service>' users today!"
+50 SET FSTNOSVC=1
End DoDot:3
+51 ;Error limit reached before report
IF XQAWRTER
IF 'FSTNOSVC
Begin DoDot:3
+52 WRITE !," Daily Error Trap limit is "_$$XQZMAXER()_" errors for users missing SERVICE/SECTION."
+53 WRITE !," Limit Reached. No more entries will be added for '<No Service>' users today!"
+54 SET FSTNOSVC=1
End DoDot:3
End DoDot:2
+55 WRITE !,NAME,?25,SERVICE,?43,NUMBER,?50,LSIGNON,?64,NCRIT,?69,OLDEST
End DoDot:1
+56 ;
+57 IF $GET(XQAPAWS)>0
Begin DoDot:1
+58 IF '$DATA(ZTQUEUED)
WRITE !
DO XQAPAUS(.XQAQTVAR)
+59 IF +$GET(XQAQTVAR)'>0
DO HEADER
End DoDot:1
+60 QUIT
+61 ;
XQAPAUS(XQAQTVAR) ;; Pause API, XU*8*690
+1 USE IO(0)
SET DIR(0)="E"
DO ^DIR
+2 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
SET XQAQTVAR=1
+3 KILL DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+4 QUIT
+5 ;
XQZMAXER() ;;Return KERNEL SYSTEM PARAMETER file (#8989.3) ERROR LIMIT field (#520.1), XU*8*690
+1 QUIT +$PIECE($GET(^XTV(8989.3,1,"ZTER"),"10"),"^",1)
+2 ;
DIVPRINT ;
+1 IF $Y>(IOSL-6)
DO HEADER
+2 WRITE !,?5,"Division: ",$SELECT(DIVNAME=0:"These users are not assigned to a division",DIVNAME=99999:"These users are assigned to multiple divisions",1:DIVNAME)
+3 QUIT
+4 ;
OLDEST() ; Returns date of oldest entry in alert tracking file
+1 NEW OLDEST,I,J,FND
+2 ; Use cross-ref, since if user data used to create entries in tracking file oldest may not be first in file
+3 ; Make sure cross-ref is valid
+4 SET FND=0
FOR I=0:0
if FND
QUIT
SET I=$ORDER(^XTV(8992.1,"D",I))
if I'>0
QUIT
FOR J=0:0
SET J=$ORDER(^XTV(8992.1,"D",I,J))
if J'>0
QUIT
IF $DATA(^XTV(8992.1,J,0))
SET FND=1
QUIT
+5 SET OLDEST=I
if OLDEST'>0
SET OLDEST=DT+1
+6 QUIT OLDEST\1
+7 ;
VIEWTRAK ; OPT. View an entry in the Alert Tracking file in Captioned mode
+1 NEW DIR,X0,X1,DAARRAY
+2 SET X0=$ORDER(^XTV(8992.1,0))
SET X1=$PIECE(^XTV(8992.1,0),U,3)
+3 SET DIR(0)="NO^"_X0_":"_X1
+4 FOR I=1:1
SET DIR("A")=$SELECT(I>1:"Another ",1:"")_"Internal Entry number in Alert Tracking File"
DO ^DIR
KILL DIRUT
if Y'>0
QUIT
SET DAARRAY(I)=+Y
+5 KILL DIR
if $DATA(DAARRAY)'>1
QUIT
+6 SET %ZIS="MQ"
DO ^%ZIS
if POP
QUIT
IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="VIEWDQ^XQARPRT1"
SET ZTDESC="List data from Alert Tracking file"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
if $GET(ZTSK)>0
WRITE !,"Task number is ",ZTSK
KILL ZTSK
QUIT
+7 ;
VIEWDQ ;
+1 NEW DIC,DA,DIC,XQAI,DR,DIQ
+2 WRITE @IOF
+3 SET DIQ(0)="CR"
+4 FOR XQAI=0:0
SET XQAI=$ORDER(DAARRAY(XQAI))
if XQAI'>0
QUIT
Begin DoDot:1
+5 SET DA=DAARRAY(XQAI)
SET DIC="^XTV(8992.1,"
DO EN^DIQ
End DoDot:1
+6 QUIT
