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)
Q
;
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)
Q
;
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)
Q
;
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
Q
;
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
Q
;
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
Q
;
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
Q
;
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
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMXDUT 5565 printed Apr 09, 2024@20:49:39 Page 2
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 ;
