Routine: PXRMXDUT

PXRMXDUT ; SLC/PJH - Date utilities for reminder reports. ;05/05/2006

 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21

BDHELP(HTEXT,TYPE) ;Write the beginning date help.

 I $D(HTEXT) D HELP(.HTEXT)

 I '$D(HTEXT) D

 . N BDHTEXT

 . S BDHTEXT(1)="This is the beginning date for "_TYPE_" to be included in the creation of"

 . S BDHTEXT(2)="this report."

 . D HELP^PXRMXDUT(.BDHTEXT)

EDHELP(HTEXT,TYPE) ;Write the ending date help.

 I $D(HTEXT) D HELP(.HTEXT)

 I '$D(HTEXT) D

 . N EDHTEXT

 . S EDHTEXT(1)="This is the ending date for "_TYPE_" to be included in the creation"

 . S EDHTEXT(2)="of this report."

 . D HELP^PXRMXDUT(.EDHTEXT)

SDHELP(HTEXT) ;Write the single date help.

 I $D(HTEXT) D HELP(.HTEXT)

 I '$D(HTEXT) D

 . N SDHTEXT

 . S SDHTEXT(1)="This is the date of reminder evaluation for the report"

 . D HELP^PXRMXDUT(.SDHTEXT)

FDR(BDATE,EDATE,TYPE,BHTEXT,EHTEXT) ;Get a future date range.

FBDATE ;Select the beginning date.

 N X,Y,DIR

 K DIROUT,DIRUT,DTOUT,DUOUT

 S DIR(0)="DA^"_DT_"::EFTX"

 S DIR("A")="Enter "_TYPE_" BEGINNING DATE AND TIME: "

 S DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D")

 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"

 S DIR("?")="This must be a future date. For detailed help type ??"

 S DIR("??")=U_"D BDHELP^PXRMXDUT(.BHTEXT,TYPE)"

W !

 D ^DIR K DIR

 I $D(DIROUT) S DTOUT=1

 I $D(DTOUT)!($D(DUOUT)) Q

 S BDATE=Y

 I $E(Y,6,7)="00" W $C(7),"  ?? Enter exact date" G FBDATE

FEDATE ;Select the ending date.

 S DIR(0)="DA^"_BDATE_"::ETFX"

 S DIR("A")="Enter "_TYPE_" ENDING DATE AND TIME: "

 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"

 S DIR("?")="This must be a future date and not before "_$$FMTE^XLFDT(BDATE,"P")_". For detailed help type ??"

 S DIR("??")=U_"D EDHELP^PXRMXDUT(.EHTEXT,TYPE)"

 D ^DIR K DIR

 I $D(DIROUT) S DTOUT=1

 I $D(DTOUT) Q

 I $D(DUOUT) G FBDATE

 S EDATE=Y

 I EDATE<DT W !,"This must be a past date. For detailed help type ??" G FEDATE

 I EDATE<BDATE W !,"The ending date cannot be before the beginning date" G FEDATE

 I $E(Y,6,7)="00" W $C(7),"  ?? Enter exact date" G FEDATE

 K DIROUT,DIRUT,DTOUT,DUOUT

GDR(BDATE,EDATE,TYPE,BHTEXT,EHTEXT) ;Get a general date range.

GBDATE ;Select the beginning date.

 N X,Y,DIR

 K DIROUT,DIRUT,DTOUT,DUOUT

 S DIR(0)="DA^::ETX"

 S DIR("A")="Enter "_TYPE_" BEGINNING DATE: "

 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"

 S DIR("?")="This must be a date. For detailed help type ??"

 S DIR("??")=U_"D BDHELP^PXRMXDUT(.BHTEXT,TYPE)"

W !

 D ^DIR K DIR

 I $D(DIROUT) S DTOUT=1

 I $D(DTOUT)!($D(DUOUT)) Q

 S BDATE=Y

 I BDATE<DT W !,"This must be a past date. For detailed help type ??" G FBDATE

