SDECAUD ;ALB/WTC,JDJ - VISTA SCHEDULING - Audit Statistics Compiler ; JULY 1, 2024
;;5.3;Scheduling;**686,885**;Aug 13, 1993;Build 5
;;Per VHA Directive 6402, this routine should not be modified
;
Q ;
;
BKGND ;
;
; Compile statistics for yesterday.
;
D COMPILE() ;
Q ;
;
SELECT ;
;
; Compile statistics for selected date or range of dates.
;
N DATE,DATE1,DATE2,%DT,Y,I,X1,X2,X,TODAY ;
;
D NOW^%DTC S TODAY=X ;
W !,"Compile audit statistics for a date or date range.",! ;
SELECT1 ;
S %DT="AEX",%DT("A")="Begin date: " D ^%DT Q:Y<0 I Y'<TODAY W "...Must be earlier than today.",! G SELECT1 ;
S DATE1=Y ;
SELECT2 ;
S %DT="AEX",%DT("A")="End date: " D ^%DT Q:Y<0 I Y'<TODAY W "...Must be earlier than today.",! G SELECT2 ;
S DATE2=Y ;
I DATE1>DATE2 W "... Dates entered out of sequence. Re-enter.",! G SELECT ;
;
; Compile data for each date in range but skip a date if compile previously run for that date.
;
F I=0:1 S X1=DATE1,X2=I D C^%DTC S DATE=X Q:DATE>DATE2 D ;
. W ! S Y=DATE D DD^%DT W Y ;
. I $D(^SDAUDIT("C",DATE)) W "...previously compiled. Skipped." Q ;
. D COMPILE(DATE) W "...compiled." ;
Q ;
;
COMPILE(DATE) ;
;
; Compile audit statistics for a date. If date not specified, use yesterday.
;
K ^TMP($J) ;
N D1,CLERK,DA,X,TYPE,MRTC,APPTDATE,STATUS,PIECE,GLOBAL,DIC,DA1,DLAYGO,FLD,D2,PTR ;
;
I $G(DATE)="" S DATE=$$HTFM^XLFDT($H-1,1) ;
;
; Do not compile if done previously.
;
I $D(^SDAUDIT("C",DATE)) Q ;
;
; Loop thru date/user cross-reference in the SDEC APPT REQUEST file (#409.85) and count APPT and MRTC Requests opened.
;
S D1=DATE-.001 F S D1=$O(^SDEC(409.85,"AC",D1)) Q:'D1 Q:D1\1'=DATE D ;
. ;
. S CLERK=0 F S CLERK=$O(^SDEC(409.85,"AC",D1,CLERK)) Q:'CLERK D ;
.. ;
.. ; Initialize statistics counters for the user.
.. ;
.. I '$D(^TMP($J,CLERK,DATE)) S ^TMP($J,CLERK,DATE)="0^0^0^0^0^0^0^0^0^0^0^0^0" ;
.. ;
.. S DA=0 F S DA=$O(^SDEC(409.85,"AC",D1,CLERK,DA)) Q:'DA S X=^SDEC(409.85,DA,0) D ;
... ;
... ; Parse request data
... ;
... S TYPE=$P(X,"^",5),APPTDATE=$P(X,"^",23),STATUS=$P(X,"^",17) ;
... S MRTC=+$P($G(^SDEC(409.85,DA,3)),"^",1) ;
... ;
... ; APPT request made
... ;
... I TYPE="APPT",MRTC=0 S $P(^(DATE),"^",2)=$P(^TMP($J,CLERK,DATE),"^",2)+1 ;
... ;
... ; MRTC request
... ;
... I MRTC=1 S $P(^(DATE),"^",5)=$P(^TMP($J,CLERK,DATE),"^",5)+1 ;
;
; Loop thru date/user cross-reference in the RECALL REMINDERS file (#403.5) and count PtCSch entries added.
;
S D1=DATE-.001 F S D1=$O(^SD(403.5,"AC",D1)) Q:'D1 Q:D1\1'=DATE D ;
. ;
. S CLERK=0 F S CLERK=$O(^SD(403.5,"AC",D1,CLERK)) Q:'CLERK D ;
.. ;
.. I '$D(^TMP($J,CLERK,DATE)) S ^TMP($J,CLERK,DATE)="0^0^0^0^0^0^0^0^0^0^0^0^0" ;
.. S $P(^(DATE),"^",10)=$P(^TMP($J,CLERK,DATE),"^",10)+1 ;
;
; Loop thru date/user cross-reference in the SD WAIT LIST file (#409.3) and count EWL entries made.
;
S D1=DATE-.001 F S D1=$O(^SDWL(409.3,"AC",D1)) Q:'D1 Q:D1\1'=DATE D ;
. ;
. S CLERK=0 F S CLERK=$O(^SDWL(409.3,"AC",D1,CLERK)) Q:'CLERK D ;
.. ;
.. I '$D(^TMP($J,CLERK,DATE)) S ^TMP($J,CLERK,DATE)="0^0^0^0^0^0^0^0^0^0^0^0^0" ;
.. S $P(^(DATE),"^",7)=$P(^TMP($J,CLERK,DATE),"^",7)+1 ;
;
; Loop thru date appointment made cross-reference in the SDEC APPOINTMENT file (#409.84) and count appointments
; made by type (EWL, Consult, PtCSch, APPT). Increment request closed for each appointment made.
S D1=DATE-.001 F S D1=$O(^SDEC(409.84,"AC",D1)) Q:'D1 Q:D1\1'=DATE D
.S DA=0 F S DA=$O(^SDEC(409.84,"AC",D1,DA)) Q:'DA S CLERK=$P(^SDEC(409.84,DA,0),"^",8),TYPE=$P($G(^SDEC(409.84,DA,2)),"^",1) D ;
.. Q:CLERK="" ; Skip if data missing
.. S PIECE=$S($P(TYPE,";",2)="SDWL(409.3,":8,$P(TYPE,";",2)="GMR(123,":12,$P(TYPE,";",2)="SD(403.5,":11,$P(TYPE,";",2)="SDEC(409.85,":3,1:0) ;
.. Q:'PIECE ;
.. S D2=$P(D1,".",1) ;GRAB THE DATE PORTION
.. I '$D(^TMP($J,CLERK,D2)) S ^TMP($J,CLERK,D2)="0^0^0^0^0^0^0^0^0^0^0^0^0" ;
.. ;
.. ; Update appointment made.
.. ;
.. S $P(^TMP($J,CLERK,D2),"^",PIECE)=$P(^TMP($J,CLERK,D2),"^",PIECE)+1 ;
.. ;
.. ; Update APPT or EWL request closed.
.. ;
.. S PIECE=$S($P(TYPE,";",2)="SDWL(409.3,":9,$P(TYPE,";",2)="SDEC(409.85,":4,1:0) Q:'PIECE ;
.. ;
.. ; Determine if APPT request is MRTC
.. ;
.. I $P(TYPE,";",2)="SDEC(409.85," S PTR=$P(TYPE,";",1),MRTC=+$P($G(^SDEC(409.85,PTR,3)),"^",1) I MRTC S PIECE=6 ;
.. ;
.. ; Update request closed
.. ;
.. S $P(^TMP($J,CLERK,D2),"^",PIECE)=$P(^TMP($J,CLERK,D2),"^",PIECE)+1 ;
;
; Loop thru date appointment cancelled cross-reference in the SDEC APPOINTMENT file (#409.84) and count cancellations.
;
S D1=DATE-.001 F S D1=$O(^SDEC(409.84,"AD",D1)) Q:'D1 Q:D1\1'=DATE D ;
. ;
. S DA=0 F S DA=$O(^SDEC(409.84,"AD",D1,DA)) Q:'DA S CLERK=$P(^SDEC(409.84,DA,0),"^",21) D ;
.. ;
.. Q:CLERK="" ; Skip if data is missing
.. ;
.. I '$D(^TMP($J,CLERK,DATE)) S ^TMP($J,CLERK,DATE)="0^0^0^0^0^0^0^0^0^0^0^0^0" ;
.. S $P(^(DATE),"^",13)=$P(^TMP($J,CLERK,DATE),"^",13)+1 ;
;
; Loop thru date/time-user cross-reference in SDEC CONTACTS file (#409.86) and count contacts.
;
S D1=DATE-.001 F S D1=$O(^SDEC(409.86,"AD",D1)) Q:'D1 Q:D1\1'=DATE D ;
. ;
. S CLERK=0 F S CLERK=$O(^SDEC(409.86,"AD",D1,CLERK)) Q:'CLERK D ;
.. ;
.. S DA=0 F S DA=$O(^SDEC(409.86,"AD",D1,CLERK,DA)) Q:'DA D ;
... S DA1=0 F S DA1=$O(^SDEC(409.86,"AD",D1,CLERK,DA,DA1)) Q:'DA1 D ;
.... I '$D(^TMP($J,CLERK,DATE)) S ^TMP($J,CLERK,DATE)="0^0^0^0^0^0^0^0^0^0^0^0^0" ;
.... S $P(^(DATE),"^",1)=$P(^TMP($J,CLERK,DATE),"^",1)+1 ;
;
;
; Update the SD Audit Statistics file (#409.97)
;
S GLOBAL=^DIC(409.97,0,"GL") ;
S CLERK=0 F S CLERK=$O(^TMP($J,CLERK)) Q:'CLERK D ;
. ;
. K DO S DIC=GLOBAL,DIC(0)="FL",DLAYGO="409.97",X=CLERK,DIC("DR")="1////"_DATE ;
. F FLD=2:1:14 S DIC("DR")=DIC("DR")_";"_FLD_"////"_$P(^TMP($J,CLERK,DATE),"^",FLD-1) ;
. D FILE^DICN ;
;
K ^TMP($J) ;
;
Q ;
;
;*zeb+tag 2/28/18 686 return compiled data
;--------------------
;SUMMGET2 - Return compiled Audit Report data via RPC
;--------------------
;Parameters
;----------
;SDECRET - global reference to array with return values
;SDBEG - start date for reporting; defaults to 1/2/1841
;SDEND - end date for reporting; defaults to 10/15/2114
;USER - IEN of a user to report on; defaults to all users
;----------
;Returns (one row for each user)
;----------
;USERIEN - user's IEN
;USERNAME - user's name
;CONTACTS - number of patient contacts
;APPTOPEN - number of APPT requests opened
;APPTMADE - number of appointments made for APPT requests
;APPTCLSD - number of APPT requests closed
;MRTCOPEN - number of MRTC requests opened
;MRTCCLSD - number of MRTC requests closed
;EWLOPEN - number of EWL requests opened
;EWLMADE - number of appointments made for EWL requests
;EWLCLSD - number of EWL requests closed
;PTCSOPEN - number of PtCSch requests opened
;PTCSMADE - number of appointments made for PtCSch requests
;CNSLTMD - number of appointments made for consults
;APPTCXLD - number of appointments canceled
;ACTIONS - total number of actions
SUMMGET2(SDECRET,SDBEG,SDEND,USER) ;Get compiled Audit Report for a given date range
N X,Y,%DT,U,X1,X2
N SDTMP,SDECLN,SDSTATS,SDPC,SDDT,SDASIEN,SDASDATA
S U="^"
;translate dates to FM format
I SDBEG]"" S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y S:Y=-1 SDBEG=1410102 I 1
E S SDBEG=1410102 ;default begin date
I SDEND]"" S %DT="" S X=$P(SDEND,"@",1) D ^%DT S SDEND=Y S:Y=-1 SDEND=4141015 I 1
E S SDEND=4141015 ;default end date
;check user
I USER]"",'$D(^VA(200,+USER,0)) S USER=""
;set up return array
S SDECRET="^TMP(""SDECAUD"","_$J_",""SUMMGET2"")" ;global reference to return array
K @SDECRET
S SDECLN=0
;set up column headers for return array
; 1 2 3 4 5 6
S SDTMP="T00030USERIEN^T00030USERNAME^T00030CONTACTS^T00030APPTOPEN^T00030APPTMADE^T00030APPTCLSD"
; 7 8 9 10 11
S SDTMP=SDTMP_"^T00030MRTCOPEN^T00030MRTCCLSD^T00030EWLOPEN^T00030EWLMADE^T00030EWLCLSD"
; 12 13 14 15 16
S SDTMP=SDTMP_"^T00030PTCSOPEN^T00030PTCSMADE^T00030CNSLTMD^T00030APPTCXLD^T00030ACTIONS"
S @SDECRET@(SDECLN)=SDTMP_$C(30)
;if a single user is specified, loop over x-ref for dates for that user
I USER]"" D I 1
.S SDSTATS="0^0^0^0^0^0^0^0^0^0^0^0^0^0"
.S X1=SDBEG,X2=-1 D C^%DTC S SDDT=X
.F S SDDT=$O(^SDAUDIT("E",USER,SDDT)) Q:SDDT="" Q:SDDT>SDEND D
..S SDASIEN=""
..F S SDASIEN=$O(^SDAUDIT("E",USER,SDDT,SDASIEN)) Q:SDASIEN="" D
...S SDASDATA=^SDAUDIT(SDASIEN,0)
...S $P(SDASDATA,U,16)=$$GET1^DIQ(409.97,SDASIEN_",",15) ;field 15 is computed, so isn't in global
...F SDPC=1:1:14 S $P(SDSTATS,U,SDPC)=$P(SDSTATS,U,SDPC)+$P(SDASDATA,U,SDPC+2)
.S SDECLN=SDECLN+1
.S SDTMP=USER_U_$$GET1^DIQ(200,USER_",",.01)_U_SDSTATS
.S @SDECRET@(SDECLN)=SDTMP_$C(30)
;otherwise, loop over x-ref for users for those dates
E D
.F S USER=$O(^SDAUDIT("E",USER)) Q:USER="" D
..S SDSTATS="0^0^0^0^0^0^0^0^0^0^0^0^0^0"
..S X1=SDBEG,X2=-1 D C^%DTC S SDDT=X
..F S SDDT=$O(^SDAUDIT("E",USER,SDDT)) Q:SDDT="" Q:SDDT>SDEND D
...S SDASIEN=""
...F S SDASIEN=$O(^SDAUDIT("E",USER,SDDT,SDASIEN)) Q:SDASIEN="" D
....S SDASDATA=^SDAUDIT(SDASIEN,0)
....S $P(SDASDATA,U,16)=$$GET1^DIQ(409.97,SDASIEN_",",15) ;field 15 is computed, so isn't in global
....F SDPC=1:1:14 S $P(SDSTATS,U,SDPC)=$P(SDSTATS,U,SDPC)+$P(SDASDATA,U,SDPC+2)
..Q:SDSTATS="0^0^0^0^0^0^0^0^0^0^0^0^0^0" ;don't send back if user has no data to send
..S SDECLN=SDECLN+1
..S SDTMP=USER_U_$$GET1^DIQ(200,USER_",",.01)_U_SDSTATS
..S @SDECRET@(SDECLN)=SDTMP_$C(30)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECAUD 10615 printed Nov 22, 2024@18:01:48 Page 2
SDECAUD ;ALB/WTC,JDJ - VISTA SCHEDULING - Audit Statistics Compiler ; JULY 1, 2024
+1 ;;5.3;Scheduling;**686,885**;Aug 13, 1993;Build 5
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ;
QUIT
+5 ;
BKGND ;
+1 ;
+2 ; Compile statistics for yesterday.
+3 ;
+4 ;
DO COMPILE()
+5 ;
QUIT
+6 ;
SELECT ;
+1 ;
+2 ; Compile statistics for selected date or range of dates.
+3 ;
+4 ;
NEW DATE,DATE1,DATE2,%DT,Y,I,X1,X2,X,TODAY
+5 ;
+6 ;
DO NOW^%DTC
SET TODAY=X
+7 ;
WRITE !,"Compile audit statistics for a date or date range.",!
SELECT1 ;
+1 ;
SET %DT="AEX"
SET %DT("A")="Begin date: "
DO ^%DT
if Y<0
QUIT
IF Y'<TODAY
WRITE "...Must be earlier than today.",!
GOTO SELECT1
+2 ;
SET DATE1=Y
SELECT2 ;
+1 ;
SET %DT="AEX"
SET %DT("A")="End date: "
DO ^%DT
if Y<0
QUIT
IF Y'<TODAY
WRITE "...Must be earlier than today.",!
GOTO SELECT2
+2 ;
SET DATE2=Y
+3 ;
IF DATE1>DATE2
WRITE "... Dates entered out of sequence. Re-enter.",!
GOTO SELECT
+4 ;
+5 ; Compile data for each date in range but skip a date if compile previously run for that date.
+6 ;
+7 ;
FOR I=0:1
SET X1=DATE1
SET X2=I
DO C^%DTC
SET DATE=X
if DATE>DATE2
QUIT
Begin DoDot:1
+8 ;
WRITE !
SET Y=DATE
DO DD^%DT
WRITE Y
+9 ;
IF $DATA(^SDAUDIT("C",DATE))
WRITE "...previously compiled. Skipped."
QUIT
+10 ;
DO COMPILE(DATE)
WRITE "...compiled."
End DoDot:1
+11 ;
QUIT
+12 ;
COMPILE(DATE) ;
+1 ;
+2 ; Compile audit statistics for a date. If date not specified, use yesterday.
+3 ;
+4 ;
KILL ^TMP($JOB)
+5 ;
NEW D1,CLERK,DA,X,TYPE,MRTC,APPTDATE,STATUS,PIECE,GLOBAL,DIC,DA1,DLAYGO,FLD,D2,PTR
+6 ;
+7 ;
IF $GET(DATE)=""
SET DATE=$$HTFM^XLFDT($HOROLOG-1,1)
+8 ;
+9 ; Do not compile if done previously.
+10 ;
+11 ;
IF $DATA(^SDAUDIT("C",DATE))
QUIT
+12 ;
+13 ; Loop thru date/user cross-reference in the SDEC APPT REQUEST file (#409.85) and count APPT and MRTC Requests opened.
+14 ;
+15 ;
SET D1=DATE-.001
FOR
SET D1=$ORDER(^SDEC(409.85,"AC",D1))
if 'D1
QUIT
if D1\1'=DATE
QUIT
Begin DoDot:1
+16 ;
+17 ;
SET CLERK=0
FOR
SET CLERK=$ORDER(^SDEC(409.85,"AC",D1,CLERK))
if 'CLERK
QUIT
Begin DoDot:2
+18 ;
+19 ; Initialize statistics counters for the user.
+20 ;
+21 ;
IF '$DATA(^TMP($JOB,CLERK,DATE))
SET ^TMP($JOB,CLERK,DATE)="0^0^0^0^0^0^0^0^0^0^0^0^0"
+22 ;
+23 ;
SET DA=0
FOR
SET DA=$ORDER(^SDEC(409.85,"AC",D1,CLERK,DA))
if 'DA
QUIT
SET X=^SDEC(409.85,DA,0)
Begin DoDot:3
+24 ;
+25 ; Parse request data
+26 ;
+27 ;
SET TYPE=$PIECE(X,"^",5)
SET APPTDATE=$PIECE(X,"^",23)
SET STATUS=$PIECE(X,"^",17)
+28 ;
SET MRTC=+$PIECE($GET(^SDEC(409.85,DA,3)),"^",1)
+29 ;
+30 ; APPT request made
+31 ;
+32 ;
IF TYPE="APPT"
IF MRTC=0
SET $PIECE(^(DATE),"^",2)=$PIECE(^TMP($JOB,CLERK,DATE),"^",2)+1
+33 ;
+34 ; MRTC request
+35 ;
+36 ;
IF MRTC=1
SET $PIECE(^(DATE),"^",5)=$PIECE(^TMP($JOB,CLERK,DATE),"^",5)+1
End DoDot:3
End DoDot:2
End DoDot:1
+37 ;
+38 ; Loop thru date/user cross-reference in the RECALL REMINDERS file (#403.5) and count PtCSch entries added.
+39 ;
+40 ;
SET D1=DATE-.001
FOR
SET D1=$ORDER(^SD(403.5,"AC",D1))
if 'D1
QUIT
if D1\1'=DATE
QUIT
Begin DoDot:1
+41 ;
+42 ;
SET CLERK=0
FOR
SET CLERK=$ORDER(^SD(403.5,"AC",D1,CLERK))
if 'CLERK
QUIT
Begin DoDot:2
+43 ;
+44 ;
IF '$DATA(^TMP($JOB,CLERK,DATE))
SET ^TMP($JOB,CLERK,DATE)="0^0^0^0^0^0^0^0^0^0^0^0^0"
+45 ;
SET $PIECE(^(DATE),"^",10)=$PIECE(^TMP($JOB,CLERK,DATE),"^",10)+1
End DoDot:2
End DoDot:1
+46 ;
+47 ; Loop thru date/user cross-reference in the SD WAIT LIST file (#409.3) and count EWL entries made.
+48 ;
+49 ;
SET D1=DATE-.001
FOR
SET D1=$ORDER(^SDWL(409.3,"AC",D1))
if 'D1
QUIT
if D1\1'=DATE
QUIT
Begin DoDot:1
+50 ;
+51 ;
SET CLERK=0
FOR
SET CLERK=$ORDER(^SDWL(409.3,"AC",D1,CLERK))
if 'CLERK
QUIT
Begin DoDot:2
+52 ;
+53 ;
IF '$DATA(^TMP($JOB,CLERK,DATE))
SET ^TMP($JOB,CLERK,DATE)="0^0^0^0^0^0^0^0^0^0^0^0^0"
+54 ;
SET $PIECE(^(DATE),"^",7)=$PIECE(^TMP($JOB,CLERK,DATE),"^",7)+1
End DoDot:2
End DoDot:1
+55 ;
+56 ; Loop thru date appointment made cross-reference in the SDEC APPOINTMENT file (#409.84) and count appointments
+57 ; made by type (EWL, Consult, PtCSch, APPT). Increment request closed for each appointment made.
+58 SET D1=DATE-.001
FOR
SET D1=$ORDER(^SDEC(409.84,"AC",D1))
if 'D1
QUIT
if D1\1'=DATE
QUIT
Begin DoDot:1
+59 ;
SET DA=0
FOR
SET DA=$ORDER(^SDEC(409.84,"AC",D1,DA))
if 'DA
QUIT
SET CLERK=$PIECE(^SDEC(409.84,DA,0),"^",8)
SET TYPE=$PIECE($GET(^SDEC(409.84,DA,2)),"^",1)
Begin DoDot:2
+60 ; Skip if data missing
if CLERK=""
QUIT
+61 ;
SET PIECE=$SELECT($PIECE(TYPE,";",2)="SDWL(409.3,":8,$PIECE(TYPE,";",2)="GMR(123,":12,$PIECE(TYPE,";",2)="SD(403.5,":11,$PIECE(TYPE,";",2)="SDEC(409.85,":3,1:0)
+62 ;
if 'PIECE
QUIT
+63 ;GRAB THE DATE PORTION
SET D2=$PIECE(D1,".",1)
+64 ;
IF '$DATA(^TMP($JOB,CLERK,D2))
SET ^TMP($JOB,CLERK,D2)="0^0^0^0^0^0^0^0^0^0^0^0^0"
+65 ;
+66 ; Update appointment made.
+67 ;
+68 ;
SET $PIECE(^TMP($JOB,CLERK,D2),"^",PIECE)=$PIECE(^TMP($JOB,CLERK,D2),"^",PIECE)+1
+69 ;
+70 ; Update APPT or EWL request closed.
+71 ;
+72 ;
SET PIECE=$SELECT($PIECE(TYPE,";",2)="SDWL(409.3,":9,$PIECE(TYPE,";",2)="SDEC(409.85,":4,1:0)
if 'PIECE
QUIT
+73 ;
+74 ; Determine if APPT request is MRTC
+75 ;
+76 ;
IF $PIECE(TYPE,";",2)="SDEC(409.85,"
SET PTR=$PIECE(TYPE,";",1)
SET MRTC=+$PIECE($GET(^SDEC(409.85,PTR,3)),"^",1)
IF MRTC
SET PIECE=6
+77 ;
+78 ; Update request closed
+79 ;
+80 ;
SET $PIECE(^TMP($JOB,CLERK,D2),"^",PIECE)=$PIECE(^TMP($JOB,CLERK,D2),"^",PIECE)+1
End DoDot:2
End DoDot:1
+81 ;
+82 ; Loop thru date appointment cancelled cross-reference in the SDEC APPOINTMENT file (#409.84) and count cancellations.
+83 ;
+84 ;
SET D1=DATE-.001
FOR
SET D1=$ORDER(^SDEC(409.84,"AD",D1))
if 'D1
QUIT
if D1\1'=DATE
QUIT
Begin DoDot:1
+85 ;
+86 ;
SET DA=0
FOR
SET DA=$ORDER(^SDEC(409.84,"AD",D1,DA))
if 'DA
QUIT
SET CLERK=$PIECE(^SDEC(409.84,DA,0),"^",21)
Begin DoDot:2
+87 ;
+88 ; Skip if data is missing
if CLERK=""
QUIT
+89 ;
+90 ;
IF '$DATA(^TMP($JOB,CLERK,DATE))
SET ^TMP($JOB,CLERK,DATE)="0^0^0^0^0^0^0^0^0^0^0^0^0"
+91 ;
SET $PIECE(^(DATE),"^",13)=$PIECE(^TMP($JOB,CLERK,DATE),"^",13)+1
End DoDot:2
End DoDot:1
+92 ;
+93 ; Loop thru date/time-user cross-reference in SDEC CONTACTS file (#409.86) and count contacts.
+94 ;
+95 ;
SET D1=DATE-.001
FOR
SET D1=$ORDER(^SDEC(409.86,"AD",D1))
if 'D1
QUIT
if D1\1'=DATE
QUIT
Begin DoDot:1
+96 ;
+97 ;
SET CLERK=0
FOR
SET CLERK=$ORDER(^SDEC(409.86,"AD",D1,CLERK))
if 'CLERK
QUIT
Begin DoDot:2
+98 ;
+99 ;
SET DA=0
FOR
SET DA=$ORDER(^SDEC(409.86,"AD",D1,CLERK,DA))
if 'DA
QUIT
Begin DoDot:3
+100 ;
SET DA1=0
FOR
SET DA1=$ORDER(^SDEC(409.86,"AD",D1,CLERK,DA,DA1))
if 'DA1
QUIT
Begin DoDot:4
+101 ;
IF '$DATA(^TMP($JOB,CLERK,DATE))
SET ^TMP($JOB,CLERK,DATE)="0^0^0^0^0^0^0^0^0^0^0^0^0"
+102 ;
SET $PIECE(^(DATE),"^",1)=$PIECE(^TMP($JOB,CLERK,DATE),"^",1)+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+103 ;
+104 ;
+105 ; Update the SD Audit Statistics file (#409.97)
+106 ;
+107 ;
SET GLOBAL=^DIC(409.97,0,"GL")
+108 ;
SET CLERK=0
FOR
SET CLERK=$ORDER(^TMP($JOB,CLERK))
if 'CLERK
QUIT
Begin DoDot:1
+109 ;
+110 ;
KILL DO
SET DIC=GLOBAL
SET DIC(0)="FL"
SET DLAYGO="409.97"
SET X=CLERK
SET DIC("DR")="1////"_DATE
+111 ;
FOR FLD=2:1:14
SET DIC("DR")=DIC("DR")_";"_FLD_"////"_$PIECE(^TMP($JOB,CLERK,DATE),"^",FLD-1)
+112 ;
DO FILE^DICN
End DoDot:1
+113 ;
+114 ;
KILL ^TMP($JOB)
+115 ;
+116 ;
QUIT
+117 ;
+118 ;*zeb+tag 2/28/18 686 return compiled data
+119 ;--------------------
+120 ;SUMMGET2 - Return compiled Audit Report data via RPC
+121 ;--------------------
+122 ;Parameters
+123 ;----------
+124 ;SDECRET - global reference to array with return values
+125 ;SDBEG - start date for reporting; defaults to 1/2/1841
+126 ;SDEND - end date for reporting; defaults to 10/15/2114
+127 ;USER - IEN of a user to report on; defaults to all users
+128 ;----------
+129 ;Returns (one row for each user)
+130 ;----------
+131 ;USERIEN - user's IEN
+132 ;USERNAME - user's name
+133 ;CONTACTS - number of patient contacts
+134 ;APPTOPEN - number of APPT requests opened
+135 ;APPTMADE - number of appointments made for APPT requests
+136 ;APPTCLSD - number of APPT requests closed
+137 ;MRTCOPEN - number of MRTC requests opened
+138 ;MRTCCLSD - number of MRTC requests closed
+139 ;EWLOPEN - number of EWL requests opened
+140 ;EWLMADE - number of appointments made for EWL requests
+141 ;EWLCLSD - number of EWL requests closed
+142 ;PTCSOPEN - number of PtCSch requests opened
+143 ;PTCSMADE - number of appointments made for PtCSch requests
+144 ;CNSLTMD - number of appointments made for consults
+145 ;APPTCXLD - number of appointments canceled
+146 ;ACTIONS - total number of actions
SUMMGET2(SDECRET,SDBEG,SDEND,USER) ;Get compiled Audit Report for a given date range
+1 NEW X,Y,%DT,U,X1,X2
+2 NEW SDTMP,SDECLN,SDSTATS,SDPC,SDDT,SDASIEN,SDASDATA
+3 SET U="^"
+4 ;translate dates to FM format
+5 IF SDBEG]""
SET %DT=""
SET X=$PIECE(SDBEG,"@",1)
DO ^%DT
SET SDBEG=Y
if Y=-1
SET SDBEG=1410102
IF 1
+6 ;default begin date
IF '$TEST
SET SDBEG=1410102
+7 IF SDEND]""
SET %DT=""
SET X=$PIECE(SDEND,"@",1)
DO ^%DT
SET SDEND=Y
if Y=-1
SET SDEND=4141015
IF 1
+8 ;default end date
IF '$TEST
SET SDEND=4141015
+9 ;check user
+10 IF USER]""
IF '$DATA(^VA(200,+USER,0))
SET USER=""
+11 ;set up return array
+12 ;global reference to return array
SET SDECRET="^TMP(""SDECAUD"","_$JOB_",""SUMMGET2"")"
+13 KILL @SDECRET
+14 SET SDECLN=0
+15 ;set up column headers for return array
+16 ; 1 2 3 4 5 6
+17 SET SDTMP="T00030USERIEN^T00030USERNAME^T00030CONTACTS^T00030APPTOPEN^T00030APPTMADE^T00030APPTCLSD"
+18 ; 7 8 9 10 11
+19 SET SDTMP=SDTMP_"^T00030MRTCOPEN^T00030MRTCCLSD^T00030EWLOPEN^T00030EWLMADE^T00030EWLCLSD"
+20 ; 12 13 14 15 16
+21 SET SDTMP=SDTMP_"^T00030PTCSOPEN^T00030PTCSMADE^T00030CNSLTMD^T00030APPTCXLD^T00030ACTIONS"
+22 SET @SDECRET@(SDECLN)=SDTMP_$CHAR(30)
+23 ;if a single user is specified, loop over x-ref for dates for that user
+24 IF USER]""
Begin DoDot:1
+25 SET SDSTATS="0^0^0^0^0^0^0^0^0^0^0^0^0^0"
+26 SET X1=SDBEG
SET X2=-1
DO C^%DTC
SET SDDT=X
+27 FOR
SET SDDT=$ORDER(^SDAUDIT("E",USER,SDDT))
if SDDT=""
QUIT
if SDDT>SDEND
QUIT
Begin DoDot:2
+28 SET SDASIEN=""
+29 FOR
SET SDASIEN=$ORDER(^SDAUDIT("E",USER,SDDT,SDASIEN))
if SDASIEN=""
QUIT
Begin DoDot:3
+30 SET SDASDATA=^SDAUDIT(SDASIEN,0)
+31 ;field 15 is computed, so isn't in global
SET $PIECE(SDASDATA,U,16)=$$GET1^DIQ(409.97,SDASIEN_",",15)
+32 FOR SDPC=1:1:14
SET $PIECE(SDSTATS,U,SDPC)=$PIECE(SDSTATS,U,SDPC)+$PIECE(SDASDATA,U,SDPC+2)
End DoDot:3
End DoDot:2
+33 SET SDECLN=SDECLN+1
+34 SET SDTMP=USER_U_$$GET1^DIQ(200,USER_",",.01)_U_SDSTATS
+35 SET @SDECRET@(SDECLN)=SDTMP_$CHAR(30)
End DoDot:1
IF 1
+36 ;otherwise, loop over x-ref for users for those dates
+37 IF '$TEST
Begin DoDot:1
+38 FOR
SET USER=$ORDER(^SDAUDIT("E",USER))
if USER=""
QUIT
Begin DoDot:2
+39 SET SDSTATS="0^0^0^0^0^0^0^0^0^0^0^0^0^0"
+40 SET X1=SDBEG
SET X2=-1
DO C^%DTC
SET SDDT=X
+41 FOR
SET SDDT=$ORDER(^SDAUDIT("E",USER,SDDT))
if SDDT=""
QUIT
if SDDT>SDEND
QUIT
Begin DoDot:3
+42 SET SDASIEN=""
+43 FOR
SET SDASIEN=$ORDER(^SDAUDIT("E",USER,SDDT,SDASIEN))
if SDASIEN=""
QUIT
Begin DoDot:4
+44 SET SDASDATA=^SDAUDIT(SDASIEN,0)
+45 ;field 15 is computed, so isn't in global
SET $PIECE(SDASDATA,U,16)=$$GET1^DIQ(409.97,SDASIEN_",",15)
+46 FOR SDPC=1:1:14
SET $PIECE(SDSTATS,U,SDPC)=$PIECE(SDSTATS,U,SDPC)+$PIECE(SDASDATA,U,SDPC+2)
End DoDot:4
End DoDot:3
+47 ;don't send back if user has no data to send
if SDSTATS="0^0^0^0^0^0^0^0^0^0^0^0^0^0"
QUIT
+48 SET SDECLN=SDECLN+1
+49 SET SDTMP=USER_U_$$GET1^DIQ(200,USER_",",.01)_U_SDSTATS
+50 SET @SDECRET@(SDECLN)=SDTMP_$CHAR(30)
End DoDot:2
End DoDot:1
+51 QUIT
