PXRRADUT ;ISL/PKR - Age and date utilities for PCE reports. ;6/26/97
;;1.0;PCE PATIENT CARE ENCOUNTER;**10,18**;Aug 12, 1996
;
;=======================================================================
AGE(TYPE,NEWLINE) ;Get a patient age.
N X,Y
K DIRUT,DTOUT,DUOUT
S DIR(0)="NO"
S DIR("A")="Enter "_TYPE_" AGE"
S DIR("?")="Enter an age in years"
S DIR("??")=U_"D AGEHELP^PXRRADUT(TYPE)"
I NEWLINE W !
D ^DIR K DIR
I $D(DIROUT) S DTOUT=1
I $D(DTOUT)!($D(DUOUT)) Q -1
Q Y
;
;
AGEHELP(TYPE) ;Write the age selection help.
W !!,"This is the ",TYPE," patient age for selecting encounters."
Q
;
;=======================================================================
BDHELP(HTEXT,TYPE) ;Write the beginning date help.
I $D(HTEXT) D HELP^PXRRADUT(.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^PXRRADUT(.BDHTEXT)
Q
;
;=======================================================================
DOBFA(AGE) ;Given an age in years return the corresponding date of birth.
N DOB
I (AGE=0)!(AGE="") Q 0
S DOB=DT-(AGE*10000)
Q DOB
;
;=======================================================================
EDHELP(HTEXT,TYPE) ;Write the ending date help.
I $D(HTEXT) D HELP^PXRRADUT(.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^PXRRADUT(.EDHTEXT)
Q
;
;=======================================================================
FDR(BDATE,EDATE,TYPE,BHTEXT,EHTEXT) ;Get a future date range.
FBDATE ;Select the beginning date.
N X,Y
K DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="DA^"_DT_"::EFTX"
S DIR("A")="Enter "_TYPE_" BEGINNING DATE: "
S DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D")
S DIR("?")="This must be a future date. For detailed help type ??"
S DIR("??")=U_"D BDHELP^PXRRADUT(.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: "
S DIR("?")="This must be a future date and not before "_$$FMTE^XLFDT(BDATE,"D")_". For detailed help type ??"
S DIR("??")=U_"D EDHELP^PXRRADUT(.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 $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
K DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="DA^::ETX"
S DIR("A")="Enter "_TYPE_" BEGINNING DATE: "
S DIR("?")="This must be a date. For detailed help type ??"
S DIR("??")=U_"D BDHELP^PXRRADUT(.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 GBDATE
;
GEDATE ;Select the ending date.
S DIR(0)="DA^"_BDATE_"::ETX"
S DIR("A")="Enter "_TYPE_" ENDING DATE: "
S DIR("?")="This must be a date and not before "_$$FMTE^XLFDT(BDATE,"D")_". For detailed help type ??"
S DIR("??")=U_"D EDHELP^PXRRADUT(.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 !
D HELP^%DTC
Q
;
;=======================================================================
PDR(BDATE,EDATE,TYPE,BHTEXT,EXTEXT) ;Get a past date range.
PBDATE ;Select the beginning date.
N X,Y
K DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="D^:"_DT_":EPTX"
S DIR("A")="Enter "_TYPE_" BEGINNING DATE"
S DIR("?")="This must be a past date. For detailed help type ??"
S DIR("??")=U_"D BDHELP^PXRRADUT(.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 PBDATE
;
PEDATE ;Select the ending date.
S DIR(0)="DA^"_BDATE_":"_DT_":EPTX"
S DIR("A")="Enter "_TYPE_" ENDING DATE: "
S DIR("?")="This must be a past date, but not before "_$$FMTE^XLFDT(BDATE,"D")_". For detailed help type ??"
S DIR("??")=U_"D EDHELP^PXRRADUT(.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 $E(Y,6,7)="00" W $C(7)," ?? Enter exact date" G PEDATE
K DIROUT,DIRUT,DTOUT,DUOUT
Q
;
PXRRADUT ;ISL/PKR - Age and date utilities for PCE reports. ;6/26/97
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**10,18**;Aug 12, 1996
+2 ;
+3 ;=======================================================================
AGE(TYPE,NEWLINE) ;Get a patient age.
+1 NEW X,Y
+2 KILL DIRUT,DTOUT,DUOUT
+3 SET DIR(0)="NO"
+4 SET DIR("A")="Enter "_TYPE_" AGE"
+5 SET DIR("?")="Enter an age in years"
+6 SET DIR("??")=U_"D AGEHELP^PXRRADUT(TYPE)"
+7 IF NEWLINE
WRITE !
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DIROUT)
SET DTOUT=1
+10 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT -1
+11 QUIT Y
+12 ;
+13 ;
AGEHELP(TYPE) ;Write the age selection help.
+1 WRITE !!,"This is the ",TYPE," patient age for selecting encounters."
+2 QUIT
+3 ;
+4 ;=======================================================================
BDHELP(HTEXT,TYPE) ;Write the beginning date help.
+1 IF $DATA(HTEXT)
DO HELP^PXRRADUT(.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^PXRRADUT(.BDHTEXT)
End DoDot:1
+7 QUIT
+8 ;
+9 ;=======================================================================
DOBFA(AGE) ;Given an age in years return the corresponding date of birth.
+1 NEW DOB
+2 IF (AGE=0)!(AGE="")
QUIT 0
+3 SET DOB=DT-(AGE*10000)
+4 QUIT DOB
+5 ;
+6 ;=======================================================================
EDHELP(HTEXT,TYPE) ;Write the ending date help.
+1 IF $DATA(HTEXT)
DO HELP^PXRRADUT(.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^PXRRADUT(.EDHTEXT)
End DoDot:1
+7 QUIT
+8 ;
+9 ;=======================================================================
FDR(BDATE,EDATE,TYPE,BHTEXT,EHTEXT) ;Get a future date range.
FBDATE ;Select the beginning date.
+1 NEW X,Y
+2 KILL DIROUT,DIRUT,DTOUT,DUOUT
+3 SET DIR(0)="DA^"_DT_"::EFTX"
+4 SET DIR("A")="Enter "_TYPE_" BEGINNING DATE: "
+5 SET DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D")
+6 SET DIR("?")="This must be a future date. For detailed help type ??"
+7 SET DIR("??")=U_"D BDHELP^PXRRADUT(.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 $EXTRACT(Y,6,7)="00"
WRITE $CHAR(7)," ?? Enter exact date"
GOTO FBDATE
+14 ;
FEDATE ;Select the ending date.
+1 SET DIR(0)="DA^"_BDATE_"::ETFX"
+2 SET DIR("A")="Enter "_TYPE_" ENDING DATE: "
+3 SET DIR("?")="This must be a future date and not before "_$$FMTE^XLFDT(BDATE,"D")_". For detailed help type ??"
+4 SET DIR("??")=U_"D EDHELP^PXRRADUT(.EHTEXT,TYPE)"
+5 DO ^DIR
KILL DIR
+6 IF $DATA(DIROUT)
SET DTOUT=1
+7 IF $DATA(DTOUT)
QUIT
+8 IF $DATA(DUOUT)
GOTO FBDATE
+9 SET EDATE=Y
+10 IF $EXTRACT(Y,6,7)="00"
WRITE $CHAR(7)," ?? Enter exact date"
GOTO FEDATE
+11 KILL DIROUT,DIRUT,DTOUT,DUOUT
+12 QUIT
+13 ;
+14 ;=======================================================================
GDR(BDATE,EDATE,TYPE,BHTEXT,EHTEXT) ;Get a general date range.
GBDATE ;Select the beginning date.
+1 NEW X,Y
+2 KILL DIROUT,DIRUT,DTOUT,DUOUT
+3 SET DIR(0)="DA^::ETX"
+4 SET DIR("A")="Enter "_TYPE_" BEGINNING DATE: "
+5 SET DIR("?")="This must be a date. For detailed help type ??"
+6 SET DIR("??")=U_"D BDHELP^PXRRADUT(.BHTEXT,TYPE)"
+7 WRITE !
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DIROUT)
SET DTOUT=1
+10 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+11 SET BDATE=Y
+12 IF $EXTRACT(Y,6,7)="00"
WRITE $CHAR(7)," ?? Enter exact date"
GOTO GBDATE
+13 ;
GEDATE ;Select the ending date.
+1 SET DIR(0)="DA^"_BDATE_"::ETX"
+2 SET DIR("A")="Enter "_TYPE_" ENDING DATE: "
+3 SET DIR("?")="This must be a date and not before "_$$FMTE^XLFDT(BDATE,"D")_". For detailed help type ??"
+4 SET DIR("??")=U_"D EDHELP^PXRRADUT(.EHTEXT,TYPE)"
+5 DO ^DIR
KILL DIR
+6 IF $DATA(DIROUT)
SET DTOUT=1
+7 IF $DATA(DTOUT)
QUIT
+8 IF $DATA(DUOUT)
GOTO GBDATE
+9 SET EDATE=Y
+10 IF $EXTRACT(Y,6,7)="00"
WRITE $CHAR(7)," ?? Enter exact date"
GOTO GEDATE
+11 KILL DIROUT,DIRUT,DTOUT,DUOUT
+12 QUIT
+13 ;
+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 DO HELP^%DTC
+16 QUIT
+17 ;
+18 ;=======================================================================
PDR(BDATE,EDATE,TYPE,BHTEXT,EXTEXT) ;Get a past date range.
PBDATE ;Select the beginning date.
+1 NEW X,Y
+2 KILL DIROUT,DIRUT,DTOUT,DUOUT
+3 SET DIR(0)="D^:"_DT_":EPTX"
+4 SET DIR("A")="Enter "_TYPE_" BEGINNING DATE"
+5 SET DIR("?")="This must be a past date. For detailed help type ??"
+6 SET DIR("??")=U_"D BDHELP^PXRRADUT(.BHTEXT,TYPE)"
+7 WRITE !
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DIROUT)
SET DTOUT=1
+10 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+11 SET BDATE=Y
+12 IF $EXTRACT(Y,6,7)="00"
WRITE $CHAR(7)," ?? Enter exact date"
GOTO PBDATE
+13 ;
PEDATE ;Select the ending date.
+1 SET DIR(0)="DA^"_BDATE_":"_DT_":EPTX"
+2 SET DIR("A")="Enter "_TYPE_" ENDING DATE: "
+3 SET DIR("?")="This must be a past date, but not before "_$$FMTE^XLFDT(BDATE,"D")_". For detailed help type ??"
+4 SET DIR("??")=U_"D EDHELP^PXRRADUT(.EHTEXT,TYPE)"
+5 DO ^DIR
KILL DIR
+6 IF $DATA(DIROUT)
SET DTOUT=1
+7 IF $DATA(DTOUT)
QUIT
+8 IF $DATA(DUOUT)
GOTO PBDATE
+9 SET EDATE=Y
+10 IF $EXTRACT(Y,6,7)="00"
WRITE $CHAR(7)," ?? Enter exact date"
GOTO PEDATE
+11 KILL DIROUT,DIRUT,DTOUT,DUOUT
+12 QUIT
+13 ;