GEDATE ;Select the ending date.

 S DIR(0)="DA^"_BDATE_"::ETX"

 S DIR("A")="Enter "_TYPE_" ENDING DATE: "

 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"

 S DIR("?")="This must be a date and not before "_$$FMTE^XLFDT(BDATE,"D")_". For detailed help type ??"

 S DIR("??")=U_"D EDHELP^PXRMXDUT(.EHTEXT,TYPE)"

 D ^DIR K DIR

 I $D(DIROUT) S DTOUT=1

 I $D(DTOUT) Q

 I $D(DUOUT) G GBDATE

 S EDATE=Y

 I $E(Y,6,7)="00" W $C(7),"  ?? Enter exact date" G GEDATE

 K DIROUT,DIRUT,DTOUT,DUOUT

HELP(HTEXT) ;General help text routine. Write out the text in the HTEXT

 ;array.

 N DIWF,DIWL,DIWR,IC

 S DIWF="C70",DIWL=0,DIWR=70

 K ^UTILITY($J,"W")

 S IC=""

 F  S IC=$O(HTEXT(IC)) Q:IC=""  D

 . S X=HTEXT(IC)

 . D ^DIWP

W !

 S IC=0

 F  S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC=""  D

 . W !,^UTILITY($J,"W",0,IC,0)

 K ^UTILITY($J,"W")

W !

 N %DT,MODE

 S MODE=$G(TYPE),%DT="F",%DT(0)=DT

 I (MODE="ADMISSION")!(MODE="ENCOUNTER") S %DT="P",%DT(0)=-DT

 D HELP^%DTC

PDR(BDATE,EDATE,TYPE,BHTEXT,EXTEXT) ;Get a past date range.

PBDATE ;Select the beginning date.

 N X,Y,DIR

 K DIROUT,DIRUT,DTOUT,DUOUT

 S DIR(0)="D^:"_DT_":EPTX"

 S DIR("A")="Enter "_TYPE_" BEGINNING DATE"

 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"

 S DIR("?")="This must be a past date. For detailed help type ??"

 S DIR("??")=U_"D BDHELP^PXRMXDUT(.BHTEXT,TYPE)"

W !

 D ^DIR K DIR

 I $D(DIROUT) S DTOUT=1

 I $D(DTOUT)!($D(DUOUT)) Q

 S BDATE=Y

 I $P(BDATE,".")>DT W !,"This must be a past date. For detailed help type ??" G PBDATE

 I $E(Y,6,7)="00" W $C(7),"  ?? Enter exact date" G PBDATE

PEDATE ;Select the ending date.

 S DIR(0)="DA^"_BDATE_":"_DT_":EPTX"

 S DIR("A")="Enter "_TYPE_" ENDING DATE: "

 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"

 S DIR("?")="This must be a past date, but not before "_$$FMTE^XLFDT(BDATE,"D")_". For detailed help type ??"

 S DIR("??")=U_"D EDHELP^PXRMXDUT(.EHTEXT,TYPE)"

 D ^DIR K DIR

 I $D(DIROUT) S DTOUT=1

 I $D(DTOUT) Q

 I $D(DUOUT) G PBDATE

 S EDATE=Y

 I $P(EDATE,".")>DT W !,"This must be a past date. For detailed help type ??" G PEDATE

 I $E(Y,6,7)="00" W $C(7),"  ?? Enter exact date" G PEDATE

 I EDATE<BDATE W !,"The ending date cannot be less then the beginning date." G PEDATE

 K DIROUT,DIRUT,DTOUT,DUOUT

SDR(SDATE,BHTEXT,EHTEXT) ;Get a date.

SBDATE ;Select the date.

 N X,Y,DIR

 K DIROUT,DIRUT,DTOUT,DUOUT

 S DIR(0)="DA^::ETX"

 S DIR("A")="Enter EFFECTIVE DUE DATE: "

 S DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D")

 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"

 S DIR("?")="Enter date for reminder evaluation. For detailed help type ??"

 S DIR("??")=U_"D SDHELP^PXRMXDUT(.BHTEXT)"

