source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXDUT.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1PXRMXDUT ; SLC/PJH - Date utilities for reminder reports. ;05/05/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4BDHELP(HTEXT,TYPE) ;Write the beginning date help.
5 I $D(HTEXT) D HELP(.HTEXT)
6 I '$D(HTEXT) D
7 . N BDHTEXT
8 . S BDHTEXT(1)="This is the beginning date for "_TYPE_" to be included in the creation of"
9 . S BDHTEXT(2)="this report."
10 . D HELP^PXRMXDUT(.BDHTEXT)
11 Q
12 ;
13EDHELP(HTEXT,TYPE) ;Write the ending date help.
14 I $D(HTEXT) D HELP(.HTEXT)
15 I '$D(HTEXT) D
16 . N EDHTEXT
17 . S EDHTEXT(1)="This is the ending date for "_TYPE_" to be included in the creation"
18 . S EDHTEXT(2)="of this report."
19 . D HELP^PXRMXDUT(.EDHTEXT)
20 Q
21 ;
22SDHELP(HTEXT) ;Write the single date help.
23 I $D(HTEXT) D HELP(.HTEXT)
24 I '$D(HTEXT) D
25 . N SDHTEXT
26 . S SDHTEXT(1)="This is the date of reminder evaluation for the report"
27 . D HELP^PXRMXDUT(.SDHTEXT)
28 Q
29 ;
30FDR(BDATE,EDATE,TYPE,BHTEXT,EHTEXT) ;Get a future date range.
31FBDATE ;Select the beginning date.
32 N X,Y,DIR
33 K DIROUT,DIRUT,DTOUT,DUOUT
34 S DIR(0)="DA^"_DT_"::EFTX"
35 S DIR("A")="Enter "_TYPE_" BEGINNING DATE AND TIME: "
36 S DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D")
37 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"
38 S DIR("?")="This must be a future date. For detailed help type ??"
39 S DIR("??")=U_"D BDHELP^PXRMXDUT(.BHTEXT,TYPE)"
40 W !
41 D ^DIR K DIR
42 I $D(DIROUT) S DTOUT=1
43 I $D(DTOUT)!($D(DUOUT)) Q
44 S BDATE=Y
45 I $E(Y,6,7)="00" W $C(7)," ?? Enter exact date" G FBDATE
46 ;
47FEDATE ;Select the ending date.
48 S DIR(0)="DA^"_BDATE_"::ETFX"
49 S DIR("A")="Enter "_TYPE_" ENDING DATE AND TIME: "
50 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"
51 S DIR("?")="This must be a future date and not before "_$$FMTE^XLFDT(BDATE,"P")_". For detailed help type ??"
52 S DIR("??")=U_"D EDHELP^PXRMXDUT(.EHTEXT,TYPE)"
53 D ^DIR K DIR
54 I $D(DIROUT) S DTOUT=1
55 I $D(DTOUT) Q
56 I $D(DUOUT) G FBDATE
57 S EDATE=Y
58 I EDATE<DT W !,"This must be a past date. For detailed help type ??" G FEDATE
59 I EDATE<BDATE W !,"The ending date cannot be before the beginning date" G FEDATE
60 I $E(Y,6,7)="00" W $C(7)," ?? Enter exact date" G FEDATE
61 K DIROUT,DIRUT,DTOUT,DUOUT
62 Q
63 ;
64GDR(BDATE,EDATE,TYPE,BHTEXT,EHTEXT) ;Get a general date range.
65GBDATE ;Select the beginning date.
66 N X,Y,DIR
67 K DIROUT,DIRUT,DTOUT,DUOUT
68 S DIR(0)="DA^::ETX"
69 S DIR("A")="Enter "_TYPE_" BEGINNING DATE: "
70 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"
71 S DIR("?")="This must be a date. For detailed help type ??"
72 S DIR("??")=U_"D BDHELP^PXRMXDUT(.BHTEXT,TYPE)"
73 W !
74 D ^DIR K DIR
75 I $D(DIROUT) S DTOUT=1
76 I $D(DTOUT)!($D(DUOUT)) Q
77 S BDATE=Y
78 I BDATE<DT W !,"This must be a past date. For detailed help type ??" G FBDATE
79 ;
80GEDATE ;Select the ending date.
81 S DIR(0)="DA^"_BDATE_"::ETX"
82 S DIR("A")="Enter "_TYPE_" ENDING DATE: "
83 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"
84 S DIR("?")="This must be a date and not before "_$$FMTE^XLFDT(BDATE,"D")_". For detailed help type ??"
85 S DIR("??")=U_"D EDHELP^PXRMXDUT(.EHTEXT,TYPE)"
86 D ^DIR K DIR
87 I $D(DIROUT) S DTOUT=1
88 I $D(DTOUT) Q
89 I $D(DUOUT) G GBDATE
90 S EDATE=Y
91 I $E(Y,6,7)="00" W $C(7)," ?? Enter exact date" G GEDATE
92 K DIROUT,DIRUT,DTOUT,DUOUT
93 Q
94 ;
95HELP(HTEXT) ;General help text routine. Write out the text in the HTEXT
96 ;array.
97 N DIWF,DIWL,DIWR,IC
98 S DIWF="C70",DIWL=0,DIWR=70
99 K ^UTILITY($J,"W")
100 S IC=""
101 F S IC=$O(HTEXT(IC)) Q:IC="" D
102 . S X=HTEXT(IC)
103 . D ^DIWP
104 W !
105 S IC=0
106 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
107 . W !,^UTILITY($J,"W",0,IC,0)
108 K ^UTILITY($J,"W")
109 W !
110 N %DT,MODE
111 S MODE=$G(TYPE),%DT="F",%DT(0)=DT
112 I (MODE="ADMISSION")!(MODE="ENCOUNTER") S %DT="P",%DT(0)=-DT
113 D HELP^%DTC
114 Q
115 ;
116PDR(BDATE,EDATE,TYPE,BHTEXT,EXTEXT) ;Get a past date range.
117PBDATE ;Select the beginning date.
118 N X,Y,DIR
119 K DIROUT,DIRUT,DTOUT,DUOUT
120 S DIR(0)="D^:"_DT_":EPTX"
121 S DIR("A")="Enter "_TYPE_" BEGINNING DATE"
122 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"
123 S DIR("?")="This must be a past date. For detailed help type ??"
124 S DIR("??")=U_"D BDHELP^PXRMXDUT(.BHTEXT,TYPE)"
125 W !
126 D ^DIR K DIR
127 I $D(DIROUT) S DTOUT=1
128 I $D(DTOUT)!($D(DUOUT)) Q
129 S BDATE=Y
130 I $P(BDATE,".")>DT W !,"This must be a past date. For detailed help type ??" G PBDATE
131 I $E(Y,6,7)="00" W $C(7)," ?? Enter exact date" G PBDATE
132 ;
133PEDATE ;Select the ending date.
134 S DIR(0)="DA^"_BDATE_":"_DT_":EPTX"
135 S DIR("A")="Enter "_TYPE_" ENDING DATE: "
136 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"
137 S DIR("?")="This must be a past date, but not before "_$$FMTE^XLFDT(BDATE,"D")_". For detailed help type ??"
138 S DIR("??")=U_"D EDHELP^PXRMXDUT(.EHTEXT,TYPE)"
139 D ^DIR K DIR
140 I $D(DIROUT) S DTOUT=1
141 I $D(DTOUT) Q
142 I $D(DUOUT) G PBDATE
143 S EDATE=Y
144 I $P(EDATE,".")>DT W !,"This must be a past date. For detailed help type ??" G PEDATE
145 I $E(Y,6,7)="00" W $C(7)," ?? Enter exact date" G PEDATE
146 I EDATE<BDATE W !,"The ending date cannot be less then the beginning date." G PEDATE
147 K DIROUT,DIRUT,DTOUT,DUOUT
148 Q
149 ;
150SDR(SDATE,BHTEXT,EHTEXT) ;Get a date.
151SBDATE ;Select the date.
152 N X,Y,DIR
153 K DIROUT,DIRUT,DTOUT,DUOUT
154 S DIR(0)="DA^::ETX"
155 S DIR("A")="Enter EFFECTIVE DUE DATE: "
156 S DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D")
157 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"
158 S DIR("?")="Enter date for reminder evaluation. For detailed help type ??"
159 S DIR("??")=U_"D SDHELP^PXRMXDUT(.BHTEXT)"
160 W !
161 D ^DIR K DIR
162 I $D(DIROUT) S DTOUT=1
163 I $D(DTOUT)!($D(DUOUT)) Q
164 I $E(Y,6,7)="00" W $C(7)," ?? Enter exact date" G SBDATE
165 S SDATE=Y
166 K DIROUT,DIRUT,DTOUT,DUOUT
167 Q
168 ;
Note: See TracBrowser for help on using the repository browser.