Changeset 623 for WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXUSUR.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXUSUR.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXUSUR.m
r613 r623 1 ECXUSUR ;ALB/TJL-Surgery Extract Unusual Volume Report ; 9/4/07 8:19am 2 ;;3.0;DSS EXTRACTS;**49,71,84,93,105**;July 1, 2003;Build 70 3 ; 4 EN ; entry point 5 N X,Y,DATE,ECRUN,ECXDESC,ECXSAVE,ECXTL,ECTHLD 6 N ECSD,ECSD1,ECSTART,ECED,ECEND,ECXERR,QFLG,ECXFLAG 7 S QFLG=0,ECTHLD="",ECXFLAG=$G(FLAG) 8 ; get today's date 9 D NOW^%DTC S DATE=X,Y=$E(%,1,12) D DD^%DT S ECRUN=$P(Y,"@") K %DT 10 I 'ECXFLAG D BEGIN Q:QFLG 11 D SELECT Q:QFLG 12 S ECXDESC=$S(ECXFLAG:"SUR Volume Report",1:"Surgery Extract Unusual Volume Report") 13 S ECXSAVE("EC*")="" 14 W !!,"This report requires 132-column format." 15 D EN^XUTMDEVQ("PROCESS^ECXUSUR",ECXDESC,.ECXSAVE) 16 I POP W !!,"No device selected...exiting.",! Q 17 I IO'=IO(0) D ^%ZISC 18 D HOME^%ZIS 19 D AUDIT^ECXKILL 20 Q 21 ; 22 BEGIN ; display report description 23 W @IOF 24 W !,"This report prints a listing of unusual volumes that would be" 25 W !,"generated by the Surgery extract (SUR) as determined by a" 26 W !,"user-defined threshold value. It should be run prior to the" 27 W !,"generation of the actual extract(s) to identify and fix, as" 28 W !,"necessary, any volumes determined to be erroneous." 29 W !!,"Unusual volumes are those where either the Operation Time," 30 W !,"Patient Time, Anesthesia Time, Recovery Room Time, OR Clean Time" 31 W !,"or Pt Holding Time field is greater than the threshold value." 32 W !!,"Note: The threshold can be set after a report is selected." 33 W !!,"Run times for this report will vary depending upon the size of" 34 W !,"the extract and could take as long as 30 minutes or more to" 35 W !,"complete. This report has no effect on the actual extracts and" 36 W !,"can be run as needed." 37 W !!,"The report is sorted by descending Volume and Case Number." 38 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q 39 W:$Y!($E(IOST)="C") @IOF,!! 40 Q 41 ; 42 SELECT ; user inputs for threshold volume and date range 43 N DONE,OUT 44 ; allow user to set threshold volume 45 I 'ECXFLAG D 46 .S ECTHLD=25 47 .W !!,"The default threshold volume for the Surgery extract is "_ECTHLD_"." 48 .W !,"The default threshold volume ("_ECTHLD_") equates to 6 hours." 49 .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 50 .I Y D 51 ..W !!,"Volume > threshold" 52 ..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 53 ; get date range from user 54 Q:QFLG 55 W !!,"Enter the date range for which you would like to scan the" 56 W !,"Surgery Extract records.",! 57 S DONE=0 F S (ECED,ECSD)="" D Q:QFLG!DONE 58 .K %DT S %DT="AEX",%DT("A")="Starting with Date: ",%DT(0)=-DATE D ^%DT 59 .I Y<0 S QFLG=1 Q 60 .S ECSD=Y,ECSD1=ECSD-.1 61 .D DD^%DT S ECSTART=Y 62 .K %DT S %DT="AEX",%DT("A")="Ending with Date: ",%DT(0)=-DATE D ^%DT 63 .I Y<0 S QFLG=1 Q 64 .I Y<ECSD D Q 65 ..W !!,"The ending date cannot be earlier than the starting date." 66 ..W !,"Please try again.",!! 67 .I $E(Y,1,5)'=$E(ECSD,1,5) D Q 68 ..W !!,"Beginning and ending dates must be in the same month and year" 69 ..W !,"Please try again.",!! 70 .S ECED=Y 71 .D DD^%DT S ECEND=Y 72 .S DONE=1 73 Q 74 ; 75 PROCESS ; entry point for queued report 76 S ZTREQ="@" 77 S ECXERR=0 D EN^ECXUSUR1 Q:ECXERR 78 S QFLG=0 D PRINT 79 Q 80 ; 81 PRINT ; process temp file and print report 82 N PG,QFLG,GTOT,LN,COUNT,VOL,SUB,REC 83 U IO 84 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q 85 S (PG,QFLG,GTOT,COUNT)=0,$P(LN,"-",132)="" 86 D HEADER Q:QFLG 87 S VOL=-999999 F S VOL=$O(^TMP($J,VOL)) Q:VOL=""!QFLG D 88 .S SUB="" F S SUB=$O(^TMP($J,VOL,SUB)) Q:SUB=""!QFLG S REC=^(SUB) D 89 ..S COUNT=COUNT+1 90 ..I $Y+3>IOSL D HEADER Q:QFLG 91 ..W !,?1,$P(REC,U),?7,$P(REC,U,2),?18,$P(REC,U,3),?27,$P(REC,U,4) 92 ..W ?34,$P(REC,U,5),?55,$$RJ^XLFSTR($P(REC,U,7),4) 93 ..W ?66,$$RJ^XLFSTR($P(REC,U,11),4),?77,$$RJ^XLFSTR($P(REC,U,9),4) 94 ..W ?86,$$RJ^XLFSTR($P(REC,U,10),4),?93,$$RJ^XLFSTR($P(REC,U,6),4) 95 ..W ?103,$$RJ^XLFSTR($P(REC,U,8),4),?113,$P(REC,U,14) 96 ..W ?117,$P(REC,U,13) 97 Q:QFLG 98 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") 99 CLOSE ; 100 I $E(IOST)="C",'QFLG D 101 .S SS=22-$Y F JJ=1:1:SS W ! 102 .S DIR(0)="E" W ! D ^DIR K DIR 103 Q 104 ; 105 HEADER ;header and page control 106 N SS,JJ 107 I $E(IOST)="C" D 108 .S SS=22-$Y F JJ=1:1:SS W ! 109 .I PG>0 S DIR(0)="E" W ! D ^DIR K DIR S:'Y QFLG=1 110 Q:QFLG 111 W:$Y!($E(IOST)="C") @IOF S PG=PG+1 112 W !,$S(ECXFLAG:"SUR Volume Report",1:"Surgery Extract Unusual Volume Report"),?124,"Page: "_PG 113 W !,"Start Date: ",ECSTART,?97,"Report Run Date/Time: "_ECRUN 114 W !," End Date: ",ECEND I 'ECXFLAG W ?97," Threshold Value: ",ECTHLD 115 W !!,?28,"Case",?38,"Encounter",?52,"Pt Holding",?63,"Anesthesia",?75,"Patient",?83,"Operation",?93,"PACU",?101,"OR Clean",?111,"Canc/",?121,"Principal" 116 W !,?1,"Name",?10,"SSN",?20,"Day",?27,"Number",?40,"Number" 117 W ?54,"Time",?66,"Time",?77,"Time",?86,"Time",?93,"Time",?103,"Time" 118 W ?111,"Abort",?121,"Procedure" 119 W !,LN,! 120 Q 121 ; 1 ECXUSUR ;ALB/TJL-Surgery Extract Unusual Volume Report ; 4/11/06 10:44AM 2 ;;3.0;DSS EXTRACTS;**49,71,84,93**;July 1, 2003 3 ; 4 EN ; entry point 5 N X,Y,DATE,ECRUN,ECXDESC,ECXSAVE,ECXTL,ECTHLD 6 N ECSD,ECSD1,ECSTART,ECED,ECEND,ECXERR,QFLG,ECXFLAG 7 S QFLG=0,ECTHLD="",ECXFLAG=$G(FLAG) 8 ; get today's date 9 D NOW^%DTC S DATE=X,Y=$E(%,1,12) D DD^%DT S ECRUN=$P(Y,"@") K %DT 10 I 'ECXFLAG D BEGIN Q:QFLG 11 D SELECT Q:QFLG 12 S ECXDESC=$S(ECXFLAG:"SUR Volume Report",1:"Surgery Extract Unusual Volume Report") 13 S ECXSAVE("EC*")="" 14 W !!,"This report requires 132-column format." 15 D EN^XUTMDEVQ("PROCESS^ECXUSUR",ECXDESC,.ECXSAVE) 16 I POP W !!,"No device selected...exiting.",! Q 17 I IO'=IO(0) D ^%ZISC 18 D HOME^%ZIS 19 D AUDIT^ECXKILL 20 Q 21 ; 22 BEGIN ; display report description 23 W @IOF 24 W !,"This report prints a listing of unusual volumes that would be" 25 W !,"generated by the Surgery extract (SUR) as determined by a" 26 W !,"user-defined threshold value. It should be run prior to the" 27 W !,"generation of the actual extract(s) to identify and fix, as" 28 W !,"necessary, any volumes determined to be erroneous." 29 W !!,"Unusual volumes are those where either the Operation Time," 30 W !,"Patient Time, Anesthesia Time, Recovery Room Time, OR Clean Time" 31 W !,"or Pt Holding Time field is greater than the threshold value." 32 W !!,"Note: The threshold can be set after a report is selected." 33 W !!,"Run times for this report will vary depending upon the size of" 34 W !,"the extract and could take as long as 30 minutes or more to" 35 W !,"complete. This report has no effect on the actual extracts and" 36 W !,"can be run as needed." 37 W !!,"The report is sorted by descending Volume and Case Number." 38 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q 39 W:$Y!($E(IOST)="C") @IOF,!! 40 Q 41 ; 42 SELECT ; user inputs for threshold volume and date range 43 N DONE,OUT 44 ; allow user to set threshold volume 45 I 'ECXFLAG D 46 .S ECTHLD=25 47 .W !!,"The default threshold volume for the Surgery extract is "_ECTHLD_"." 48 .W !,"The default threshold volume ("_ECTHLD_") equates to 6 hours." 49 .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 50 .I Y D 51 ..W !!,"Volume > threshold" 52 ..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 53 ; get date range from user 54 Q:QFLG 55 W !!,"Enter the date range for which you would like to scan the" 56 W !,"Surgery Extract records.",! 57 S DONE=0 F S (ECED,ECSD)="" D Q:QFLG!DONE 58 .K %DT S %DT="AEX",%DT("A")="Starting with Date: ",%DT(0)=-DATE D ^%DT 59 .I Y<0 S QFLG=1 Q 60 .S ECSD=Y,ECSD1=ECSD-.1 61 .D DD^%DT S ECSTART=Y 62 .K %DT S %DT="AEX",%DT("A")="Ending with Date: ",%DT(0)=-DATE D ^%DT 63 .I Y<0 S QFLG=1 Q 64 .I Y<ECSD D Q 65 ..W !!,"The ending date cannot be earlier than the starting date." 66 ..W !,"Please try again.",!! 67 .I $E(Y,1,5)'=$E(ECSD,1,5) D Q 68 ..W !!,"Beginning and ending dates must be in the same month and year" 69 ..W !,"Please try again.",!! 70 .S ECED=Y 71 .D DD^%DT S ECEND=Y 72 .S DONE=1 73 Q 74 ; 75 PROCESS ; entry point for queued report 76 S ZTREQ="@" 77 S ECXERR=0 D EN^ECXUSUR1 Q:ECXERR 78 S QFLG=0 D PRINT 79 Q 80 ; 81 PRINT ; process temp file and print report 82 N PG,QFLG,GTOT,LN,COUNT,VOL,SUB,REC 83 U IO 84 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q 85 S (PG,QFLG,GTOT,COUNT)=0,$P(LN,"-",132)="" 86 D HEADER Q:QFLG 87 S VOL=-999999 F S VOL=$O(^TMP($J,VOL)) Q:VOL=""!QFLG D 88 .S SUB="" F S SUB=$O(^TMP($J,VOL,SUB)) Q:SUB=""!QFLG S REC=^(SUB) D 89 ..S COUNT=COUNT+1 90 ..I $Y+3>IOSL D HEADER Q:QFLG 91 ..W !,$P(REC,U),?6,$P(REC,U,2),?17,$P(REC,U,3),?26,$P(REC,U,4) 92 ..W ?33,$P(REC,U,5),?55,$$RJ^XLFSTR($P(REC,U,9),4) 93 ..W ?63,$$RJ^XLFSTR($P(REC,U,10),4),?74,$$RJ^XLFSTR($P(REC,U,11),4) 94 ..W ?83,$$RJ^XLFSTR($P(REC,U,6),4),?90,$$RJ^XLFSTR($P(REC,U,8),4) 95 ..W ?101,$$RJ^XLFSTR($P(REC,U,7),4),?114,$P(REC,U,13) 96 Q:QFLG 97 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") 98 CLOSE ; 99 I $E(IOST)="C",'QFLG D 100 .S SS=22-$Y F JJ=1:1:SS W ! 101 .S DIR(0)="E" W ! D ^DIR K DIR 102 Q 103 ; 104 HEADER ;header and page control 105 N SS,JJ 106 I $E(IOST)="C" D 107 .S SS=22-$Y F JJ=1:1:SS W ! 108 .I PG>0 S DIR(0)="E" W ! D ^DIR K DIR S:'Y QFLG=1 109 Q:QFLG 110 W:$Y!($E(IOST)="C") @IOF S PG=PG+1 111 W !,$S(ECXFLAG:"SUR Volume Report",1:"Surgery Extract Unusual Volume Report"),?124,"Page: "_PG 112 W !,"Start Date: ",ECSTART,?97,"Report Run Date/Time: "_ECRUN 113 W !," End Date: ",ECEND I 'ECXFLAG W ?97," Threshold Value: ",ECTHLD 114 W !!,?27,"Case",?37,"Encounter",?53,"Patient",?61,"Operation",?71,"Anesthesia",?83,"PACU",?89,"OR Clean",?99,"Pt Holding",?114,"Principal" 115 W !,"Name",?9,"SSN",?19,"Day",?26,"Number",?39,"Number" 116 W ?55,"Time",?63,"Time",?74,"Time",?83,"Time",?90,"Time",?101,"Time" 117 W ?114,"Procedure" 118 W !,LN,! 119 Q 120 ;
Note:
See TracChangeset
for help on using the changeset viewer.
