Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDECAUD

SDECAUD.m

Go to the documentation of this file.
  1. SDECAUD ;ALB/WTC,JDJ - VISTA SCHEDULING - Audit Statistics Compiler ; JULY 1, 2024
  1. ;;5.3;Scheduling;**686,885**;Aug 13, 1993;Build 5
  1. ;;Per VHA Directive 6402, this routine should not be modified
  1. ;
  1. Q ;
  1. ;
  1. BKGND ;
  1. ;
  1. ; Compile statistics for yesterday.
  1. ;
  1. D COMPILE() ;
  1. Q ;
  1. ;
  1. SELECT ;
  1. ;
  1. ; Compile statistics for selected date or range of dates.
  1. ;
  1. N DATE,DATE1,DATE2,%DT,Y,I,X1,X2,X,TODAY ;
  1. ;
  1. D NOW^%DTC S TODAY=X ;
  1. W !,"Compile audit statistics for a date or date range.",! ;
  1. SELECT1 ;
  1. S %DT="AEX",%DT("A")="Begin date: " D ^%DT Q:Y<0 I Y'<TODAY W "...Must be earlier than today.",! G SELECT1 ;
  1. S DATE1=Y ;
  1. SELECT2 ;
  1. S %DT="AEX",%DT("A")="End date: " D ^%DT Q:Y<0 I Y'<TODAY W "...Must be earlier than today.",! G SELECT2 ;
  1. S DATE2=Y ;
  1. I DATE1>DATE2 W "... Dates entered out of sequence. Re-enter.",! G SELECT ;
  1. ;
  1. ; Compile data for each date in range but skip a date if compile previously run for that date.
  1. ;
  1. F I=0:1 S X1=DATE1,X2=I D C^%DTC S DATE=X Q:DATE>DATE2 D ;
  1. . W ! S Y=DATE D DD^%DT W Y ;
  1. . I $D(^SDAUDIT("C",DATE)) W "...previously compiled. Skipped." Q ;
  1. . D COMPILE(DATE) W "...compiled." ;
  1. Q ;
  1. ;
  1. COMPILE(DATE) ;
  1. ;
  1. ; Compile audit statistics for a date. If date not specified, use yesterday.
  1. ;
  1. K ^TMP($J) ;
  1. N D1,CLERK,DA,X,TYPE,MRTC,APPTDATE,STATUS,PIECE,GLOBAL,DIC,DA1,DLAYGO,FLD,D2,PTR ;
  1. ;
  1. I $G(DATE)="" S DATE=$$HTFM^XLFDT($H-1,1) ;
  1. ;
  1. ; Do not compile if done previously.
  1. ;
  1. I $D(^SDAUDIT("C",DATE)) Q ;
  1. ;
  1. ; Loop thru date/user cross-reference in the SDEC APPT REQUEST file (#409.85) and count APPT and MRTC Requests opened.
  1. ;
  1. S D1=DATE-.001 F S D1=$O(^SDEC(409.85,"AC",D1)) Q:'D1 Q:D1\1'=DATE D ;
  1. . ;
  1. . S CLERK=0 F S CLERK=$O(^SDEC(409.85,"AC",D1,CLERK)) Q:'CLERK D ;
  1. .. ;
  1. .. ; Initialize statistics counters for the user.
  1. .. ;
  1. .. I '$D(^TMP($J,CLERK,DATE)) S ^TMP($J,CLERK,DATE)="0^0^0^0^0^0^0^0^0^0^0^0^0" ;
  1. .. ;
  1. .. S DA=0 F S DA=$O(^SDEC(409.85,"AC",D1,CLERK,DA)) Q:'DA S X=^SDEC(409.85,DA,0) D ;
  1. ... ;
  1. ... ; Parse request data
  1. ... ;
  1. ... S TYPE=$P(X,"^",5),APPTDATE=$P(X,"^",23),STATUS=$P(X,"^",17) ;
  1. ... S MRTC=+$P($G(^SDEC(409.85,DA,3)),"^",1) ;
  1. ... ;
  1. ... ; APPT request made
  1. ... ;
  1. ... I TYPE="APPT",MRTC=0 S $P(^(DATE),"^",2)=$P(^TMP($J,CLERK,DATE),"^",2)+1 ;
  1. ... ;
  1. ... ; MRTC request
  1. ... ;
  1. ... I MRTC=1 S $P(^(DATE),"^",5)=$P(^TMP($J,CLERK,DATE),"^",5)+1 ;
  1. ;
  1. ; Loop thru date/user cross-reference in the RECALL REMINDERS file (#403.5) and count PtCSch entries added.
  1. ;
  1. S D1=DATE-.001 F S D1=$O(^SD(403.5,"AC",D1)) Q:'D1 Q:D1\1'=DATE D ;
  1. . ;
  1. . S CLERK=0 F S CLERK=$O(^SD(403.5,"AC",D1,CLERK)) Q:'CLERK D ;
  1. .. ;
  1. .. I '$D(^TMP($J,CLERK,DATE)) S ^TMP($J,CLERK,DATE)="0^0^0^0^0^0^0^0^0^0^0^0^0" ;
  1. .. S $P(^(DATE),"^",10)=$P(^TMP($J,CLERK,DATE),"^",10)+1 ;
  1. ;
  1. ; Loop thru date/user cross-reference in the SD WAIT LIST file (#409.3) and count EWL entries made.
  1. ;
  1. S D1=DATE-.001 F S D1=$O(^SDWL(409.3,"AC",D1)) Q:'D1 Q:D1\1'=DATE D ;
  1. . ;
  1. . S CLERK=0 F S CLERK=$O(^SDWL(409.3,"AC",D1,CLERK)) Q:'CLERK D ;
  1. .. ;
  1. .. I '$D(^TMP($J,CLERK,DATE)) S ^TMP($J,CLERK,DATE)="0^0^0^0^0^0^0^0^0^0^0^0^0" ;
  1. .. S $P(^(DATE),"^",7)=$P(^TMP($J,CLERK,DATE),"^",7)+1 ;
  1. ;
  1. ; Loop thru date appointment made cross-reference in the SDEC APPOINTMENT file (#409.84) and count appointments
  1. ; made by type (EWL, Consult, PtCSch, APPT). Increment request closed for each appointment made.
  1. S D1=DATE-.001 F S D1=$O(^SDEC(409.84,"AC",D1)) Q:'D1 Q:D1\1'=DATE D
  1. .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 ;
  1. .. Q:CLERK="" ; Skip if data missing
  1. .. 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) ;
  1. .. Q:'PIECE ;
  1. .. S D2=$P(D1,".",1) ;GRAB THE DATE PORTION
  1. .. I '$D(^TMP($J,CLERK,D2)) S ^TMP($J,CLERK,D2)="0^0^0^0^0^0^0^0^0^0^0^0^0" ;
  1. .. ;
  1. .. ; Update appointment made.
  1. .. ;
  1. .. S $P(^TMP($J,CLERK,D2),"^",PIECE)=$P(^TMP($J,CLERK,D2),"^",PIECE)+1 ;
  1. .. ;
  1. .. ; Update APPT or EWL request closed.
  1. .. ;
  1. .. S PIECE=$S($P(TYPE,";",2)="SDWL(409.3,":9,$P(TYPE,";",2)="SDEC(409.85,":4,1:0) Q:'PIECE ;
  1. .. ;
  1. .. ; Determine if APPT request is MRTC
  1. .. ;
  1. .. 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 ;
  1. .. ;
  1. .. ; Update request closed
  1. .. ;
  1. .. S $P(^TMP($J,CLERK,D2),"^",PIECE)=$P(^TMP($J,CLERK,D2),"^",PIECE)+1 ;
  1. ;
  1. ; Loop thru date appointment cancelled cross-reference in the SDEC APPOINTMENT file (#409.84) and count cancellations.
  1. ;
  1. S D1=DATE-.001 F S D1=$O(^SDEC(409.84,"AD",D1)) Q:'D1 Q:D1\1'=DATE D ;
  1. . ;
  1. . 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 ;
  1. .. ;
  1. .. Q:CLERK="" ; Skip if data is missing
  1. .. ;
  1. .. I '$D(^TMP($J,CLERK,DATE)) S ^TMP($J,CLERK,DATE)="0^0^0^0^0^0^0^0^0^0^0^0^0" ;
  1. .. S $P(^(DATE),"^",13)=$P(^TMP($J,CLERK,DATE),"^",13)+1 ;
  1. ;
  1. ; Loop thru date/time-user cross-reference in SDEC CONTACTS file (#409.86) and count contacts.
  1. ;
  1. S D1=DATE-.001 F S D1=$O(^SDEC(409.86,"AD",D1)) Q:'D1 Q:D1\1'=DATE D ;
  1. . ;
  1. . S CLERK=0 F S CLERK=$O(^SDEC(409.86,"AD",D1,CLERK)) Q:'CLERK D ;
  1. .. ;
  1. .. S DA=0 F S DA=$O(^SDEC(409.86,"AD",D1,CLERK,DA)) Q:'DA D ;
  1. ... S DA1=0 F S DA1=$O(^SDEC(409.86,"AD",D1,CLERK,DA,DA1)) Q:'DA1 D ;
  1. .... I '$D(^TMP($J,CLERK,DATE)) S ^TMP($J,CLERK,DATE)="0^0^0^0^0^0^0^0^0^0^0^0^0" ;
  1. .... S $P(^(DATE),"^",1)=$P(^TMP($J,CLERK,DATE),"^",1)+1 ;
  1. ;
  1. ;
  1. ; Update the SD Audit Statistics file (#409.97)
  1. ;
  1. S GLOBAL=^DIC(409.97,0,"GL") ;
  1. S CLERK=0 F S CLERK=$O(^TMP($J,CLERK)) Q:'CLERK D ;
  1. . ;
  1. . K DO S DIC=GLOBAL,DIC(0)="FL",DLAYGO="409.97",X=CLERK,DIC("DR")="1////"_DATE ;
  1. . F FLD=2:1:14 S DIC("DR")=DIC("DR")_";"_FLD_"////"_$P(^TMP($J,CLERK,DATE),"^",FLD-1) ;
  1. . D FILE^DICN ;
  1. ;
  1. K ^TMP($J) ;
  1. ;
  1. Q ;
  1. ;
  1. ;*zeb+tag 2/28/18 686 return compiled data
  1. ;--------------------
  1. ;SUMMGET2 - Return compiled Audit Report data via RPC
  1. ;--------------------
  1. ;Parameters
  1. ;----------
  1. ;SDECRET - global reference to array with return values
  1. ;SDBEG - start date for reporting; defaults to 1/2/1841
  1. ;SDEND - end date for reporting; defaults to 10/15/2114
  1. ;USER - IEN of a user to report on; defaults to all users
  1. ;----------
  1. ;Returns (one row for each user)
  1. ;----------
  1. ;USERIEN - user's IEN
  1. ;USERNAME - user's name
  1. ;CONTACTS - number of patient contacts
  1. ;APPTOPEN - number of APPT requests opened
  1. ;APPTMADE - number of appointments made for APPT requests
  1. ;APPTCLSD - number of APPT requests closed
  1. ;MRTCOPEN - number of MRTC requests opened
  1. ;MRTCCLSD - number of MRTC requests closed
  1. ;EWLOPEN - number of EWL requests opened
  1. ;EWLMADE - number of appointments made for EWL requests
  1. ;EWLCLSD - number of EWL requests closed
  1. ;PTCSOPEN - number of PtCSch requests opened
  1. ;PTCSMADE - number of appointments made for PtCSch requests
  1. ;CNSLTMD - number of appointments made for consults
  1. ;APPTCXLD - number of appointments canceled
  1. ;ACTIONS - total number of actions
  1. SUMMGET2(SDECRET,SDBEG,SDEND,USER) ;Get compiled Audit Report for a given date range
  1. N X,Y,%DT,U,X1,X2
  1. N SDTMP,SDECLN,SDSTATS,SDPC,SDDT,SDASIEN,SDASDATA
  1. S U="^"
  1. ;translate dates to FM format
  1. I SDBEG]"" S %DT="" S X=$P(SDBEG,"@",1) D ^%DT S SDBEG=Y S:Y=-1 SDBEG=1410102 I 1
  1. E S SDBEG=1410102 ;default begin date
  1. I SDEND]"" S %DT="" S X=$P(SDEND,"@",1) D ^%DT S SDEND=Y S:Y=-1 SDEND=4141015 I 1
  1. E S SDEND=4141015 ;default end date
  1. ;check user
  1. I USER]"",'$D(^VA(200,+USER,0)) S USER=""
  1. ;set up return array
  1. S SDECRET="^TMP(""SDECAUD"","_$J_",""SUMMGET2"")" ;global reference to return array
  1. K @SDECRET
  1. S SDECLN=0
  1. ;set up column headers for return array
  1. ; 1 2 3 4 5 6
  1. S SDTMP="T00030USERIEN^T00030USERNAME^T00030CONTACTS^T00030APPTOPEN^T00030APPTMADE^T00030APPTCLSD"
  1. ; 7 8 9 10 11
  1. S SDTMP=SDTMP_"^T00030MRTCOPEN^T00030MRTCCLSD^T00030EWLOPEN^T00030EWLMADE^T00030EWLCLSD"
  1. ; 12 13 14 15 16
  1. S SDTMP=SDTMP_"^T00030PTCSOPEN^T00030PTCSMADE^T00030CNSLTMD^T00030APPTCXLD^T00030ACTIONS"
  1. S @SDECRET@(SDECLN)=SDTMP_$C(30)
  1. ;if a single user is specified, loop over x-ref for dates for that user
  1. I USER]"" D I 1
  1. .S SDSTATS="0^0^0^0^0^0^0^0^0^0^0^0^0^0"
  1. .S X1=SDBEG,X2=-1 D C^%DTC S SDDT=X
  1. .F S SDDT=$O(^SDAUDIT("E",USER,SDDT)) Q:SDDT="" Q:SDDT>SDEND D
  1. ..S SDASIEN=""
  1. ..F S SDASIEN=$O(^SDAUDIT("E",USER,SDDT,SDASIEN)) Q:SDASIEN="" D
  1. ...S SDASDATA=^SDAUDIT(SDASIEN,0)
  1. ...S $P(SDASDATA,U,16)=$$GET1^DIQ(409.97,SDASIEN_",",15) ;field 15 is computed, so isn't in global
  1. ...F SDPC=1:1:14 S $P(SDSTATS,U,SDPC)=$P(SDSTATS,U,SDPC)+$P(SDASDATA,U,SDPC+2)
  1. .S SDECLN=SDECLN+1
  1. .S SDTMP=USER_U_$$GET1^DIQ(200,USER_",",.01)_U_SDSTATS
  1. .S @SDECRET@(SDECLN)=SDTMP_$C(30)
  1. ;otherwise, loop over x-ref for users for those dates
  1. E D
  1. .F S USER=$O(^SDAUDIT("E",USER)) Q:USER="" D
  1. ..S SDSTATS="0^0^0^0^0^0^0^0^0^0^0^0^0^0"
  1. ..S X1=SDBEG,X2=-1 D C^%DTC S SDDT=X
  1. ..F S SDDT=$O(^SDAUDIT("E",USER,SDDT)) Q:SDDT="" Q:SDDT>SDEND D
  1. ...S SDASIEN=""
  1. ...F S SDASIEN=$O(^SDAUDIT("E",USER,SDDT,SDASIEN)) Q:SDASIEN="" D
  1. ....S SDASDATA=^SDAUDIT(SDASIEN,0)
  1. ....S $P(SDASDATA,U,16)=$$GET1^DIQ(409.97,SDASIEN_",",15) ;field 15 is computed, so isn't in global
  1. ....F SDPC=1:1:14 S $P(SDSTATS,U,SDPC)=$P(SDSTATS,U,SDPC)+$P(SDASDATA,U,SDPC+2)
  1. ..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
  1. ..S SDECLN=SDECLN+1
  1. ..S SDTMP=USER_U_$$GET1^DIQ(200,USER_",",.01)_U_SDSTATS
  1. ..S @SDECRET@(SDECLN)=SDTMP_$C(30)
  1. Q