W !

 D ^DIR K DIR

 I $D(DIROUT) S DTOUT=1

 I $D(DTOUT)!($D(DUOUT)) Q

 I $E(Y,6,7)="00" W $C(7),"  ?? Enter exact date" G SBDATE

 S SDATE=Y

 K DIROUT,DIRUT,DTOUT,DUOUT

PXRMXDUT  ; SLC/PJH - Date utilities for reminder reports. ;05/05/2006

 +1       ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21

 +2       ;

BDHELP(HTEXT,TYPE) ;Write the beginning date help.

 +1        IF $DATA(HTEXT)

               DO HELP(.HTEXT)

 +2        IF '$DATA(HTEXT)

               Begin DoDot:1

 +3                NEW BDHTEXT

 +4                SET BDHTEXT(1)="This is the beginning date for "_TYPE_" to be included in the creation of"

 +5                SET BDHTEXT(2)="this report."

 +6                DO HELP^PXRMXDUT(.BDHTEXT)

               End DoDot:1

 +7        QUIT

 +8       ;

EDHELP(HTEXT,TYPE) ;Write the ending date help.

 +1        IF $DATA(HTEXT)

               DO HELP(.HTEXT)

 +2        IF '$DATA(HTEXT)

               Begin DoDot:1

 +3                NEW EDHTEXT

 +4                SET EDHTEXT(1)="This is the ending date for "_TYPE_" to be included in the creation"

 +5                SET EDHTEXT(2)="of this report."

 +6                DO HELP^PXRMXDUT(.EDHTEXT)

               End DoDot:1

 +7        QUIT

 +8       ;

SDHELP(HTEXT) ;Write the single date help.

 +1        IF $DATA(HTEXT)

               DO HELP(.HTEXT)

 +2        IF '$DATA(HTEXT)

               Begin DoDot:1

 +3                NEW SDHTEXT

 +4                SET SDHTEXT(1)="This is the date of reminder evaluation for the report"

 +5                DO HELP^PXRMXDUT(.SDHTEXT)

               End DoDot:1

 +6        QUIT

 +7       ;

FDR(BDATE,EDATE,TYPE,BHTEXT,EHTEXT) ;Get a future date range.

FBDATE    ;Select the beginning date.

 +1        NEW X,Y,DIR

 +2        KILL DIROUT,DIRUT,DTOUT,DUOUT

 +3        SET DIR(0)="DA^"_DT_"::EFTX"

 +4        SET DIR("A")="Enter "_TYPE_" BEGINNING DATE AND TIME: "

 +5        SET DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D")

 +6        SET DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"

 +7        SET DIR("?")="This must be a future date. For detailed help type ??"

 +8        SET DIR("??")=U_"D BDHELP^PXRMXDUT(.BHTEXT,TYPE)"

 +9        WRITE !

 +10       DO ^DIR

           KILL DIR

 +11       IF $DATA(DIROUT)

               SET DTOUT=1

 +12       IF $DATA(DTOUT)!($DATA(DUOUT))

               QUIT

 +13       SET BDATE=Y

 +14       IF $EXTRACT(Y,6,7)="00"

               WRITE $CHAR(7),"  ?? Enter exact date"

               GOTO FBDATE

 +15      ;

