| 1 | PXRRADUT ;ISL/PKR - Age and date utilities for PCE reports. ;6/26/97
|
|---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**10,18**;Aug 12, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | ;=======================================================================
|
|---|
| 5 | AGE(TYPE,NEWLINE) ;Get a patient age.
|
|---|
| 6 | N X,Y
|
|---|
| 7 | K DIRUT,DTOUT,DUOUT
|
|---|
| 8 | S DIR(0)="NO"
|
|---|
| 9 | S DIR("A")="Enter "_TYPE_" AGE"
|
|---|
| 10 | S DIR("?")="Enter an age in years"
|
|---|
| 11 | S DIR("??")=U_"D AGEHELP^PXRRADUT(TYPE)"
|
|---|
| 12 | I NEWLINE W !
|
|---|
| 13 | D ^DIR K DIR
|
|---|
| 14 | I $D(DIROUT) S DTOUT=1
|
|---|
| 15 | I $D(DTOUT)!($D(DUOUT)) Q -1
|
|---|
| 16 | Q Y
|
|---|
| 17 | ;
|
|---|
| 18 | ;
|
|---|
| 19 | AGEHELP(TYPE) ;Write the age selection help.
|
|---|
| 20 | W !!,"This is the ",TYPE," patient age for selecting encounters."
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | ;=======================================================================
|
|---|
| 24 | BDHELP(HTEXT,TYPE) ;Write the beginning date help.
|
|---|
| 25 | I $D(HTEXT) D HELP^PXRRADUT(.HTEXT)
|
|---|
| 26 | I '$D(HTEXT) D
|
|---|
| 27 | . N BDHTEXT
|
|---|
| 28 | . S BDHTEXT(1)="This is the beginning date for "_TYPE_" to be included in the creation of"
|
|---|
| 29 | . S BDHTEXT(2)="this report."
|
|---|
| 30 | . D HELP^PXRRADUT(.BDHTEXT)
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | ;=======================================================================
|
|---|
| 34 | DOBFA(AGE) ;Given an age in years return the corresponding date of birth.
|
|---|
| 35 | N DOB
|
|---|
| 36 | I (AGE=0)!(AGE="") Q 0
|
|---|
| 37 | S DOB=DT-(AGE*10000)
|
|---|
| 38 | Q DOB
|
|---|
| 39 | ;
|
|---|
| 40 | ;=======================================================================
|
|---|
| 41 | EDHELP(HTEXT,TYPE) ;Write the ending date help.
|
|---|
| 42 | I $D(HTEXT) D HELP^PXRRADUT(.HTEXT)
|
|---|
| 43 | I '$D(HTEXT) D
|
|---|
| 44 | . N EDHTEXT
|
|---|
| 45 | . S EDHTEXT(1)="This is the ending date for "_TYPE_" to be included in the creation"
|
|---|
| 46 | . S EDHTEXT(2)="of this report."
|
|---|
| 47 | . D HELP^PXRRADUT(.EDHTEXT)
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | ;=======================================================================
|
|---|
| 51 | FDR(BDATE,EDATE,TYPE,BHTEXT,EHTEXT) ;Get a future date range.
|
|---|
| 52 | FBDATE ;Select the beginning date.
|
|---|
| 53 | N X,Y
|
|---|
| 54 | K DIROUT,DIRUT,DTOUT,DUOUT
|
|---|
| 55 | S DIR(0)="DA^"_DT_"::EFTX"
|
|---|
| 56 | S DIR("A")="Enter "_TYPE_" BEGINNING DATE: "
|
|---|
| 57 | S DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D")
|
|---|
| 58 | S DIR("?")="This must be a future date. For detailed help type ??"
|
|---|
| 59 | S DIR("??")=U_"D BDHELP^PXRRADUT(.BHTEXT,TYPE)"
|
|---|
| 60 | W !
|
|---|
| 61 | D ^DIR K DIR
|
|---|
| 62 | I $D(DIROUT) S DTOUT=1
|
|---|
| 63 | I $D(DTOUT)!($D(DUOUT)) Q
|
|---|
| 64 | S BDATE=Y
|
|---|
| 65 | I $E(Y,6,7)="00" W $C(7)," ?? Enter exact date" G FBDATE
|
|---|
| 66 | ;
|
|---|
| 67 | FEDATE ;Select the ending date.
|
|---|
| 68 | S DIR(0)="DA^"_BDATE_"::ETFX"
|
|---|
| 69 | S DIR("A")="Enter "_TYPE_" ENDING DATE: "
|
|---|
| 70 | S DIR("?")="This must be a future date and not before "_$$FMTE^XLFDT(BDATE,"D")_". For detailed help type ??"
|
|---|
| 71 | S DIR("??")=U_"D EDHELP^PXRRADUT(.EHTEXT,TYPE)"
|
|---|
| 72 | D ^DIR K DIR
|
|---|
| 73 | I $D(DIROUT) S DTOUT=1
|
|---|
| 74 | I $D(DTOUT) Q
|
|---|
| 75 | I $D(DUOUT) G FBDATE
|
|---|
| 76 | S EDATE=Y
|
|---|
| 77 | I $E(Y,6,7)="00" W $C(7)," ?? Enter exact date" G FEDATE
|
|---|
| 78 | K DIROUT,DIRUT,DTOUT,DUOUT
|
|---|
| 79 | Q
|
|---|
| 80 | ;
|
|---|
| 81 | ;=======================================================================
|
|---|
| 82 | GDR(BDATE,EDATE,TYPE,BHTEXT,EHTEXT) ;Get a general date range.
|
|---|
| 83 | GBDATE ;Select the beginning date.
|
|---|
| 84 | N X,Y
|
|---|
| 85 | K DIROUT,DIRUT,DTOUT,DUOUT
|
|---|
| 86 | S DIR(0)="DA^::ETX"
|
|---|
| 87 | S DIR("A")="Enter "_TYPE_" BEGINNING DATE: "
|
|---|
| 88 | S DIR("?")="This must be a date. For detailed help type ??"
|
|---|
| 89 | S DIR("??")=U_"D BDHELP^PXRRADUT(.BHTEXT,TYPE)"
|
|---|
| 90 | W !
|
|---|
| 91 | D ^DIR K DIR
|
|---|
| 92 | I $D(DIROUT) S DTOUT=1
|
|---|
| 93 | I $D(DTOUT)!($D(DUOUT)) Q
|
|---|
| 94 | S BDATE=Y
|
|---|
| 95 | I $E(Y,6,7)="00" W $C(7)," ?? Enter exact date" G GBDATE
|
|---|
| 96 | ;
|
|---|
| 97 | GEDATE ;Select the ending date.
|
|---|
| 98 | S DIR(0)="DA^"_BDATE_"::ETX"
|
|---|
| 99 | S DIR("A")="Enter "_TYPE_" ENDING DATE: "
|
|---|
| 100 | S DIR("?")="This must be a date and not before "_$$FMTE^XLFDT(BDATE,"D")_". For detailed help type ??"
|
|---|
| 101 | S DIR("??")=U_"D EDHELP^PXRRADUT(.EHTEXT,TYPE)"
|
|---|
| 102 | D ^DIR K DIR
|
|---|
| 103 | I $D(DIROUT) S DTOUT=1
|
|---|
| 104 | I $D(DTOUT) Q
|
|---|
| 105 | I $D(DUOUT) G GBDATE
|
|---|
| 106 | S EDATE=Y
|
|---|
| 107 | I $E(Y,6,7)="00" W $C(7)," ?? Enter exact date" G GEDATE
|
|---|
| 108 | K DIROUT,DIRUT,DTOUT,DUOUT
|
|---|
| 109 | Q
|
|---|
| 110 | ;
|
|---|
| 111 | ;=======================================================================
|
|---|
| 112 | HELP(HTEXT) ;General help text routine. Write out the text in the HTEXT
|
|---|
| 113 | ;array.
|
|---|
| 114 | N DIWF,DIWL,DIWR,IC
|
|---|
| 115 | S DIWF="C70",DIWL=0,DIWR=70
|
|---|
| 116 | K ^UTILITY($J,"W")
|
|---|
| 117 | S IC=""
|
|---|
| 118 | F S IC=$O(HTEXT(IC)) Q:IC="" D
|
|---|
| 119 | . S X=HTEXT(IC)
|
|---|
| 120 | . D ^DIWP
|
|---|
| 121 | W !
|
|---|
| 122 | S IC=0
|
|---|
| 123 | F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
|
|---|
| 124 | . W !,^UTILITY($J,"W",0,IC,0)
|
|---|
| 125 | K ^UTILITY($J,"W")
|
|---|
| 126 | W !
|
|---|
| 127 | D HELP^%DTC
|
|---|
| 128 | Q
|
|---|
| 129 | ;
|
|---|
| 130 | ;=======================================================================
|
|---|
| 131 | PDR(BDATE,EDATE,TYPE,BHTEXT,EXTEXT) ;Get a past date range.
|
|---|
| 132 | PBDATE ;Select the beginning date.
|
|---|
| 133 | N X,Y
|
|---|
| 134 | K DIROUT,DIRUT,DTOUT,DUOUT
|
|---|
| 135 | S DIR(0)="D^:"_DT_":EPTX"
|
|---|
| 136 | S DIR("A")="Enter "_TYPE_" BEGINNING DATE"
|
|---|
| 137 | S DIR("?")="This must be a past date. For detailed help type ??"
|
|---|
| 138 | S DIR("??")=U_"D BDHELP^PXRRADUT(.BHTEXT,TYPE)"
|
|---|
| 139 | W !
|
|---|
| 140 | D ^DIR K DIR
|
|---|
| 141 | I $D(DIROUT) S DTOUT=1
|
|---|
| 142 | I $D(DTOUT)!($D(DUOUT)) Q
|
|---|
| 143 | S BDATE=Y
|
|---|
| 144 | I $E(Y,6,7)="00" W $C(7)," ?? Enter exact date" G PBDATE
|
|---|
| 145 | ;
|
|---|
| 146 | PEDATE ;Select the ending date.
|
|---|
| 147 | S DIR(0)="DA^"_BDATE_":"_DT_":EPTX"
|
|---|
| 148 | S DIR("A")="Enter "_TYPE_" ENDING DATE: "
|
|---|
| 149 | S DIR("?")="This must be a past date, but not before "_$$FMTE^XLFDT(BDATE,"D")_". For detailed help type ??"
|
|---|
| 150 | S DIR("??")=U_"D EDHELP^PXRRADUT(.EHTEXT,TYPE)"
|
|---|
| 151 | D ^DIR K DIR
|
|---|
| 152 | I $D(DIROUT) S DTOUT=1
|
|---|
| 153 | I $D(DTOUT) Q
|
|---|
| 154 | I $D(DUOUT) G PBDATE
|
|---|
| 155 | S EDATE=Y
|
|---|
| 156 | I $E(Y,6,7)="00" W $C(7)," ?? Enter exact date" G PEDATE
|
|---|
| 157 | K DIROUT,DIRUT,DTOUT,DUOUT
|
|---|
| 158 | Q
|
|---|
| 159 | ;
|
|---|
