XQARPRT1 ;sgh/mtz,JLI/OAK_OIFO-ROUTINE TO PROVIDE COUNTS OF ALERTS ;9/3/03 11:17
;;8.0;KERNEL;**316,338,631**;Jul 10, 1995;Build 6
;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
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",DIR("A")="START DATE"
D ^DIR K DIR Q:Y'>0
S XQASDT=Y
S DIR(0)="DO^"_XQASDT_":DT",DIR("A")="END DATE"
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)="SO^;1:By Name;2:By Number;",DIR("A")="Within Service/Section order results by" D ^DIR K DIR 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
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
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 S XQACTR=0
W @IOF 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 CRITICAL alerts and ABNORMAL IMAGING alerts"
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
S NAME="" F S NAME=$O(@XQAGLOB1@("NAME",NAME)) Q:NAME="" S VALUE=@XQAGLOB1@("NAME",NAME) D PRINTVAL
Q
;
PRTNUMBR ;
N NAME,NUMBER,NUMB,VALUE,XQAN1,NCRIT,OLDEST,LSIGNON
S NAME="" F S NAME=$O(@XQAGLOB1@("NAME",NAME)) Q:NAME="" D
. 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="" S NAME="" F S NAME=$O(@XQAGLOB1@("NUMB",NUMB,NAME)) Q:NAME="" S VALUE=@XQAGLOB1@("NUMB",NUMB,NAME) D PRINTVAL
Q
;
PRTSERVC ;
N NAME,NUMBER,NUMB,VALUE,XQAN1,NCRIT,OLDEST,LSIGNON
S NAME="" F S NAME=$O(@XQAGLOB1@("NAME",NAME)) Q:NAME="" D
. 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="" D HEADER D
. I SERVSRT=1 S NAME="" F S NAME=$O(@XQAGLOB1@("SERV",SERVICE,NAME)) Q:NAME="" S VALUE=@XQAGLOB1@("SERV",SERVICE,NAME) D PRINTVAL
. I SERVSRT=2 F NUMB=0:0 S NUMB=$O(@XQAGLOB1@("SERV",SERVICE,"NUMB",NUMB)) Q:NUMB'>0 D
. . S NAME="" F S NAME=$O(@XQAGLOB1@("SERV",SERVICE,"NUMB",NUMB,NAME)) Q:NAME="" S VALUE=@XQAGLOB1@("SERV",SERVICE,"NUMB",NUMB,NAME) D PRINTVAL
. . Q
. Q
Q
;
PRINTVAL ;
N NAME
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)
S LSIGNON=$$GET1^DIQ(200,XQAN1_",",202)
I LSIGNON["@" S LSIGNON=$P(LSIGNON,"@")
I $Y>(IOSL-4) W @IOF D HEADER
W !,NAME,?25,SERVICE,?43,NUMBER,?50,LSIGNON,?64,NCRIT,?69,OLDEST
Q
;
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
XQARPRT1 ;sgh/mtz,JLI/OAK_OIFO-ROUTINE TO PROVIDE COUNTS OF ALERTS ;9/3/03 11:17
+1 ;;8.0;KERNEL;**316,338,631**;Jul 10, 1995;Build 6
+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
+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 SET DIR(0)="DO"
SET DIR("A")="START DATE"
+2 DO ^DIR
KILL DIR
IF Y'>0
QUIT
+3 SET XQASDT=Y
+4 SET DIR(0)="DO^"_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)="SO^;1:By Name;2:By Number;"
SET DIR("A")="Within Service/Section order results by"
DO ^DIR
KILL DIR
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 DO ^%ZISC
+6 KILL @XQAGLOB
+7 QUIT
+8 ;
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
+2 SET XQAGLOB1=XQAGLOB
+3 IF DIVISION
Begin DoDot:1
+4 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
+5 IF '$TEST
DO HEADER
DO PRTLOC
+6 QUIT
+7 ;
PRTLOC ;
+1 NEW PRTLOC
+2 SET PRTLOC=$SELECT(XQAORDER=1:"PRTNAME",XQAORDER=2:"PRTNUMBR",1:"PRTSERVC")
DO @PRTLOC
+3 QUIT
+4 ;
+1 NEW XQACTR
SET XQACTR=0
+2 WRITE @IOF
WRITE " COUNT of ",$SELECT($DATA(XQAWORDS)>1:"SELECTED ",1:""),"ALERTS - users with more than ",XQAC1," on ",$$FMTE^XLFDT($$NOW^XLFDT())
+3 WRITE !," for date range ",$$FMTE^XLFDT(XQASDT,"5DZ")," to ",$$FMTE^XLFDT(XQAEDT,"5DZ")
+4 ;W !,"CRIT column indicates number of CRITICAL alerts and ABNORMAL IMAGING alerts"
+5 WRITE !,"CRIT column indicates number of alerts containing critical text"
+6 DO WORDHDR^XQARPRT2
+7 WRITE !!,?42,$SELECT($DATA(XQAWORDS)>1:"Selected",1:" Total"),?70,"Oldest"
+8 WRITE !,"Name",?25,"Service/section",?43,"Alerts",?50,"Last Sign-on",?64,"CRIT Alert"
+9 WRITE !,"-----------------",?25,"-----------------",?43,"------",?50,"------------",?64,"---- ----------"
+10 IF $DATA(DIVNAME)
DO DIVPRINT
+11 QUIT
+12 ;
PRTNAME ;
+1 NEW NAME,NUMBER,VALUE,XQAN1,NCRIT,OLDEST,LSIGNON
+2 SET NAME=""
FOR
SET NAME=$ORDER(@XQAGLOB1@("NAME",NAME))
IF NAME=""
QUIT
SET VALUE=@XQAGLOB1@("NAME",NAME)
DO PRINTVAL
+3 QUIT
+4 ;
PRTNUMBR ;
+1 NEW NAME,NUMBER,NUMB,VALUE,XQAN1,NCRIT,OLDEST,LSIGNON
+2 SET NAME=""
FOR
SET NAME=$ORDER(@XQAGLOB1@("NAME",NAME))
IF NAME=""
QUIT
Begin DoDot:1
+3 SET NUMBER=$SELECT(XQACRIT:$PIECE(@XQAGLOB1@("NAME",NAME),U,4),1:+@XQAGLOB1@("NAME",NAME))
+4 SET @XQAGLOB1@("NUMB",100000-NUMBER,NAME)=@XQAGLOB1@("NAME",NAME)
+5 QUIT
End DoDot:1
+6 NEW NUMB
SET NUMB=""
FOR
SET NUMB=$ORDER(@XQAGLOB1@("NUMB",NUMB))
IF NUMB=""
QUIT
SET NAME=""
FOR
SET NAME=$ORDER(@XQAGLOB1@("NUMB",NUMB,NAME))
IF NAME=""
QUIT
SET VALUE=@XQAGLOB1@("NUMB",NUMB,NAME)
DO PRINTVAL
+7 QUIT
+8 ;
PRTSERVC ;
+1 NEW NAME,NUMBER,NUMB,VALUE,XQAN1,NCRIT,OLDEST,LSIGNON
+2 SET NAME=""
FOR
SET NAME=$ORDER(@XQAGLOB1@("NAME",NAME))
IF NAME=""
QUIT
Begin DoDot:1
+3 SET XQAN1=$PIECE(@XQAGLOB1@("NAME",NAME),U,2)
+4 SET SERVICE=$EXTRACT($$GET1^DIQ(200,XQAN1_",",29),1,17)
IF SERVICE=""
SET SERVICE="<No Service>"
+5 IF ALLSERV!$DATA(SERVICE(SERVICE))
Begin DoDot:2
+6 IF SERVSRT=1
SET @XQAGLOB1@("SERV",SERVICE,NAME)=@XQAGLOB1@("NAME",NAME)
QUIT
+7 IF SERVSRT=2
SET @XQAGLOB1@("SERV",SERVICE,"NUMB",100000-@XQAGLOB1@("NAME",NAME),NAME)=@XQAGLOB1@("NAME",NAME)
+8 QUIT
End DoDot:2
+9 QUIT
End DoDot:1
+10 SET SERVICE=""
FOR
SET SERVICE=$ORDER(@XQAGLOB1@("SERV",SERVICE))
IF SERVICE=""
QUIT
DO HEADER
Begin DoDot:1
+11 IF SERVSRT=1
SET NAME=""
FOR
SET NAME=$ORDER(@XQAGLOB1@("SERV",SERVICE,NAME))
IF NAME=""
QUIT
SET VALUE=@XQAGLOB1@("SERV",SERVICE,NAME)
DO PRINTVAL
+12 IF SERVSRT=2
FOR NUMB=0:0
SET NUMB=$ORDER(@XQAGLOB1@("SERV",SERVICE,"NUMB",NUMB))
IF NUMB'>0
QUIT
Begin DoDot:2
+13 SET NAME=""
FOR
SET NAME=$ORDER(@XQAGLOB1@("SERV",SERVICE,"NUMB",NUMB,NAME))
IF NAME=""
QUIT
SET VALUE=@XQAGLOB1@("SERV",SERVICE,"NUMB",NUMB,NAME)
DO PRINTVAL
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 QUIT
+17 ;
PRINTVAL ;
+1 NEW NAME
+2 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)
+3 SET SERVICE=$EXTRACT($$GET1^DIQ(200,XQAN1_",",29),1,17)
+4 SET LSIGNON=$$GET1^DIQ(200,XQAN1_",",202)
+5 IF LSIGNON["@"
SET LSIGNON=$PIECE(LSIGNON,"@")
+6 IF $Y>(IOSL-4)
WRITE @IOF
DO HEADER
+7 WRITE !,NAME,?25,SERVICE,?43,NUMBER,?50,LSIGNON,?64,NCRIT,?69,OLDEST
+8 QUIT
+9 ;
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