FEDATE    ;Select the ending date.

 +1        SET DIR(0)="DA^"_BDATE_"::ETFX"

 +2        SET DIR("A")="Enter "_TYPE_" ENDING DATE AND TIME: "

 +3        SET DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"

 +4        SET DIR("?")="This must be a future date and not before "_$$FMTE^XLFDT(BDATE,"P")_". For detailed help type ??"

 +5        SET DIR("??")=U_"D EDHELP^PXRMXDUT(.EHTEXT,TYPE)"

 +6        DO ^DIR

           KILL DIR

 +7        IF $DATA(DIROUT)

               SET DTOUT=1

 +8        IF $DATA(DTOUT)

               QUIT

 +9        IF $DATA(DUOUT)

               GOTO FBDATE

 +10       SET EDATE=Y

 +11       IF EDATE<DT

               WRITE !,"This must be a past date. For detailed help type ??"

               GOTO FEDATE

 +12       IF EDATE<BDATE

               WRITE !,"The ending date cannot be before the beginning date"

               GOTO FEDATE

 +13       IF $EXTRACT(Y,6,7)="00"

               WRITE $CHAR(7),"  ?? Enter exact date"

               GOTO FEDATE

 +14       KILL DIROUT,DIRUT,DTOUT,DUOUT

 +15       QUIT

 +16      ;

GDR(BDATE,EDATE,TYPE,BHTEXT,EHTEXT) ;Get a general date range.

GBDATE    ;Select the beginning date.

 +1        NEW X,Y,DIR

 +2        KILL DIROUT,DIRUT,DTOUT,DUOUT

 +3        SET DIR(0)="DA^::ETX"

 +4        SET DIR("A")="Enter "_TYPE_" BEGINNING DATE: "

 +5        SET DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"

 +6        SET DIR("?")="This must be a date. For detailed help type ??"

 +7        SET DIR("??")=U_"D BDHELP^PXRMXDUT(.BHTEXT,TYPE)"

 +8        WRITE !

 +9        DO ^DIR

           KILL DIR

 +10       IF $DATA(DIROUT)

               SET DTOUT=1

 +11       IF $DATA(DTOUT)!($DATA(DUOUT))

               QUIT

 +12       SET BDATE=Y

 +13       IF BDATE<DT

               WRITE !,"This must be a past date. For detailed help type ??"

               GOTO FBDATE

 +14      ;

GEDATE    ;Select the ending date.

 +1        SET DIR(0)="DA^"_BDATE_"::ETX"

 +2        SET DIR("A")="Enter "_TYPE_" ENDING DATE: "

 +3        SET DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"

 +4        SET DIR("?")="This must be a date and not before "_$$FMTE^XLFDT(BDATE,"D")_". For detailed help type ??"

 +5        SET DIR("??")=U_"D EDHELP^PXRMXDUT(.EHTEXT,TYPE)"

 +6        DO ^DIR

           KILL DIR

 +7        IF $DATA(DIROUT)

               SET DTOUT=1

 +8        IF $DATA(DTOUT)

               QUIT

 +9        IF $DATA(DUOUT)

               GOTO GBDATE

 +10       SET EDATE=Y

 +11       IF $EXTRACT(Y,6,7)="00"

               WRITE $CHAR(7),"  ?? Enter exact date"

               GOTO GEDATE

 +12       KILL DIROUT,DIRUT,DTOUT,DUOUT

 +13       QUIT

 +14      ;

HELP(HTEXT) ;General help text routine. Write out the text in the HTEXT

 +1       ;array.

 +2        NEW DIWF,DIWL,DIWR,IC

 +3        SET DIWF="C70"

           SET DIWL=0

           SET DIWR=70

 +4        KILL ^UTILITY($JOB,"W")

 +5        SET IC=""

 +6        FOR

               SET IC=$ORDER(HTEXT(IC))

               IF IC=""

                   QUIT

               Begin DoDot:1

 +7                SET X=HTEXT(IC)

 +8                DO ^DIWP

               End DoDot:1

 +9        WRITE !

 +10       SET IC=0

 +11       FOR

               SET IC=$ORDER(^UTILITY($JOB,"W",0,IC))

               IF IC=""

                   QUIT

               Begin DoDot:1

 +12               WRITE !,^UTILITY($JOB,"W",0,IC,0)

               End DoDot:1

 +13       KILL ^UTILITY($JOB,"W")

 +14       WRITE !

 +15       NEW %DT,MODE

 +16       SET MODE=$GET(TYPE)

           SET %DT="F"

           SET %DT(0)=DT

 +17       IF (MODE="ADMISSION")!(MODE="ENCOUNTER")

               SET %DT="P"

               SET %DT(0)=-DT

 +18       DO HELP^%DTC

 +19       QUIT

 +20      ;

