121 lines
4.6 KiB
Mathematica
121 lines
4.6 KiB
Mathematica
ECXUSUR ;ALB/TJL-Surgery Extract Unusual Volume Report ; 4/11/06 10:44AM
|
|
;;3.0;DSS EXTRACTS;**49,71,84,93**;July 1, 2003
|
|
;
|
|
EN ; entry point
|
|
N X,Y,DATE,ECRUN,ECXDESC,ECXSAVE,ECXTL,ECTHLD
|
|
N ECSD,ECSD1,ECSTART,ECED,ECEND,ECXERR,QFLG,ECXFLAG
|
|
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 ECXDESC=$S(ECXFLAG:"SUR Volume Report",1:"Surgery Extract Unusual Volume Report")
|
|
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
|
|
U IO
|
|
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
|
|
S (PG,QFLG,GTOT,COUNT)=0,$P(LN,"-",132)=""
|
|
D HEADER Q:QFLG
|
|
S VOL=-999999 F S VOL=$O(^TMP($J,VOL)) Q:VOL=""!QFLG D
|
|
.S SUB="" F S SUB=$O(^TMP($J,VOL,SUB)) Q:SUB=""!QFLG S REC=^(SUB) D
|
|
..S COUNT=COUNT+1
|
|
..I $Y+3>IOSL D HEADER Q:QFLG
|
|
..W !,$P(REC,U),?6,$P(REC,U,2),?17,$P(REC,U,3),?26,$P(REC,U,4)
|
|
..W ?33,$P(REC,U,5),?55,$$RJ^XLFSTR($P(REC,U,9),4)
|
|
..W ?63,$$RJ^XLFSTR($P(REC,U,10),4),?74,$$RJ^XLFSTR($P(REC,U,11),4)
|
|
..W ?83,$$RJ^XLFSTR($P(REC,U,6),4),?90,$$RJ^XLFSTR($P(REC,U,8),4)
|
|
..W ?101,$$RJ^XLFSTR($P(REC,U,7),4),?114,$P(REC,U,13)
|
|
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
|
|
;
|
|
HEADER ;header and page control
|
|
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:"SUR Volume Report",1:"Surgery Extract Unusual Volume Report"),?124,"Page: "_PG
|
|
W !,"Start Date: ",ECSTART,?97,"Report Run Date/Time: "_ECRUN
|
|
W !," End Date: ",ECEND I 'ECXFLAG W ?97," Threshold Value: ",ECTHLD
|
|
W !!,?27,"Case",?37,"Encounter",?53,"Patient",?61,"Operation",?71,"Anesthesia",?83,"PACU",?89,"OR Clean",?99,"Pt Holding",?114,"Principal"
|
|
W !,"Name",?9,"SSN",?19,"Day",?26,"Number",?39,"Number"
|
|
W ?55,"Time",?63,"Time",?74,"Time",?83,"Time",?90,"Time",?101,"Time"
|
|
W ?114,"Procedure"
|
|
W !,LN,!
|
|
Q
|
|
;
|