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

ECXECMDI.m

Go to the documentation of this file. 
  1. ECXECMDI ;ALB/NCD - Event Capture Pre-Extract Missing DSS Identifier Report ;Apr 28, 2022@21:50:31
  1.  ;;3.0;DSS EXTRACTS;**184**;Dec 22, 1997;Build 124
  1.  ;
  1.  ; Reference to ^ECD in ICR #1561
  1.  ; Reference to ^ICPT in ICR #5408
  1.  ; Reference to ^EC(725) in ICR #1874
  1.  ; Reference to ^ECH in ICR #1873
  1.  ; Reference to ^SC in ICR #10040
  1.  ; Reference to ^DIC(40.7) in ICR #557
  1.  ;
  1. EN ; entry point
  1.  N ECXPORT,ECSD,ECED,COUNT,CNT,ECXERR,QFLG,DIR,DTOUT,DUOUT,ZTSK,ZTQUEUED,DIC,%,X,Y,DATE
  1.  W !!,"This report prints a list of records that are missing the DSS Identifier"
  1.  W !,"that would be generated by the Event Capture Extract (ECS), so that corrective"
  1.  W !,"action can be taken."
  1.  W !,"The running of this report has no effect on the actual extracts and "
  1.  W !,"can be run as needed.",!
  1.  W !,"Enter the date range for which you would like to scan the Event Capture records."
  1.  D GETDATE Q:QFLG
  1.  S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1  I $G(ECXPORT) D  Q
  1.  .K ^TMP($J,"ECXPORT")
  1.  .S ^TMP($J,"ECXPORT",0)="SSN^FACILITY^DSS UNIT^DSS UNIT IEN^DATE/TIME^PROCEDURE CODE^PROVIDER^CLINIC^CLINIC IEN^DSS IDENTIFIER",CNT=1
  1.  .D START,PRINT
  1.  .D EXPDISP^ECXUTL1
  1.  .K ^TMP($J,"ECXPORT"),^TMP("ECNOSSID",$J)
  1.  S ECXDESC="Event Capture Pre-Extract Missing DSS Identifier Report"
  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^ECXECMDI",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. START ; Find EC records in the date range
  1.  N ECLL,X,Y,ECDA,ECD,COUNT,COUNT
  1.  S ECLL=0
  1.  S ECED=ECED+.3,(ECDA,COUNT)=0
  1.  K ^TMP("ECNOSSID",$J)
  1.  F  S ECLL=$O(^ECH("AC1",ECLL)) Q:'ECLL  S ECD=ECSD-.1 D
  1.  . F  S ECD=$O(^ECH("AC1",ECLL,ECD)) Q:(ECD>ECED)!('ECD)  D
  1.  .. F  S ECDA=$O(^ECH("AC1",ECLL,ECD,ECDA)) Q:'ECDA  D GETREC
  1.  Q
  1.  ;
  1. GETREC ;get data for report
  1.  N ECXSSN,ECXPDIV,ECXPROV,ECXSSID,ECXCLIN,ECXDU,ECXUNIT,ECXPRCN,ECCH,ECFILE,ECXSSID,ECXCLINM,ECXASIH
  1.  N ECDU,ECUPCE,ECUSTOP,ECAC1,ECAC2,ECAC1S,ECAC2S
  1.  S ECCH=^ECH(ECDA,0)
  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),ECXDU=$P(ECCH,U,7),ECP=$P(ECCH,U,9)
  1.  S ECXCLIN=$P(ECCH,U,19)
  1.  Q:(ECP']"")
  1.  S ECDU=$G(^ECD(ECXDU,0))
  1.  S ECUPCE=$P(ECDU,U,14),ECUSTOP=$P(ECDU,U,10)
  1.  Q:('$$PATDEM^ECXUTL2(ECXDFN,ECDT,"1;","13"))
  1.  S ECFILE=$P(ECP,";",2),ECFILE=$S($E(ECFILE)="I":81,$E(ECFILE)="E":725,1:"UNKNOWN")
  1.  S ECXDATE=$$FMTE^XLFDT(ECDT,5)
  1.  I $G(ECXASIH) S ECXA="A"
  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 ECFILE="UNKNOWN" S ECPN="UNKNOWN"
  1.  S ECXPRCN=$S(ECFILE=81:$$GET1^DIQ(ECFILE,+ECP,.01),1:$$GET1^DIQ(ECFILE,+ECP,1))
  1.  S COUNT=COUNT+1
  1.  S ECXCLINM=$S(ECXCLIN'="":$$GET1^DIQ(44,ECXCLIN,.01),1:"")
  1.  S (ECAC1,ECAC2,ECAC1S,ECAC2S)="000"
  1.  I ECUPCE="A"!(ECUPCE="OOS")!(ECUPCE="O"&(ECXA="O")) D
  1.  . I ECXCLIN'="" D
  1.  .. S ECAC1=$$GET1^DIQ(44,ECXCLIN,8,"I"),ECAC2=$$GET1^DIQ(44,ECXCLIN,2503,"I")
  1.  .. I ECAC2="" S ECAC2S="000"
  1.  .. I ECAC1="" S (ECAC1S,ECAC2S)="000" Q
  1.  .. S ECAC1S=$$GET1^DIQ(40.7,+ECAC1,1)
  1.  .. S ECAC2S=$$GET1^DIQ(40.7,+ECAC2,1)
  1.  .. S ECAC1S=$$RJ^XLFSTR(ECAC1S,3,0),ECAC2S=$$RJ^XLFSTR(ECAC2S,3,0)
  1.  . I ECXCLIN="" S (ECAC1S,ECAC2S)="000"
  1.  I ECUPCE=""!(ECUPCE="N")!(ECUPCE="O"&(ECXA="I")) D
  1.  . S ECAC1S=$$RJ^XLFSTR($$GET1^DIQ(40.7,+ECUSTOP,1,"I"),3,0)
  1.  . S ECAC2S=$$RJ^XLFSTR($$GET1^DIQ(40.7,+$P(ECDU,U,13),1,"I"),3,0)
  1.  S ECDSS=ECAC1S_ECAC2S
  1.  I "^18^23^24^41^65^94^108^"[("^"_ECXTS_"^") S ECDSS=$$TSMAP^ECXUTL4(ECXTS)
  1.  Q:ECDSS'="000000"
  1.  ;SSN^FACILTY^DSS UNIT IEN^DATE/TIME^PROCEDURE^PROVIDER^CLINIC IEN^CLINIC NAME^DSS ID 
  1.  S ^TMP("ECNOSSID",$J,ECDT,COUNT)=ECXSSN_U_ECXPDIV_U_ECXDU_U_ECXDATE_U_ECXPRCN_U_ECXPROV_U_ECXCLIN_U_ECXCLINM_U_ECDSS
  1.  Q
  1.  ;
  1. PRINT ; Process the TMP file and print the report
  1.  N PG,QFLG,LN,COUNT,REC,DATE,X,Y
  1.  N ECXSSN,ECXPDIV,ECXDATE,ECXDSSU,ECXUNIT,ECP,ECXPROV,ECXPRCN,ECXPROV,ECXCLIN,ECXCLINM,ECXSSID
  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
  1.  S DATE=0
  1.  F  S DATE=$O(^TMP("ECNOSSID",$J,DATE)) Q:DATE=""  D  Q:QFLG
  1.  .F  S COUNT=$O(^TMP("ECNOSSID",$J,DATE,COUNT)) Q:COUNT=""  D
  1.  .. S REC=^TMP("ECNOSSID",$J,DATE,COUNT)
  1.  .. S ECXSSN=$P(REC,U),ECXPDIV=$P(REC,U,2),ECXDSSU=$P(REC,U,3)
  1.  .. S ECXDATE=$P(REC,U,4),ECXPRCN=$P(REC,U,5),ECXPROV=$P(REC,U,6)
  1.  .. S ECXCLIN=$P(REC,U,7),ECXCLINM=$P(REC,U,8),ECXSSID=$P(REC,U,9)
  1.  .. I $G(ECXPORT) S ^TMP($J,"ECXPORT",CNT)=ECXSSN_U_ECXPDIV_U_$P($G(^ECD(ECXDSSU,0)),U)_U_ECXDSSU_U_ECXDATE_U_ECXPRCN_U_ECXPROV_U_ECXCLINM_U_ECXCLIN_U_ECXSSID,CNT=CNT+1 Q
  1.  .. W !,?1,ECXSSN,?12,ECXPDIV,?25,ECXDSSU,?42,ECXDATE,?69,ECXPRCN,?83,ECXPROV,?105,ECXCLIN,?122,ECXSSID
  1.  .. I $Y+4>IOSL D HEADER Q:QFLG
  1.  I $G(ECXPORT) Q 
  1.  Q:QFLG
  1.  I COUNT=0 W !!,?8,"No Event Capture records with missing DSS Identifier to report for the date range.",!!
  1.  D SS
  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("ECNOSSID",$J) D ^ECXKILL
  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
  1.  W !!,?1,"SSN",?12,"FACILITY",?25,"DSS UNIT IEN",?45,"DATE/TIME",?68,"PROCEDURE",?83,"PROVIDER",?105,"CLINIC IEN",?122,"DSS ID"
  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
  1.  ;
  1. GETDATE ;Get starting and ending date for sort
  1.  N DONE,Y
  1.  S QFLG=0
  1.  D NOW^%DTC S DATE=X,Y=$E(%,1,12) D DD^%DT S ECRUN=$P(Y,"@") K %DT
  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.  ;