ECXUSUR ;ALB/TJL-Surgery Pre-Extract Unusual Volume Report ;6/1/17 15:30
;;3.0;DSS EXTRACTS;**49,71,84,93,105,148,149,161,166,184,185**;Dec 22, 1997;Build 134
;
EN ; entry point
N X,Y,DATE,ECRUN,ECXDESC,ECXSAVE,ECXTL,ECTHLD,ECXPORT,CNT ;149
N ECSD,ECSD1,ECSTART,ECED,ECEND,ECXERR,QFLG,ECXFLAG
K ^TMP($J)
S QFLG=0,ECTHLD="",ECXFLAG=$G(FLAG)
; get today's date
D NOW^%DTC S DATE=X,Y=$E(%,1,12) D DD^%DT S ECRUN=$P(Y,"@") K %DT
I 'ECXFLAG D BEGIN Q:QFLG
D SELECT Q:QFLG
S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 I $G(ECXPORT) D Q ;149 Section added
.K ^TMP($J,"ECXPORT"),^TMP("ECXPORT",$J)
.S ^TMP("ECXPORT",$J,0)="PRODUCTION DIVISION^PRODUCTION DIVISION NAME^"
.S ^TMP("ECXPORT",$J,0)=^TMP("ECXPORT",$J,0)_"NAME^SSN^DAY^CASE #^ENCOUNTER #^PT HOLDING TIME^ANESTHESIA TIME^PATIENT TIME^OPERATION TIME^PACU TIME^OR CLEAN TIME^CANC/ABORT^PRINCIPAL PROCEDURE",CNT=1 ;184 Added Production Division
.D PROCESS
.M ^TMP($J,"ECXPORT")=^TMP("ECXPORT",$J) ;149 Move results to TMP for printing
.D EXPDISP^ECXUTL1
.D AUDIT^ECXKILL K ^TMP("ECXPORT",$J)
S ECXDESC=$S(ECXFLAG:"Surgery Pre-Extract Volume Report",1:"Surgery Pre-Extract Unusual Volume Report") ;tjl 166 - Changed report title
S ECXSAVE("EC*")=""
W !!,"This report requires 132-column format."
D EN^XUTMDEVQ("PROCESS^ECXUSUR",ECXDESC,.ECXSAVE)
I POP W !!,"No device selected...exiting.",! Q
I IO'=IO(0) D ^%ZISC
D HOME^%ZIS
D AUDIT^ECXKILL
Q
;
BEGIN ; display report description
W @IOF
W !,"This report prints a listing of unusual volumes that would be"
W !,"generated by the Surgery extract (SUR) as determined by a"
W !,"user-defined threshold value. It should be run prior to the"
W !,"generation of the actual extract(s) to identify and fix, as"
W !,"necessary, any volumes determined to be erroneous."
W !!,"Unusual volumes are those where either the Operation Time,"
W !,"Patient Time, Anesthesia Time, Recovery Room Time, OR Clean Time"
W !,"or Pt Holding Time field is greater than the threshold value."
W !!,"Note: The threshold can be set after a report is selected."
W !!,"Run times for this report will vary depending upon the size of"
W !,"the extract and could take as long as 30 minutes or more to"
W !,"complete. This report has no effect on the actual extracts and"
W !,"can be run as needed."
W !!,"The report is sorted by descending Volume and Case Number."
S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
W:$Y!($E(IOST)="C") @IOF,!!
Q
;
SELECT ; user inputs for threshold volume and date range
N DONE,OUT
; allow user to set threshold volume
I 'ECXFLAG D
.S ECTHLD=25
.W !!,"The default threshold volume for the Surgery extract is "_ECTHLD_"."
.W !,"The default threshold volume ("_ECTHLD_") equates to 6 hours."
.S DIR(0)="Y",DIR("A")="Would you like to change the threshold?",DIR("B")="NO" D ^DIR K DIR I X["^" S QFLG=1 Q
.I Y D
..W !!,"Volume > threshold"
..S DIR(0)="N^0:99",DIR("A")="Enter the new threshold volume" D ^DIR K DIR S ECTHLD=Y I X["^" S QFLG=1 Q
; get date range from user
Q:QFLG
W !!,"Enter the date range for which you would like to scan the"
W !,"Surgery Extract records.",!
S DONE=0 F S (ECED,ECSD)="" D Q:QFLG!DONE
.K %DT S %DT="AEX",%DT("A")="Starting with Date: ",%DT(0)=-DATE D ^%DT
.I Y<0 S QFLG=1 Q
.S ECSD=Y,ECSD1=ECSD-.1
.D DD^%DT S ECSTART=Y
.K %DT S %DT="AEX",%DT("A")="Ending with Date: ",%DT(0)=-DATE D ^%DT
.I Y<0 S QFLG=1 Q
.I Y<ECSD D Q
..W !!,"The ending date cannot be earlier than the starting date."
..W !,"Please try again.",!!
.I $E(Y,1,5)'=$E(ECSD,1,5) D Q
..W !!,"Beginning and ending dates must be in the same month and year"
..W !,"Please try again.",!!
.S ECED=Y
.D DD^%DT S ECEND=Y
.S DONE=1
Q
;
PROCESS ; entry point for queued report
S ZTREQ="@"
S ECXERR=0 D EN^ECXUSUR1 Q:ECXERR
S QFLG=0 D PRINT
Q
;
PRINT ; process temp file and print report
N PG,QFLG,GTOT,LN,COUNT,VOL,SUB,REC,PIECE,COL ;149,161
N PDIV,PDIVNM,PPDIV ;184,185
U IO
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
S (PG,QFLG,GTOT,COUNT)=0,$P(LN,"-",132)="-" ;161
I '$G(ECXPORT) D HEADER Q:QFLG ;149
S PDIV="" ;184
S PPDIV="" ;185
F S PDIV=$O(^TMP($J,PDIV)) Q:PDIV="" D
. I '$G(ECXPORT) W:PPDIV'="" ! W !,?31," PRODUCTION DIVISION: ",$P(PDIV,"~"),! ;184,185
. S PPDIV=PDIV
. S VOL=-999999 F S VOL=$O(^TMP($J,PDIV,VOL)) Q:VOL=""!QFLG D
..S SUB="" F S SUB=$O(^TMP($J,PDIV,VOL,SUB)) Q:SUB=""!QFLG S REC=^(SUB) D ;185 - Add a dot "." in the following code block
...I $G(ECXPORT) F PIECE=1:1:5,7,11,9,10,6,8,14,13 S ^TMP("ECXPORT",$J,CNT)=$G(^TMP("ECXPORT",$J,CNT))_$P(REC,U,PIECE)_$S(PIECE'=13:"^",1:"") ;S:PIECE=13 CNT=CNT+1 ;149,184 - Update CNT below
...I $G(ECXPORT) S ^TMP("ECXPORT",$J,CNT)=$P(PDIV,"~")_U_$P(PDIV,"~",2)_U_$G(^TMP("ECXPORT",$J,CNT)),CNT=CNT+1 ;184 - Added Production Division and name to export format,185 - Get the division and division name from 2nd subscript
...I $G(ECXPORT) Q ;149
...S COUNT=COUNT+1
...I $Y+3>IOSL D HEADER W !?31," PRODUCTION DIVISION: ",$P(PDIV,"~"),! Q:QFLG ;184 - Added PDIV,185
...W !,$P(REC,U),?8,$P(REC,U,2),?15,$P(REC,U,3),?24,$P(REC,U,4) ;161, 184 - only display the last 4 of SSN
...W ?31,$P(REC,U,5) ;161
...S COL=$S($P(REC,U,7):52,1:49) W ?COL,$$RJ^XLFSTR($P(REC,U,7),4) ;161
...S COL=$S($P(REC,U,11):63,1:60) W ?COL,$$RJ^XLFSTR($P(REC,U,11),4) ;161
...S COL=$S($P(REC,U,9):73,1:71) W ?COL,$$RJ^XLFSTR($P(REC,U,9),4) ;161
...S COL=$S($P(REC,U,10):84,1:81) W ?COL,$$RJ^XLFSTR($P(REC,U,10),4) ;161
...W ?91,$$RJ^XLFSTR($P(REC,U,6),4) ;161
...S COL=$S($P(REC,U,8):103,1:101) W ?COL,$$RJ^XLFSTR($P(REC,U,8),4),?113,$P(REC,U,14) ;161
...W ?117,$P(REC,U,13)
I $G(ECXPORT) Q ;149
Q:QFLG
I COUNT=0 W !!,?8,$S(ECXFLAG=1:"No surgery volumes to report for this extract",1:"No unusual volumes to report for this extract")
CLOSE ;
I $E(IOST)="C",'QFLG D
.S SS=22-$Y F JJ=1:1:SS W !
.S DIR(0)="E" W ! D ^DIR K DIR
Q
;
N SS,JJ
I $E(IOST)="C" D
.S SS=22-$Y F JJ=1:1:SS W !
.I PG>0 S DIR(0)="E" W ! D ^DIR K DIR S:'Y QFLG=1
Q:QFLG
W:$Y!($E(IOST)="C") @IOF S PG=PG+1
W !,$S(ECXFLAG:"Surgery Pre-Extract Volume Report",1:"Surgery Pre-Extract Unusual Volume Report"),?124,"Page: "_PG ;tjl 166 - Changed report title
W !,"Start Date: ",ECSTART,?97,"Report Run Date/Time: "_ECRUN
W !," End Date: ",ECEND I 'ECXFLAG W ?97," Threshold Value: ",ECTHLD
W !!,?25,"Case",?35,"Encounter",?49,"Pt Holding",?60,"Anesthesia",?71,"Patient",?81,"Operation",?91,"PACU",?101,"OR Clean",?111,"Canc/",?121,"Principal" ;161
W !,"Name",?8,"SSN",?17,"Day",?24,"Number",?37,"Number" ;161
W ?51,"Time",?63,"Time",?73,"Time",?84,"Time",?91,"Time",?104,"Time" ;161
W ?111,"Abort",?121,"Procedure"
W !,LN ;185 Removed blank line
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXUSUR 6860 printed Apr 09, 2024@20:55:49 Page 2
ECXUSUR ;ALB/TJL-Surgery Pre-Extract Unusual Volume Report ;6/1/17 15:30
+1 ;;3.0;DSS EXTRACTS;**49,71,84,93,105,148,149,161,166,184,185**;Dec 22, 1997;Build 134
+2 ;
EN ; entry point
+1 ;149
NEW X,Y,DATE,ECRUN,ECXDESC,ECXSAVE,ECXTL,ECTHLD,ECXPORT,CNT
+2 NEW ECSD,ECSD1,ECSTART,ECED,ECEND,ECXERR,QFLG,ECXFLAG
+3 KILL ^TMP($JOB)
+4 SET QFLG=0
SET ECTHLD=""
SET ECXFLAG=$GET(FLAG)
+5 ; get today's date
+6 DO NOW^%DTC
SET DATE=X
SET Y=$EXTRACT(%,1,12)
DO DD^%DT
SET ECRUN=$PIECE(Y,"@")
KILL %DT
+7 IF 'ECXFLAG
DO BEGIN
if QFLG
QUIT
+8 DO SELECT
if QFLG
QUIT
+9 ;149 Section added
SET ECXPORT=$$EXPORT^ECXUTL1
if ECXPORT=-1
QUIT
IF $GET(ECXPORT)
Begin DoDot:1
+10 KILL ^TMP($JOB,"ECXPORT"),^TMP("ECXPORT",$JOB)
+11 SET ^TMP("ECXPORT",$JOB,0)="PRODUCTION DIVISION^PRODUCTION DIVISION NAME^"
+12 ;184 Added Production Division
SET ^TMP("ECXPORT",$JOB,0)=^TMP("ECXPORT",$JOB,0)_"NAME^SSN^DAY^CASE #^ENCOUNTER #^PT HOLDING TIME^ANESTHESIA TIME^PATIENT TIME^OPERATION TIME^PACU TIME^OR CLEAN TIME^CANC/ABORT^PRINCIPAL PROCEDURE"
SET CNT=1
+13 DO PROCESS
+14 ;149 Move results to TMP for printing
MERGE ^TMP($JOB,"ECXPORT")=^TMP("ECXPORT",$JOB)
+15 DO EXPDISP^ECXUTL1
+16 DO AUDIT^ECXKILL
KILL ^TMP("ECXPORT",$JOB)
End DoDot:1
QUIT
+17 ;tjl 166 - Changed report title
SET ECXDESC=$SELECT(ECXFLAG:"Surgery Pre-Extract Volume Report",1:"Surgery Pre-Extract Unusual Volume Report")
+18 SET ECXSAVE("EC*")=""
+19 WRITE !!,"This report requires 132-column format."
+20 DO EN^XUTMDEVQ("PROCESS^ECXUSUR",ECXDESC,.ECXSAVE)
+21 IF POP
WRITE !!,"No device selected...exiting.",!
QUIT
+22 IF IO'=IO(0)
DO ^%ZISC
+23 DO HOME^%ZIS
+24 DO AUDIT^ECXKILL
+25 QUIT
+26 ;
BEGIN ; display report description
+1 WRITE @IOF
+2 WRITE !,"This report prints a listing of unusual volumes that would be"
+3 WRITE !,"generated by the Surgery extract (SUR) as determined by a"
+4 WRITE !,"user-defined threshold value. It should be run prior to the"
+5 WRITE !,"generation of the actual extract(s) to identify and fix, as"
+6 WRITE !,"necessary, any volumes determined to be erroneous."
+7 WRITE !!,"Unusual volumes are those where either the Operation Time,"
+8 WRITE !,"Patient Time, Anesthesia Time, Recovery Room Time, OR Clean Time"
+9 WRITE !,"or Pt Holding Time field is greater than the threshold value."
+10 WRITE !!,"Note: The threshold can be set after a report is selected."
+11 WRITE !!,"Run times for this report will vary depending upon the size of"
+12 WRITE !,"the extract and could take as long as 30 minutes or more to"
+13 WRITE !,"complete. This report has no effect on the actual extracts and"
+14 WRITE !,"can be run as needed."
+15 WRITE !!,"The report is sorted by descending Volume and Case Number."
+16 SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
IF 'Y
SET QFLG=1
QUIT
+17 if $Y!($EXTRACT(IOST)="C")
WRITE @IOF,!!
+18 QUIT
+19 ;
SELECT ; user inputs for threshold volume and date range
+1 NEW DONE,OUT
+2 ; allow user to set threshold volume
+3 IF 'ECXFLAG
Begin DoDot:1
+4 SET ECTHLD=25
+5 WRITE !!,"The default threshold volume for the Surgery extract is "_ECTHLD_"."
+6 WRITE !,"The default threshold volume ("_ECTHLD_") equates to 6 hours."
+7 SET DIR(0)="Y"
SET DIR("A")="Would you like to change the threshold?"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
IF X["^"
SET QFLG=1
QUIT
+8 IF Y
Begin DoDot:2
+9 WRITE !!,"Volume > threshold"
+10 SET DIR(0)="N^0:99"
SET DIR("A")="Enter the new threshold volume"
DO ^DIR
KILL DIR
SET ECTHLD=Y
IF X["^"
SET QFLG=1
QUIT
End DoDot:2
End DoDot:1
+11 ; get date range from user
+12 if QFLG
QUIT
+13 WRITE !!,"Enter the date range for which you would like to scan the"
+14 WRITE !,"Surgery Extract records.",!
+15 SET DONE=0
FOR
SET (ECED,ECSD)=""
Begin DoDot:1
+16 KILL %DT
SET %DT="AEX"
SET %DT("A")="Starting with Date: "
SET %DT(0)=-DATE
DO ^%DT
+17 IF Y<0
SET QFLG=1
QUIT
+18 SET ECSD=Y
SET ECSD1=ECSD-.1
+19 DO DD^%DT
SET ECSTART=Y
+20 KILL %DT
SET %DT="AEX"
SET %DT("A")="Ending with Date: "
SET %DT(0)=-DATE
DO ^%DT
+21 IF Y<0
SET QFLG=1
QUIT
+22 IF Y<ECSD
Begin DoDot:2
+23 WRITE !!,"The ending date cannot be earlier than the starting date."
+24 WRITE !,"Please try again.",!!
End DoDot:2
QUIT
+25 IF $EXTRACT(Y,1,5)'=$EXTRACT(ECSD,1,5)
Begin DoDot:2
+26 WRITE !!,"Beginning and ending dates must be in the same month and year"
+27 WRITE !,"Please try again.",!!
End DoDot:2
QUIT
+28 SET ECED=Y
+29 DO DD^%DT
SET ECEND=Y
+30 SET DONE=1
End DoDot:1
if QFLG!DONE
QUIT
+31 QUIT
+32 ;
PROCESS ; entry point for queued report
+1 SET ZTREQ="@"
+2 SET ECXERR=0
DO EN^ECXUSUR1
if ECXERR
QUIT
+3 SET QFLG=0
DO PRINT
+4 QUIT
+5 ;
PRINT ; process temp file and print report
+1 ;149,161
NEW PG,QFLG,GTOT,LN,COUNT,VOL,SUB,REC,PIECE,COL
+2 ;184,185
NEW PDIV,PDIVNM,PPDIV
+3 USE IO
+4 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
KILL ZTREQ
QUIT
+5 ;161
SET (PG,QFLG,GTOT,COUNT)=0
SET $PIECE(LN,"-",132)="-"
+6 ;149
IF '$GET(ECXPORT)
DO HEADER
if QFLG
QUIT
+7 ;184
SET PDIV=""
+8 ;185
SET PPDIV=""
+9 FOR
SET PDIV=$ORDER(^TMP($JOB,PDIV))
if PDIV=""
QUIT
Begin DoDot:1
+10 ;184,185
IF '$GET(ECXPORT)
if PPDIV'=""
WRITE !
WRITE !,?31," PRODUCTION DIVISION: ",$PIECE(PDIV,"~"),!
+11 SET PPDIV=PDIV
+12 SET VOL=-999999
FOR
SET VOL=$ORDER(^TMP($JOB,PDIV,VOL))
if VOL=""!QFLG
QUIT
Begin DoDot:2
+13 ;185 - Add a dot "." in the following code block
SET SUB=""
FOR
SET SUB=$ORDER(^TMP($JOB,PDIV,VOL,SUB))
if SUB=""!QFLG
QUIT
SET REC=^(SUB)
Begin DoDot:3
+14 ;S:PIECE=13 CNT=CNT+1 ;149,184 - Update CNT below
IF $GET(ECXPORT)
FOR PIECE=1:1:5,7,11,9,10,6,8,14,13
SET ^TMP("ECXPORT",$JOB,CNT)=$GET(^TMP("ECXPORT",$JOB,CNT))_$PIECE(REC,U,PIECE)_$SELECT(PIECE'=13:"^",1:"")
+15 ;184 - Added Production Division and name to export format,185 - Get the division and division name from 2nd subscript
IF $GET(ECXPORT)
SET ^TMP("ECXPORT",$JOB,CNT)=$PIECE(PDIV,"~")_U_$PIECE(PDIV,"~",2)_U_$GET(^TMP("ECXPORT",$JOB,CNT))
SET CNT=CNT+1
+16 ;149
IF $GET(ECXPORT)
QUIT
+17 SET COUNT=COUNT+1
+18 ;184 - Added PDIV,185
IF $Y+3>IOSL
DO HEADER
WRITE !?31," PRODUCTION DIVISION: ",$PIECE(PDIV,"~"),!
if QFLG
QUIT
+19 ;161, 184 - only display the last 4 of SSN
WRITE !,$PIECE(REC,U),?8,$PIECE(REC,U,2),?15,$PIECE(REC,U,3),?24,$PIECE(REC,U,4)
+20 ;161
WRITE ?31,$PIECE(REC,U,5)
+21 ;161
SET COL=$SELECT($PIECE(REC,U,7):52,1:49)
WRITE ?COL,$$RJ^XLFSTR($PIECE(REC,U,7),4)
+22 ;161
SET COL=$SELECT($PIECE(REC,U,11):63,1:60)
WRITE ?COL,$$RJ^XLFSTR($PIECE(REC,U,11),4)
+23 ;161
SET COL=$SELECT($PIECE(REC,U,9):73,1:71)
WRITE ?COL,$$RJ^XLFSTR($PIECE(REC,U,9),4)
+24 ;161
SET COL=$SELECT($PIECE(REC,U,10):84,1:81)
WRITE ?COL,$$RJ^XLFSTR($PIECE(REC,U,10),4)
+25 ;161
WRITE ?91,$$RJ^XLFSTR($PIECE(REC,U,6),4)
+26 ;161
SET COL=$SELECT($PIECE(REC,U,8):103,1:101)
WRITE ?COL,$$RJ^XLFSTR($PIECE(REC,U,8),4),?113,$PIECE(REC,U,14)
+27 WRITE ?117,$PIECE(REC,U,13)
End DoDot:3
End DoDot:2
End DoDot:1
+28 ;149
IF $GET(ECXPORT)
QUIT
+29 if QFLG
QUIT
+30 IF COUNT=0
WRITE !!,?8,$SELECT(ECXFLAG=1:"No surgery volumes to report for this extract",1:"No unusual volumes to report for this extract")
CLOSE ;
+1 IF $EXTRACT(IOST)="C"
IF 'QFLG
Begin DoDot:1
+2 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+3 SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
End DoDot:1
+4 QUIT
+5 ;
+1 NEW SS,JJ
+2 IF $EXTRACT(IOST)="C"
Begin DoDot:1
+3 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+4 IF PG>0
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
if 'Y
SET QFLG=1
End DoDot:1
+5 if QFLG
QUIT
+6 if $Y!($EXTRACT(IOST)="C")
WRITE @IOF
SET PG=PG+1
+7 ;tjl 166 - Changed report title
WRITE !,$SELECT(ECXFLAG:"Surgery Pre-Extract Volume Report",1:"Surgery Pre-Extract Unusual Volume Report"),?124,"Page: "_PG
+8 WRITE !,"Start Date: ",ECSTART,?97,"Report Run Date/Time: "_ECRUN
+9 WRITE !," End Date: ",ECEND
IF 'ECXFLAG
WRITE ?97," Threshold Value: ",ECTHLD
+10 ;161
WRITE !!,?25,"Case",?35,"Encounter",?49,"Pt Holding",?60,"Anesthesia",?71,"Patient",?81,"Operation",?91,"PACU",?101,"OR Clean",?111,"Canc/",?121,"Principal"
+11 ;161
WRITE !,"Name",?8,"SSN",?17,"Day",?24,"Number",?37,"Number"
+12 ;161
WRITE ?51,"Time",?63,"Time",?73,"Time",?84,"Time",?91,"Time",?104,"Time"
+13 WRITE ?111,"Abort",?121,"Procedure"
+14 ;185 Removed blank line
WRITE !,LN
+15 QUIT
+16 ;
