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

ECXUEC.m

Go to the documentation of this file. 
  1. ECXUEC ;ALB/TJL,JAP - Event Capture Pre-Extract Unusual Volume Report ;6/1/17  15:33
  1.  ;;3.0;DSS EXTRACTS;**120,127,148,149,161,166**;Dec 22, 1997;Build 24
  1.  ;
  1. EN ; entry point
  1.  N X,Y,DATE,ECRUN,ECXDESC,ECXSAVE,ECXTL,ECTHLD
  1.  N ECSD,ECSD1,ECSTART,ECXDSS,ECED,ECEND,ECXERR,QFLG,DIR,DTOUT,DUOUT,DIRUT,POP,ZTSK,ZTQUEUED,DIC,%,ECXPORT,CNT ;149
  1.  S QFLG=0,ECTHLD=""
  1.  ; get today's date
  1.  D NOW^%DTC S DATE=X,Y=$E(%,1,12) D DD^%DT S ECRUN=$P(Y,"@") K %DT
  1.  D BEGIN Q:QFLG
  1.  D SELECT Q:QFLG
  1.  S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1  I $G(ECXPORT) D  Q  ;149 Section added
  1.  .K ^TMP($J,"ECXPORT")
  1.  .S ^TMP($J,"ECXPORT",0)="SSN^FACILITY^DSS UNIT^DATE/TIME^PROCEDURE^VOLUME^PROVIDER",CNT=1
  1.  .D START,PRINT
  1.  .D EXPDISP^ECXUTL1
  1.  .K ^TMP($J,"ECXPORT"),^TMP("ECUV",$J)
  1.  S ECXDESC="Event Capture Pre-Extract Unusual Volume Report"  ;tjl 166 Changed report title
  1.  S ECXSAVE("EC*")=""
  1.  W !!,"This report is formatted for 132-column line width."
  1.  W !!,"Enter 'Q' to queue report to TaskManager, then select printer."
  1.  D EN^XUTMDEVQ("PROCESS^ECXUEC",ECXDESC,.ECXSAVE,"",1)
  1.  I $G(POP) W !!,"No device selected...exiting.",! Q
  1.  I IO'=IO(0) D ^%ZISC
  1.  D HOME^%ZIS
  1.  I $D(ZTSK) W !!,"Queued as Task #"_ZTSK_"."
  1.  Q
  1.  ;
  1. BEGIN ; display report description
  1.  W @IOF
  1.  W !,"Event Capture Pre-Extract Unusual Volume Report"  ;tjl 166 Changed report title
  1.  W !!,"   This report prints a listing of unusual volumes that would be"
  1.  W !,"   generated by the Event Capture extract (ECS) as determined by"
  1.  W !,"   a user-defined threshold value. It should be run prior to"
  1.  W !,"   the generation of an actual extract to identify and fix, as"
  1.  W !,"   necessary, any volumes determined to be erroneous."
  1.  W !!,"   Unusual volumes are those in excess of the threshold value"
  1.  W !,"   defined by the user. The threshold value is 20 by default."
  1.  W !!,"   Note: You may set a different threshold if you opt to continue."
  1.  W !!,"   Run times will vary depending upon the size of the EVENT CAPTURE"
  1.  W !,"   PATIENT file (#721) and the date range selected, but may be at"
  1.  W !,"   least several minutes. Queuing to a printer is recommended."
  1.  W !!,"   The running of this report has no effect on the actual extracts"
  1.  W !,"   and can be run as needed."
  1.  W !!,"   You may select one or all DSS Units.  If you select one unit,"
  1.  W !,"   the report is sorted by descending volume. If you select all DSS Units, "
  1.  W !,"   the report is sorted by DSS Unit, then by descending volume."
  1.  S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
  1.  W:$Y!($E(IOST)="C") @IOF,!!
  1.  Q
  1.  ;
  1. SELECT ; user inputs for threshold volume and date range
  1.  N DONE,OUT
  1.  ; allow user to set threshold volume
  1.  S ECTHLD=20
  1.  W !!,"The default threshold volume for unusual volumes in Event Capture is "_ECTHLD_"."
  1.  S DIR(0)="Y",DIR("A")="Would you like to change the threshold",DIR("B")="NO"
  1.  D ^DIR K DIR I X["^" S QFLG=1 Q
  1.  I Y D
  1.  .W !!,"Volume > threshold"
  1.  .S DIR(0)="N^0:99",DIR("A")="Enter the new threshold volume"
  1.  .D ^DIR K DIR S ECTHLD=Y I X["^" S QFLG=1
  1.  ; get DSS Unit selection from user
  1.  Q:QFLG
  1.  W !
  1.  S DIR(0)="Y",DIR("A")="Do you want All DSS Units",DIR("B")="YES"
  1.  D ^DIR K DIR I X["^" S QFLG=1 Q
  1.  I Y S ECXDSS="ALL"
  1.  E  D  I QFLG=1 Q
  1.  .S DIC(0)="AEQM",DIC="^ECD(" D ^DIC K DIC I X["^" S QFLG=1 Q
  1.  .I Y=-1 S QFLG=1 Q
  1.  .S ECXDSS=+$G(Y) I ECXDSS=0 S QFLG=1 Q
  1.  ; get date range from user
  1.  W !!,"Enter the date range for which you would like to scan the"
  1.  W !,"Event Capture records.",!
  1.  S DONE=0 F  S (ECED,ECSD)="" D  Q:QFLG!DONE
  1.  .K %DT S %DT="AEX",%DT("A")="Starting with Date: ",%DT(0)=-DATE D ^%DT
  1.  .I Y<0 S QFLG=1 Q
  1.  .S ECSD=Y,ECSD1=ECSD-.1
  1.  .D DD^%DT S ECSTART=Y
  1.  .K %DT S %DT="AEX",%DT("A")="Ending with Date: ",%DT(0)=-DATE D ^%DT
  1.  .I Y<0 S QFLG=1 Q
  1.  .I Y<ECSD D  Q
  1.  ..W !!,"The ending date cannot be earlier than the starting date."
  1.  ..W !,"Please try again.",!!
  1.  .I $E(Y,1,5)'=$E(ECSD,1,5) D  Q
  1.  ..W !!,"Beginning and ending dates must be in the same month and year"
  1.  ..W !,"Please try again.",!!
  1.  .S ECED=Y
  1.  .D DD^%DT S ECEND=Y
  1.  .S DONE=1
  1.  Q
  1.  ;
  1. PROCESS ; entry point for queued report
  1.  N QFLG
  1.  S ZTREQ="@"
  1.  S ECXERR=0 D START Q:ECXERR
  1.  S QFLG=0 D PRINT
  1.  K ^TMP("ECUV",$J) D ^ECXKILL
  1.  Q
  1.  ;
  1. START ;find EC records in date range
  1.  I ECXDSS="ALL" D
  1.  .N X,Y,ECLL,ECDA,ECD,COUNT
  1.  .S ECED=ECED+.3,ECLL=0,COUNT=0
  1.  .K ^TMP("ECUV",$J)
  1.  .F  S ECLL=$O(^ECH("AC1",ECLL)),ECD=ECSD-.1 Q:'ECLL  D
  1.  ..F  S ECD=$O(^ECH("AC1",ECLL,ECD)),ECDA=0 Q:(ECD>ECED)!('ECD)  D
  1.  ...F  S ECDA=$O(^ECH("AC1",ECLL,ECD,ECDA)) Q:'ECDA  D GETREC
  1.  E  D
  1.  .N X,Y,ECLL,ECPAT,ECDA,ECD,COUNT
  1.  .S ECED=ECED+.3,ECLL=0,ECPAT=0,COUNT=0
  1.  .K ^TMP("ECUV",$J)
  1.  .F  S ECLL=$O(^ECH("ADT",ECLL)) Q:'ECLL  D
  1.  .. S ECPAT=0
  1.  .. F  S ECPAT=$O(^ECH("ADT",ECLL,ECPAT)),ECD=ECSD-.1 Q:'ECPAT  D
  1.  ...F  S ECD=$O(^ECH("ADT",ECLL,ECPAT,ECXDSS,ECD)),ECDA=0 Q:(ECD>ECED)!('ECD)  D
  1.  ....F  S ECDA=$O(^ECH("ADT",ECLL,ECPAT,ECXDSS,ECD,ECDA)) Q:'ECDA  D GETREC
  1.  Q
  1.  ;
  1. GETREC ;get data for report
  1.  N ECCH,ECL,ECXDFN,ECXSSN,ECXPDIV,ECDT,ECDU,ECV,ECP,ECXPROV,ECXPRV,ECXDATE,ECXUNIT
  1.  N ECXDOB,ECXETH,ECXMAR,ECXMPI,ECXPNM,ECXPRIME,ECXRACE,ECXRC1,ECXREL,ECXSEX,N1,N2,VA,ECHEAD,ECPNM ;161
  1.  S ECCH=^ECH(ECDA,0),ECV=$P(ECCH,U,10)
  1.  Q:(ECV<ECTHLD)
  1.  S ECL=$P(ECCH,U,4),ECXDFN=$P(ECCH,U,2)
  1.  S ECXPDIV=$$RADDIV^ECXDEPT(ECL)  ;Get production division from file 4
  1.  S ECDT=$P(ECCH,U,3),ECDU=$P(ECCH,U,7),ECP=$P(ECCH,U,9)
  1.  Q:(ECP']"")
  1.  I ECP[";" S ECHEAD="ECS",ECPNM=$S(ECP["ICPT":$P(^ICPT(+ECP,0),U),ECP<90000:$P(^EC(725,+ECP,0),U,2),1:$P(^EC(725,+ECP,0),U,2)) ;161 Setting ECHEAD and ECPNM to allow potential test patients with certain procedures to be included
  1.  Q:('$$PATDEM^ECXUTL2(ECXDFN,ECDT,"1;","12"))
  1.  S ECXDATE=$$FMTE^XLFDT(ECDT,5)
  1.  K ECXPRV S X=$$GETPPRV^ECPRVMUT(ECDA,.ECXPRV),ECXPROV=$E($P(ECXPRV,U,2),1,30)
  1.  I ECXPROV]"" D
  1.  .S N1=$$TITLE^XLFSTR($P(ECXPROV,",")),N2=$$TITLE^XLFSTR($P(ECXPROV,",",2))
  1.  .S ECXPROV=(N1_","_N2)
  1.  I ECP[";" D
  1.  .S ECP=$S(ECP["ICPT":$P(^ICPT(+ECP,0),U)_"01",ECP<90000:$P(^EC(725,+ECP,0),U,2)_"N",1:$P(^EC(725,+ECP,0),U,2)_"L")
  1.  S ECXUNIT=$P($G(^ECD(ECDU,0)),U)
  1.  S COUNT=COUNT+1
  1.  S ^TMP("ECUV",$J,ECXUNIT,(100-ECV),COUNT)=ECXSSN_U_ECXPDIV_U_ECXDATE_U_ECP_U_ECXPROV_U_ECV
  1.  Q
  1.  ;
  1. PRINT ; process temp file and print report
  1.  N PG,QFLG,LN,COUNT,REC,CC,SS,JJ,ZTSTOP
  1.  N ECXUNIT,ECV,ECVV,ECXSSN,ECXPDIV,ECXDATE,ECXUNIT,ECP,ECXPROV
  1.  U IO
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
  1.  S (PG,QFLG,COUNT)=0,$P(LN,"-",130)=""
  1.  I '$G(ECXPORT) D HEADER Q:QFLG  ;149
  1.  S ECXUNIT="" F  S ECXUNIT=$O(^TMP("ECUV",$J,ECXUNIT)) Q:ECXUNIT=""  D  Q:QFLG
  1.  .I '$G(ECXPORT) I COUNT>0 W !,?1,LN ;149
  1.  .S ECVV=0 F  S ECVV=$O(^TMP("ECUV",$J,ECXUNIT,ECVV)) Q:'ECVV  D  Q:QFLG
  1.  ..S CC=0 F  S CC=$O(^TMP("ECUV",$J,ECXUNIT,ECVV,CC)) Q:'CC  D  Q:QFLG
  1.  ...S REC=^TMP("ECUV",$J,ECXUNIT,ECVV,CC),COUNT=COUNT+1
  1.  ...S ECXSSN=$P(REC,U),ECXPDIV=$P(REC,U,2),ECXDATE=$P(REC,U,3),ECP=$P(REC,U,4),ECXPROV=$P(REC,U,5),ECV=$P(REC,U,6)
  1.  ...I $G(ECXPORT) S ^TMP($J,"ECXPORT",CNT)=ECXSSN_U_ECXPDIV_U_ECXUNIT_U_ECXDATE_U_ECP_U_ECV_U_ECXPROV,CNT=CNT+1 Q  ;149
  1.  ...W !,?1,ECXSSN,?13,ECXPDIV,?24,ECXUNIT,?55,ECXDATE,?75,ECP,?86,ECV,?94,ECXPROV
  1.  ...I $Y+4>IOSL D HEADER Q:QFLG
  1.  I $G(ECXPORT) Q  ;149 Nothing more to print if exporting
  1.  Q:QFLG
  1.  I COUNT=0 W !!,?8,"No unusual Event Capture volumes to report for the date range.",!!
  1.  D SS
  1.  Q
  1.  ;
  1.  D:PG SS Q:QFLG
  1.  Q:QFLG
  1.  W:$Y!($E(IOST)="C") @IOF S PG=PG+1
  1.  W !,ECXDESC,?103,"Page: "_PG
  1.  W !,"Start Date: ",ECSTART,?92,"Report Run Date: "_ECRUN
  1.  W !,"  End Date: ",ECEND,?92,"Threshold Value: ",ECTHLD
  1.  W !!,?1,"SSN",?13,"FACILITY",?24,"DSS UNIT",?55,"DATE/TIME",?75,"PROCEDURE",?86,"VOLUME",?94,"PROVIDER"
  1.  W !,LN,!
  1.  Q
  1.  ;
  1. SS ;SCROLL STOPS
  1.  N JJ,SS
  1.  I $E(IOST)="C" S SS=21-$Y F JJ=1:1:SS W !
  1.  I $E(IOST)="C",PG>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
  1.  Q