PXRRADUT.m

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      ;