XTER1A1.m

XTER1A1 ;ISC-SF.SEA/JLI - CONTINUTATION OF ERROR REPORTING ;12/7/93  14:16

 ;;8.0;KERNEL;;Jul 10, 1995

 ;

 Q

INTRACT ;

 K XTPRNT

 S %DT="AEQX",%DT("A")="Starting Date: " D ^%DT K %DT Q:Y'>0  S XTNDAT1=Y S XTNDAT2=Y I Y<DT S %DT="AEQX",%DT("A")="Ending Date:   " D ^%DT K %DT Q:Y'>0  S XTNDAT2=Y I Y<XTNDAT1 W !!,$C(7),"ENDING DATE can not be BEFORE start date" G INTRACT

 S DIR(0)="N^1:10",DIR("A")="List first N occurrences, where N = " D ^DIR K DIR S XTNUM=+Y Q:Y'>0

INT S %ZIS="Q" D ^%ZIS Q:POP  I $D(IO("Q")) K IO("Q") S ZTRTN="DQ^XTER1A1",ZTIO=ION,ZTDESC="XTERTRP PRINT ERRS",ZTSAVE("XTNDAT1")="",ZTSAVE("XTNDAT2")="",ZTSAVE("XTNUM")="" D ^%ZTLOAD K XTNDAT1,XTNDAT2,XTNUM,ZTSK Q

DQ ;

 K ^TMP($J,"XTER1A") S XTNDAT1=+$$FMTH^XLFDT(XTNDAT1),XTNDAT2=+$$FMTH^XLFDT(XTNDAT2) F XTNDATE=XTNDAT1:1:XTNDAT2 D LISTN^XTER1A

 D LIST^XTER1A

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XTER1A1   848     printed  Apr 09, 2024@21:43:01                                                                                                                                                                                                      Page 2

XTER1A1   ;ISC-SF.SEA/JLI - CONTINUTATION OF ERROR REPORTING ;12/7/93  14:16

 +1       ;;8.0;KERNEL;;Jul 10, 1995

 +2       ;

 +3        QUIT 

INTRACT   ;

 +1        KILL XTPRNT

 +2        SET %DT="AEQX"

           SET %DT("A")="Starting Date: "

           DO ^%DT

           KILL %DT

           if Y'>0

               QUIT 

           SET XTNDAT1=Y

           SET XTNDAT2=Y

           IF Y<DT

               SET %DT="AEQX"

               SET %DT("A")="Ending Date:   "

               DO ^%DT

               KILL %DT

               if Y'>0

                   QUIT 

               SET XTNDAT2=Y

               IF Y<XTNDAT1

                   WRITE !!,$CHAR(7),"ENDING DATE can not be BEFORE start date"

                   GOTO INTRACT

 +3        SET DIR(0)="N^1:10"

           SET DIR("A")="List first N occurrences, where N = "

           DO ^DIR

           KILL DIR

           SET XTNUM=+Y

           if Y'>0

               QUIT 

INT        SET %ZIS="Q"

           DO ^%ZIS

           if POP

               QUIT 

           IF $DATA(IO("Q"))

               KILL IO("Q")

               SET ZTRTN="DQ^XTER1A1"

               SET ZTIO=ION

               SET ZTDESC="XTERTRP PRINT ERRS"

               SET ZTSAVE("XTNDAT1")=""

               SET ZTSAVE("XTNDAT2")=""

               SET ZTSAVE("XTNUM")=""

               DO ^%ZTLOAD

               KILL XTNDAT1,XTNDAT2,XTNUM,ZTSK

               QUIT 

DQ        ;

 +1        KILL ^TMP($JOB,"XTER1A")

           SET XTNDAT1=+$$FMTH^XLFDT(XTNDAT1)

           SET XTNDAT2=+$$FMTH^XLFDT(XTNDAT2)

           FOR XTNDATE=XTNDAT1:1:XTNDAT2

               DO LISTN^XTER1A

 +2        DO LIST^XTER1A

 +3        QUIT