source: FOIAVistA/tag/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXRRADUT.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1PXRRADUT ;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 ;=======================================================================
5AGE(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 ;
19AGEHELP(TYPE) ;Write the age selection help.
20 W !!,"This is the ",TYPE," patient age for selecting encounters."
21 Q
22 ;
23 ;=======================================================================
24BDHELP(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 ;=======================================================================
34DOBFA(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 ;=======================================================================
41EDHELP(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 ;=======================================================================
51FDR(BDATE,EDATE,TYPE,BHTEXT,EHTEXT) ;Get a future date range.
52FBDATE ;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 ;
67FEDATE ;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 ;=======================================================================
82GDR(BDATE,EDATE,TYPE,BHTEXT,EHTEXT) ;Get a general date range.
83GBDATE ;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 ;
97GEDATE ;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 ;=======================================================================
112HELP(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 ;=======================================================================
131PDR(BDATE,EDATE,TYPE,BHTEXT,EXTEXT) ;Get a past date range.
132PBDATE ;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 ;
146PEDATE ;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 ;
Note: See TracBrowser for help on using the repository browser.