PDR(BDATE,EDATE,TYPE,BHTEXT,EXTEXT) ;Get a past date range.

PBDATE    ;Select the beginning date.

 +1        NEW X,Y,DIR

 +2        KILL DIROUT,DIRUT,DTOUT,DUOUT

 +3        SET DIR(0)="D^:"_DT_":EPTX"

 +4        SET DIR("A")="Enter "_TYPE_" BEGINNING DATE"

 +5        SET DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"

 +6        SET DIR("?")="This must be a past date. For detailed help type ??"

 +7        SET DIR("??")=U_"D BDHELP^PXRMXDUT(.BHTEXT,TYPE)"

 +8        WRITE !

 +9        DO ^DIR

           KILL DIR

 +10       IF $DATA(DIROUT)

               SET DTOUT=1

 +11       IF $DATA(DTOUT)!($DATA(DUOUT))

               QUIT

 +12       SET BDATE=Y

 +13       IF $PIECE(BDATE,".")>DT

               WRITE !,"This must be a past date. For detailed help type ??"

               GOTO PBDATE

 +14       IF $EXTRACT(Y,6,7)="00"

               WRITE $CHAR(7),"  ?? Enter exact date"

               GOTO PBDATE

 +15      ;

PEDATE    ;Select the ending date.

 +1        SET DIR(0)="DA^"_BDATE_":"_DT_":EPTX"

 +2        SET DIR("A")="Enter "_TYPE_" ENDING DATE: "

 +3        SET DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"

 +4        SET DIR("?")="This must be a past date, but not before "_$$FMTE^XLFDT(BDATE,"D")_". For detailed help type ??"

 +5        SET DIR("??")=U_"D EDHELP^PXRMXDUT(.EHTEXT,TYPE)"

 +6        DO ^DIR

           KILL DIR

 +7        IF $DATA(DIROUT)

               SET DTOUT=1

 +8        IF $DATA(DTOUT)

               QUIT

 +9        IF $DATA(DUOUT)

               GOTO PBDATE

 +10       SET EDATE=Y

 +11       IF $PIECE(EDATE,".")>DT

               WRITE !,"This must be a past date. For detailed help type ??"

               GOTO PEDATE

 +12       IF $EXTRACT(Y,6,7)="00"

               WRITE $CHAR(7),"  ?? Enter exact date"

               GOTO PEDATE

 +13       IF EDATE<BDATE

               WRITE !,"The ending date cannot be less then the beginning date."

               GOTO PEDATE

 +14       KILL DIROUT,DIRUT,DTOUT,DUOUT

 +15       QUIT

 +16      ;

SDR(SDATE,BHTEXT,EHTEXT) ;Get a date.

SBDATE    ;Select the date.

 +1        NEW X,Y,DIR

 +2        KILL DIROUT,DIRUT,DTOUT,DUOUT

 +3        SET DIR(0)="DA^::ETX"

 +4        SET DIR("A")="Enter EFFECTIVE DUE DATE: "

 +5        SET DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D")

 +6        SET DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"

 +7        SET DIR("?")="Enter date for reminder evaluation. For detailed help type ??"

 +8        SET DIR("??")=U_"D SDHELP^PXRMXDUT(.BHTEXT)"

 +9        WRITE !

 +10       DO ^DIR

           KILL DIR

 +11       IF $DATA(DIROUT)

               SET DTOUT=1

 +12       IF $DATA(DTOUT)!($DATA(DUOUT))

               QUIT

 +13       IF $EXTRACT(Y,6,7)="00"

               WRITE $CHAR(7),"  ?? Enter exact date"

               GOTO SBDATE

 +14       SET SDATE=Y

 +15       KILL DIROUT,DIRUT,DTOUT,DUOUT

 +16       QUIT

 +17      ;

PXRMXDUT.m