- 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 Feb 19, 2025@00:18:14 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