ECXECMDI ;ALB/NCD - Event Capture Pre-Extract Missing DSS Identifier Report ;Apr 28, 2022@21:50:31
;;3.0;DSS EXTRACTS;**184**;Dec 22, 1997;Build 124
;
; Reference to ^ECD in ICR #1561
; Reference to ^ICPT in ICR #5408
; Reference to ^EC(725) in ICR #1874
; Reference to ^ECH in ICR #1873
; Reference to ^SC in ICR #10040
; Reference to ^DIC(40.7) in ICR #557
;
EN ; entry point
N ECXPORT,ECSD,ECED,COUNT,CNT,ECXERR,QFLG,DIR,DTOUT,DUOUT,ZTSK,ZTQUEUED,DIC,%,X,Y,DATE
W !!,"This report prints a list of records that are missing the DSS Identifier"
W !,"that would be generated by the Event Capture Extract (ECS), so that corrective"
W !,"action can be taken."
W !,"The running of this report has no effect on the actual extracts and "
W !,"can be run as needed.",!
W !,"Enter the date range for which you would like to scan the Event Capture records."
D GETDATE Q:QFLG
S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 I $G(ECXPORT) D Q
.K ^TMP($J,"ECXPORT")
.S ^TMP($J,"ECXPORT",0)="SSN^FACILITY^DSS UNIT^DSS UNIT IEN^DATE/TIME^PROCEDURE CODE^PROVIDER^CLINIC^CLINIC IEN^DSS IDENTIFIER",CNT=1
.D START,PRINT
.D EXPDISP^ECXUTL1
.K ^TMP($J,"ECXPORT"),^TMP("ECNOSSID",$J)
S ECXDESC="Event Capture Pre-Extract Missing DSS Identifier Report"
S ECXSAVE("EC*")=""
W !!,"This report is formatted for 132-column line width."
W !!,"Enter 'Q' to queue report to TaskManager, then select printer."
D EN^XUTMDEVQ("PROCESS^ECXECMDI",ECXDESC,.ECXSAVE,"",1)
I $G(POP) W !!,"No device selected...exiting.",! Q
I IO'=IO(0) D ^%ZISC
D HOME^%ZIS
I $D(ZTSK) W !!,"Queued as Task #"_ZTSK_"."
Q
;
START ; Find EC records in the date range
N ECLL,X,Y,ECDA,ECD,COUNT,COUNT
S ECLL=0
S ECED=ECED+.3,(ECDA,COUNT)=0
K ^TMP("ECNOSSID",$J)
F S ECLL=$O(^ECH("AC1",ECLL)) Q:'ECLL S ECD=ECSD-.1 D
. F S ECD=$O(^ECH("AC1",ECLL,ECD)) Q:(ECD>ECED)!('ECD) D
.. F S ECDA=$O(^ECH("AC1",ECLL,ECD,ECDA)) Q:'ECDA D GETREC
Q
;
GETREC ;get data for report
N ECXSSN,ECXPDIV,ECXPROV,ECXSSID,ECXCLIN,ECXDU,ECXUNIT,ECXPRCN,ECCH,ECFILE,ECXSSID,ECXCLINM,ECXASIH
N ECDU,ECUPCE,ECUSTOP,ECAC1,ECAC2,ECAC1S,ECAC2S
S ECCH=^ECH(ECDA,0)
S ECL=$P(ECCH,U,4),ECXDFN=$P(ECCH,U,2)
S ECXPDIV=$$RADDIV^ECXDEPT(ECL) ;Get production division from file 4
S ECDT=$P(ECCH,U,3),ECXDU=$P(ECCH,U,7),ECP=$P(ECCH,U,9)
S ECXCLIN=$P(ECCH,U,19)
Q:(ECP']"")
S ECDU=$G(^ECD(ECXDU,0))
S ECUPCE=$P(ECDU,U,14),ECUSTOP=$P(ECDU,U,10)
Q:('$$PATDEM^ECXUTL2(ECXDFN,ECDT,"1;","13"))
S ECFILE=$P(ECP,";",2),ECFILE=$S($E(ECFILE)="I":81,$E(ECFILE)="E":725,1:"UNKNOWN")
S ECXDATE=$$FMTE^XLFDT(ECDT,5)
I $G(ECXASIH) S ECXA="A"
K ECXPRV S X=$$GETPPRV^ECPRVMUT(ECDA,.ECXPRV),ECXPROV=$E($P(ECXPRV,U,2),1,30)
I ECXPROV]"" D
.S N1=$$TITLE^XLFSTR($P(ECXPROV,",")),N2=$$TITLE^XLFSTR($P(ECXPROV,",",2))
.S ECXPROV=(N1_","_N2)
I ECFILE="UNKNOWN" S ECPN="UNKNOWN"
S ECXPRCN=$S(ECFILE=81:$$GET1^DIQ(ECFILE,+ECP,.01),1:$$GET1^DIQ(ECFILE,+ECP,1))
S COUNT=COUNT+1
S ECXCLINM=$S(ECXCLIN'="":$$GET1^DIQ(44,ECXCLIN,.01),1:"")
S (ECAC1,ECAC2,ECAC1S,ECAC2S)="000"
I ECUPCE="A"!(ECUPCE="OOS")!(ECUPCE="O"&(ECXA="O")) D
. I ECXCLIN'="" D
.. S ECAC1=$$GET1^DIQ(44,ECXCLIN,8,"I"),ECAC2=$$GET1^DIQ(44,ECXCLIN,2503,"I")
.. I ECAC2="" S ECAC2S="000"
.. I ECAC1="" S (ECAC1S,ECAC2S)="000" Q
.. S ECAC1S=$$GET1^DIQ(40.7,+ECAC1,1)
.. S ECAC2S=$$GET1^DIQ(40.7,+ECAC2,1)
.. S ECAC1S=$$RJ^XLFSTR(ECAC1S,3,0),ECAC2S=$$RJ^XLFSTR(ECAC2S,3,0)
. I ECXCLIN="" S (ECAC1S,ECAC2S)="000"
I ECUPCE=""!(ECUPCE="N")!(ECUPCE="O"&(ECXA="I")) D
. S ECAC1S=$$RJ^XLFSTR($$GET1^DIQ(40.7,+ECUSTOP,1,"I"),3,0)
. S ECAC2S=$$RJ^XLFSTR($$GET1^DIQ(40.7,+$P(ECDU,U,13),1,"I"),3,0)
S ECDSS=ECAC1S_ECAC2S
I "^18^23^24^41^65^94^108^"[("^"_ECXTS_"^") S ECDSS=$$TSMAP^ECXUTL4(ECXTS)
Q:ECDSS'="000000"
;SSN^FACILTY^DSS UNIT IEN^DATE/TIME^PROCEDURE^PROVIDER^CLINIC IEN^CLINIC NAME^DSS ID
S ^TMP("ECNOSSID",$J,ECDT,COUNT)=ECXSSN_U_ECXPDIV_U_ECXDU_U_ECXDATE_U_ECXPRCN_U_ECXPROV_U_ECXCLIN_U_ECXCLINM_U_ECDSS
Q
;
PRINT ; Process the TMP file and print the report
N PG,QFLG,LN,COUNT,REC,DATE,X,Y
N ECXSSN,ECXPDIV,ECXDATE,ECXDSSU,ECXUNIT,ECP,ECXPROV,ECXPRCN,ECXPROV,ECXCLIN,ECXCLINM,ECXSSID
U IO
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
S (PG,QFLG,COUNT)=0,$P(LN,"-",130)=""
I '$G(ECXPORT) D HEADER Q:QFLG
S DATE=0
F S DATE=$O(^TMP("ECNOSSID",$J,DATE)) Q:DATE="" D Q:QFLG
.F S COUNT=$O(^TMP("ECNOSSID",$J,DATE,COUNT)) Q:COUNT="" D
.. S REC=^TMP("ECNOSSID",$J,DATE,COUNT)
.. S ECXSSN=$P(REC,U),ECXPDIV=$P(REC,U,2),ECXDSSU=$P(REC,U,3)
.. S ECXDATE=$P(REC,U,4),ECXPRCN=$P(REC,U,5),ECXPROV=$P(REC,U,6)
.. S ECXCLIN=$P(REC,U,7),ECXCLINM=$P(REC,U,8),ECXSSID=$P(REC,U,9)
.. 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
.. W !,?1,ECXSSN,?12,ECXPDIV,?25,ECXDSSU,?42,ECXDATE,?69,ECXPRCN,?83,ECXPROV,?105,ECXCLIN,?122,ECXSSID
.. I $Y+4>IOSL D HEADER Q:QFLG
I $G(ECXPORT) Q
Q:QFLG
I COUNT=0 W !!,?8,"No Event Capture records with missing DSS Identifier to report for the date range.",!!
D SS
Q
;
PROCESS ; entry point for queued report
N QFLG
S ZTREQ="@"
S ECXERR=0 D START Q:ECXERR
S QFLG=0 D PRINT
K ^TMP("ECNOSSID",$J) D ^ECXKILL
Q
;
D:PG SS Q:QFLG
Q:QFLG
W:$Y!($E(IOST)="C") @IOF S PG=PG+1
W !,ECXDESC,?103,"Page: "_PG
W !,"Start Date: ",ECSTART,?92,"Report Run Date: "_ECRUN
W !," End Date: ",ECEND
W !!,?1,"SSN",?12,"FACILITY",?25,"DSS UNIT IEN",?45,"DATE/TIME",?68,"PROCEDURE",?83,"PROVIDER",?105,"CLINIC IEN",?122,"DSS ID"
W !,LN,!
Q
;
SS ;SCROLL STOPS
N JJ,SS
I $E(IOST)="C" S SS=21-$Y F JJ=1:1:SS W !
I $E(IOST)="C",PG>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
Q
;
GETDATE ;Get starting and ending date for sort
N DONE,Y
S QFLG=0
D NOW^%DTC S DATE=X,Y=$E(%,1,12) D DD^%DT S ECRUN=$P(Y,"@") K %DT
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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXECMDI 6562 printed Apr 09, 2024@20:57:25 Page 2
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
+2 ;
+3 ; Reference to ^ECD in ICR #1561
+4 ; Reference to ^ICPT in ICR #5408
+5 ; Reference to ^EC(725) in ICR #1874
+6 ; Reference to ^ECH in ICR #1873
+7 ; Reference to ^SC in ICR #10040
+8 ; Reference to ^DIC(40.7) in ICR #557
+9 ;
EN ; entry point
+1 NEW ECXPORT,ECSD,ECED,COUNT,CNT,ECXERR,QFLG,DIR,DTOUT,DUOUT,ZTSK,ZTQUEUED,DIC,%,X,Y,DATE
+2 WRITE !!,"This report prints a list of records that are missing the DSS Identifier"
+3 WRITE !,"that would be generated by the Event Capture Extract (ECS), so that corrective"
+4 WRITE !,"action can be taken."
+5 WRITE !,"The running of this report has no effect on the actual extracts and "
+6 WRITE !,"can be run as needed.",!
+7 WRITE !,"Enter the date range for which you would like to scan the Event Capture records."
+8 DO GETDATE
if QFLG
QUIT
+9 SET ECXPORT=$$EXPORT^ECXUTL1
if ECXPORT=-1
QUIT
IF $GET(ECXPORT)
Begin DoDot:1
+10 KILL ^TMP($JOB,"ECXPORT")
+11 SET ^TMP($JOB,"ECXPORT",0)="SSN^FACILITY^DSS UNIT^DSS UNIT IEN^DATE/TIME^PROCEDURE CODE^PROVIDER^CLINIC^CLINIC IEN^DSS IDENTIFIER"
SET CNT=1
+12 DO START
DO PRINT
+13 DO EXPDISP^ECXUTL1
+14 KILL ^TMP($JOB,"ECXPORT"),^TMP("ECNOSSID",$JOB)
End DoDot:1
QUIT
+15 SET ECXDESC="Event Capture Pre-Extract Missing DSS Identifier Report"
+16 SET ECXSAVE("EC*")=""
+17 WRITE !!,"This report is formatted for 132-column line width."
+18 WRITE !!,"Enter 'Q' to queue report to TaskManager, then select printer."
+19 DO EN^XUTMDEVQ("PROCESS^ECXECMDI",ECXDESC,.ECXSAVE,"",1)
+20 IF $GET(POP)
WRITE !!,"No device selected...exiting.",!
QUIT
+21 IF IO'=IO(0)
DO ^%ZISC
+22 DO HOME^%ZIS
+23 IF $DATA(ZTSK)
WRITE !!,"Queued as Task #"_ZTSK_"."
+24 QUIT
+25 ;
START ; Find EC records in the date range
+1 NEW ECLL,X,Y,ECDA,ECD,COUNT,COUNT
+2 SET ECLL=0
+3 SET ECED=ECED+.3
SET (ECDA,COUNT)=0
+4 KILL ^TMP("ECNOSSID",$JOB)
+5 FOR
SET ECLL=$ORDER(^ECH("AC1",ECLL))
if 'ECLL
QUIT
SET ECD=ECSD-.1
Begin DoDot:1
+6 FOR
SET ECD=$ORDER(^ECH("AC1",ECLL,ECD))
if (ECD>ECED)!('ECD)
QUIT
Begin DoDot:2
+7 FOR
SET ECDA=$ORDER(^ECH("AC1",ECLL,ECD,ECDA))
if 'ECDA
QUIT
DO GETREC
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
GETREC ;get data for report
+1 NEW ECXSSN,ECXPDIV,ECXPROV,ECXSSID,ECXCLIN,ECXDU,ECXUNIT,ECXPRCN,ECCH,ECFILE,ECXSSID,ECXCLINM,ECXASIH
+2 NEW ECDU,ECUPCE,ECUSTOP,ECAC1,ECAC2,ECAC1S,ECAC2S
+3 SET ECCH=^ECH(ECDA,0)
+4 SET ECL=$PIECE(ECCH,U,4)
SET ECXDFN=$PIECE(ECCH,U,2)
+5 ;Get production division from file 4
SET ECXPDIV=$$RADDIV^ECXDEPT(ECL)
+6 SET ECDT=$PIECE(ECCH,U,3)
SET ECXDU=$PIECE(ECCH,U,7)
SET ECP=$PIECE(ECCH,U,9)
+7 SET ECXCLIN=$PIECE(ECCH,U,19)
+8 if (ECP']"")
QUIT
+9 SET ECDU=$GET(^ECD(ECXDU,0))
+10 SET ECUPCE=$PIECE(ECDU,U,14)
SET ECUSTOP=$PIECE(ECDU,U,10)
+11 if ('$$PATDEM^ECXUTL2(ECXDFN,ECDT,"1;","13"))
QUIT
+12 SET ECFILE=$PIECE(ECP,";",2)
SET ECFILE=$SELECT($EXTRACT(ECFILE)="I":81,$EXTRACT(ECFILE)="E":725,1:"UNKNOWN")
+13 SET ECXDATE=$$FMTE^XLFDT(ECDT,5)
+14 IF $GET(ECXASIH)
SET ECXA="A"
+15 KILL ECXPRV
SET X=$$GETPPRV^ECPRVMUT(ECDA,.ECXPRV)
SET ECXPROV=$EXTRACT($PIECE(ECXPRV,U,2),1,30)
+16 IF ECXPROV]""
Begin DoDot:1
+17 SET N1=$$TITLE^XLFSTR($PIECE(ECXPROV,","))
SET N2=$$TITLE^XLFSTR($PIECE(ECXPROV,",",2))
+18 SET ECXPROV=(N1_","_N2)
End DoDot:1
+19 IF ECFILE="UNKNOWN"
SET ECPN="UNKNOWN"
+20 SET ECXPRCN=$SELECT(ECFILE=81:$$GET1^DIQ(ECFILE,+ECP,.01),1:$$GET1^DIQ(ECFILE,+ECP,1))
+21 SET COUNT=COUNT+1
+22 SET ECXCLINM=$SELECT(ECXCLIN'="":$$GET1^DIQ(44,ECXCLIN,.01),1:"")
+23 SET (ECAC1,ECAC2,ECAC1S,ECAC2S)="000"
+24 IF ECUPCE="A"!(ECUPCE="OOS")!(ECUPCE="O"&(ECXA="O"))
Begin DoDot:1
+25 IF ECXCLIN'=""
Begin DoDot:2
+26 SET ECAC1=$$GET1^DIQ(44,ECXCLIN,8,"I")
SET ECAC2=$$GET1^DIQ(44,ECXCLIN,2503,"I")
+27 IF ECAC2=""
SET ECAC2S="000"
+28 IF ECAC1=""
SET (ECAC1S,ECAC2S)="000"
QUIT
+29 SET ECAC1S=$$GET1^DIQ(40.7,+ECAC1,1)
+30 SET ECAC2S=$$GET1^DIQ(40.7,+ECAC2,1)
+31 SET ECAC1S=$$RJ^XLFSTR(ECAC1S,3,0)
SET ECAC2S=$$RJ^XLFSTR(ECAC2S,3,0)
End DoDot:2
+32 IF ECXCLIN=""
SET (ECAC1S,ECAC2S)="000"
End DoDot:1
+33 IF ECUPCE=""!(ECUPCE="N")!(ECUPCE="O"&(ECXA="I"))
Begin DoDot:1
+34 SET ECAC1S=$$RJ^XLFSTR($$GET1^DIQ(40.7,+ECUSTOP,1,"I"),3,0)
+35 SET ECAC2S=$$RJ^XLFSTR($$GET1^DIQ(40.7,+$PIECE(ECDU,U,13),1,"I"),3,0)
End DoDot:1
+36 SET ECDSS=ECAC1S_ECAC2S
+37 IF "^18^23^24^41^65^94^108^"[("^"_ECXTS_"^")
SET ECDSS=$$TSMAP^ECXUTL4(ECXTS)
+38 if ECDSS'="000000"
QUIT
+39 ;SSN^FACILTY^DSS UNIT IEN^DATE/TIME^PROCEDURE^PROVIDER^CLINIC IEN^CLINIC NAME^DSS ID
+40 SET ^TMP("ECNOSSID",$JOB,ECDT,COUNT)=ECXSSN_U_ECXPDIV_U_ECXDU_U_ECXDATE_U_ECXPRCN_U_ECXPROV_U_ECXCLIN_U_ECXCLINM_U_ECDSS
+41 QUIT
+42 ;
PRINT ; Process the TMP file and print the report
+1 NEW PG,QFLG,LN,COUNT,REC,DATE,X,Y
+2 NEW ECXSSN,ECXPDIV,ECXDATE,ECXDSSU,ECXUNIT,ECP,ECXPROV,ECXPRCN,ECXPROV,ECXCLIN,ECXCLINM,ECXSSID
+3 USE IO
+4 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
KILL ZTREQ
QUIT
+5 SET (PG,QFLG,COUNT)=0
SET $PIECE(LN,"-",130)=""
+6 IF '$GET(ECXPORT)
DO HEADER
if QFLG
QUIT
+7 SET DATE=0
+8 FOR
SET DATE=$ORDER(^TMP("ECNOSSID",$JOB,DATE))
if DATE=""
QUIT
Begin DoDot:1
+9 FOR
SET COUNT=$ORDER(^TMP("ECNOSSID",$JOB,DATE,COUNT))
if COUNT=""
QUIT
Begin DoDot:2
+10 SET REC=^TMP("ECNOSSID",$JOB,DATE,COUNT)
+11 SET ECXSSN=$PIECE(REC,U)
SET ECXPDIV=$PIECE(REC,U,2)
SET ECXDSSU=$PIECE(REC,U,3)
+12 SET ECXDATE=$PIECE(REC,U,4)
SET ECXPRCN=$PIECE(REC,U,5)
SET ECXPROV=$PIECE(REC,U,6)
+13 SET ECXCLIN=$PIECE(REC,U,7)
SET ECXCLINM=$PIECE(REC,U,8)
SET ECXSSID=$PIECE(REC,U,9)
+14 IF $GET(ECXPORT)
SET ^TMP($JOB,"ECXPORT",CNT)=ECXSSN_U_ECXPDIV_U_$PIECE($GET(^ECD(ECXDSSU,0)),U)_U_ECXDSSU_U_ECXDATE_U_ECXPRCN_U_ECXPROV_U_ECXCLINM_U_ECXCLIN_U_ECXSSID
SET CNT=CNT+1
QUIT
+15 WRITE !,?1,ECXSSN,?12,ECXPDIV,?25,ECXDSSU,?42,ECXDATE,?69,ECXPRCN,?83,ECXPROV,?105,ECXCLIN,?122,ECXSSID
+16 IF $Y+4>IOSL
DO HEADER
if QFLG
QUIT
End DoDot:2
End DoDot:1
if QFLG
QUIT
+17 IF $GET(ECXPORT)
QUIT
+18 if QFLG
QUIT
+19 IF COUNT=0
WRITE !!,?8,"No Event Capture records with missing DSS Identifier to report for the date range.",!!
+20 DO SS
+21 QUIT
+22 ;
PROCESS ; entry point for queued report
+1 NEW QFLG
+2 SET ZTREQ="@"
+3 SET ECXERR=0
DO START
if ECXERR
QUIT
+4 SET QFLG=0
DO PRINT
+5 KILL ^TMP("ECNOSSID",$JOB)
DO ^ECXKILL
+6 QUIT
+7 ;
+1 if PG
DO SS
if QFLG
QUIT
+2 if QFLG
QUIT
+3 if $Y!($EXTRACT(IOST)="C")
WRITE @IOF
SET PG=PG+1
+4 WRITE !,ECXDESC,?103,"Page: "_PG
+5 WRITE !,"Start Date: ",ECSTART,?92,"Report Run Date: "_ECRUN
+6 WRITE !," End Date: ",ECEND
+7 WRITE !!,?1,"SSN",?12,"FACILITY",?25,"DSS UNIT IEN",?45,"DATE/TIME",?68,"PROCEDURE",?83,"PROVIDER",?105,"CLINIC IEN",?122,"DSS ID"
+8 WRITE !,LN,!
+9 QUIT
+10 ;
SS ;SCROLL STOPS
+1 NEW JJ,SS
+2 IF $EXTRACT(IOST)="C"
SET SS=21-$Y
FOR JJ=1:1:SS
WRITE !
+3 IF $EXTRACT(IOST)="C"
IF PG>0
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
IF 'Y
SET QFLG=1
QUIT
+4 QUIT
+5 ;
GETDATE ;Get starting and ending date for sort
+1 NEW DONE,Y
+2 SET QFLG=0
+3 DO NOW^%DTC
SET DATE=X
SET Y=$EXTRACT(%,1,12)
DO DD^%DT
SET ECRUN=$PIECE(Y,"@")
KILL %DT
+4 SET DONE=0
FOR
SET (ECED,ECSD)=""
Begin DoDot:1
+5 KILL %DT
SET %DT="AEX"
SET %DT("A")="Starting with Date: "
SET %DT(0)=-DATE
DO ^%DT
+6 IF Y<0
SET QFLG=1
QUIT
+7 SET ECSD=Y
SET ECSD1=ECSD-.1
+8 DO DD^%DT
SET ECSTART=Y
+9 KILL %DT
SET %DT="AEX"
SET %DT("A")="Ending with Date: "
SET %DT(0)=-DATE
DO ^%DT
+10 IF Y<0
SET QFLG=1
QUIT
+11 IF Y<ECSD
Begin DoDot:2
+12 WRITE !!,"The ending date cannot be earlier than the starting date."
+13 WRITE !,"Please try again.",!!
End DoDot:2
QUIT
+14 IF $EXTRACT(Y,1,5)'=$EXTRACT(ECSD,1,5)
Begin DoDot:2
+15 WRITE !!,"Beginning and ending dates must be in the same month and year"
+16 WRITE !,"Please try again.",!!
End DoDot:2
QUIT
+17 SET ECED=Y
+18 DO DD^%DT
SET ECEND=Y
+19 SET DONE=1
End DoDot:1
if QFLG!DONE
QUIT
+20 QUIT
+21 ;
