source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEUT.m@ 1719

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

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1PXRMEUT ; SLC/PJH - General extract utilities ;09/06/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;
4 ;=================================================
5ASKNUM(TEXT,MIN,MAX) ;
6 N DIR,X,Y
7 K DIROUT,DIRUT,DTOUT,DUOUT
8 S DIR(0)="N"_U_MIN_":"_MAX
9 S DIR("A")=TEXT
10 S DIR("B")=MIN
11 S DIR("?")="Enter a number between "_MIN_" and "_MAX_"."
12 W !
13 D ^DIR
14 I $D(DTOUT)!$D(DUOUT) S Y=MIN
15 Q Y
16 ;
17 ;=================================================
18ASKYN(DEF,TEXT,RTN,HLP) ;
19 N DIR,X,Y
20 K DIROUT,DIRUT,DTOUT,DUOUT
21 S DIR(0)="Y0"
22 S DIR("A")=TEXT
23 S DIR("B")=DEF
24 S DIR("?")="Enter Y or N."
25 I $G(RTN)'="",$G(HLP)'="" D
26 . S DIR("?")="Enter Y or N. For detailed help type ??"
27 . S DIR("??")=U_"D HELP^"_RTN_"(HLP)"
28 W !
29 D ^DIR
30 I $D(DTOUT)!$D(DUOUT) S Y=DEF
31 Q Y
32 ;
33 ;=================================================
34BHELP ;Write the beginning date help.
35 N BDHTEXT,%DT
36 S BDHTEXT(1)="This is the beginning date for the "_LIT_"."
37 D HELP^PXRMEUT(.BDHTEXT)
38 S %DT="P",%DT(0)=-DT
39 D HELP^%DTC
40 Q
41 ;
42 ;=================================================
43CALC(NEXT,START,END) ;Calculate period start and end dates
44 ;Next is current run period
45 N CMON,CYR,ETYPE,NMON,NYR,PERIOD,YEAR
46 ;extract year and period (M1,M2,Q1,Q2,Y etc)
47 I NEXT["/" S YEAR=$P(NEXT,"/",2),PERIOD=$P(NEXT,"/"),ETYPE=$E(PERIOD)
48 I NEXT?4N S YEAR=NEXT,PERIOD="",ETYPE="Y"
49 ;Two digit year
50 S CYR=$E(YEAR,3,4),NYR=CYR
51 ;If yearly use Jan 1st of current year and next
52 I ETYPE="Y" D
53 .S CMON="1",NMON="1",NYR=NYR+1
54 ;If quarterly use start of first month of next quarter
55 I ETYPE="Q" D
56 .S CMON=$E(PERIOD,2,99),NMON=CMON*3+1 I NMON>12 S NYR=NYR+1,NMON=1
57 .S CMON=CMON*3-2
58 ;If monthly use start of next month
59 I ETYPE="M" D
60 .S CMON=$E(PERIOD,2,99),NMON=CMON+1 I NMON>12 S NYR=NYR+1,NMON=1
61 ;Zero fill the month fields
62 S CMON=$$RJ^XLFSTR(CMON,2,0),NMON=$$RJ^XLFSTR(NMON,2,0)
63 ;Zero fill the year fields
64 S CYR=$$RJ^XLFSTR(CYR,2,0),NYR=$$RJ^XLFSTR(NYR,2,0)
65 ;Report start date is start of current period
66 S START=3_CYR_CMON_"01"
67 ;Report end date is start of next period less one day
68 S END=$$FMADD^XLFDT(3_NYR_NMON_"01",-1)
69 Q
70 ;
71 ;=================================================
72DATES(BDATE,EDATE,LIT) ;Get a past date range.
73BEGIN ;Select the beginning date.
74 N DIR,%DT,X,Y
75 K DIROUT,DIRUT,DTOUT,DUOUT
76 S DIR(0)="DA^::ETX"
77 S DIR("A")="Enter "_LIT_" BEGINNING DATE: "
78 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"
79 S DIR("?")="For detailed help type ??"
80 S DIR("??")=U_"D BHELP^PXRMEUT"
81 W !
82 D ^DIR K DIR
83 I $D(DIROUT) S DTOUT=1
84 I $D(DTOUT)!($D(DUOUT)) Q
85 S BDATE=Y
86 I $E(Y,6,7)="00" W $C(7)," ?? Enter exact date" G BEGIN
87 S BDATE=Y
88 ;
89END ;Select the ending date.
90 S DIR(0)="DA^"_BDATE_"::ETX"
91 S DIR("A")="Enter "_LIT_" ENDING DATE: "
92 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X"
93 S DIR("?")="This date cannot be before "_$$FMTE^XLFDT(BDATE,"D")_". For detailed help type ??"
94 S DIR("??")=U_"D EHELP^PXRMEUT"
95 D ^DIR
96 I $D(DIROUT) S DTOUT=1
97 I $D(DTOUT) Q
98 I $D(DUOUT) G BEGIN
99 S EDATE=Y
100 I $E(Y,6,7)="00" W $C(7)," ?? Enter exact date" G END
101 K DIROUT,DIRUT,DTOUT,DUOUT
102 Q
103 ;
104 ;=================================================
105DOCUMENT(PXRMLIST,PXRMRULE,INDP,INTP,BEG,END) ;Document how the
106 ;list was built.
107 N CDATE,CLASS,CREATOR,IND,LDATA,LNAME
108 N NDL,NL,NPAT,OUTPUT,SNAME,SOURCE,TEXT,TYPE,VALMCNT
109 K ^TMP("PXRMLRED",$J)
110 S LDATA=$G(^PXRMXP(810.5,PXRMLIST,0))
111 S LNAME=$P(LDATA,U,1)
112 S CDATE=$P(LDATA,U,4)
113 S SOURCE=$P(LDATA,U,5),SNAME="NONE"
114 ;Check if generated from #810.2
115 I SOURCE S SNAME="Extract Parameter - "_$P($G(^PXRM(810.2,SOURCE,0)),U)
116 ;If not check if generated from #810.4
117 I 'SOURCE S SOURCE=$P(LDATA,U,6) S:SOURCE SNAME="List Rule - "_$P($G(^PXRM(810.4,SOURCE,0)),U)
118 ;Creator
119 S CREATOR=+$P(LDATA,U,7)
120 S CREATOR=$S(CREATOR>0:$$GET1^DIQ(200,CREATOR,.01),1:"None")
121 ;Type
122 S TYPE=$P(LDATA,U,8)
123 S TYPE=$$EXTERNAL^DILFD(810.5,.08,"",TYPE,.EM)
124 ;Class
125 S CLASS=$P($G(^PXRMXP(810.5,PXRMLIST,100)),U,1)
126 S CLASS=$S(CLASS="N":"National",CLASS="V":"VISN",1:"Local")
127 S NPAT=$P(^PXRMXP(810.5,PXRMLIST,30,0),U,4)
128 S TEXT(1)="List Name: "_LNAME_" ("_NPAT_" patients)"
129 S TEXT(2)=" Created: "_$$FMTE^XLFDT(CDATE,"5Z")
130 S TEXT(2)=$$LJ^XLFSTR(TEXT(2),40)_"Creator: "_CREATOR
131 S TEXT(3)=" Class: "_CLASS
132 S TEXT(3)=$$LJ^XLFSTR(TEXT(3),40)_"Type: "_TYPE
133 S TEXT(4)=" Source: "_SNAME
134 S TEXT(5)=" Patient List Beginning Date: "_$$FMTE^XLFDT(BEG,"5Z")
135 S TEXT(6)=" Patient List Ending Date: "_$$FMTE^XLFDT(END,"5Z")
136 S TEXT(7)=" "
137 S NL=7
138 F IND=1:1:NL S ^PXRMXP(810.5,PXRMLIST,200,IND,0)=TEXT(IND)
139 D BLDLIST^PXRMLRED(PXRMRULE,3)
140 F IND=1:1:VALMCNT S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)=^TMP("PXRMLRED",$J,IND,0)
141 S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)=" --- List Build Information ---"
142 S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)="List Build Beginning Date: "_$$FMTE^XLFDT(BEG,"5Z")
143 S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)="List Build Ending Date: "_$$FMTE^XLFDT(END,"5Z")
144 S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)=" "
145 S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)="Include deceased patients: "_$S(INDP:"Yes",1:"No")
146 S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)="Include test patients: "_$S(INTP:"Yes",1:"No")
147 ;Get the beginning and ending date information
148 D DOCDATES^PXRMEUT1(PXRMRULE,BEG,END,.NDL,.OUTPUT)
149 F IND=1:1:NDL S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)=OUTPUT(IND)
150 S ^PXRMXP(810.5,PXRMLIST,200,0)=U_U_NL_U_NL_U_DT_U
151 K ^TMP("PXRMLRED",$J)
152 Q
153 ;
154 ;=================================================
155EHELP ;Write the ending date help.
156 N EDHTEXT,%DT
157 S EDHTEXT(1)="This is the ending date for the "_LIT_"."
158 D HELP^PXRMEUT(.EDHTEXT)
159 S %DT="P",%DT(0)=-DT
160 D HELP^%DTC
161 Q
162 ;
163 ;=================================================
164HELP(HTEXT) ;General help text output routine.
165 N IND,NIN,NOUT,TEXTIN,TEXOUT
166 ;Make sure the text is in a form the formatting routine can handle.
167 S IND="",NIN=0
168 F S IND=$O(HTEXT(IND)) Q:IND="" S NIN=NIN+1,TEXTIN(NIN)=HTEXT(IND)
169 D FORMAT^PXRMTEXT(1,72,NIN,.TEXTIN,.NOUT,.TEXTOUT)
170 F IND=1:1:NOUT W !,TEXTOUT(IND)
171 W !
172 Q
173 ;
174 ;=================================================
175LDELOK(LISTIEN) ;Return a 1 if it is ok for this user to delete the list.
176 N CREATOR,DELOK
177 S CREATOR=$P(^PXRMXP(810.5,LISTIEN,0),U,7)
178 S DELOK=$S(CREATOR=DUZ:1,$D(^XUSEC("PXRM MANAGER",DUZ)):1,1:0)
179 Q DELOK
180 ;
181 ;=================================================
182MES(TEXT) ;General mail message
183 N XMSUB
184 K ^TMP("PXRMXMZ",$J)
185 S XMSUB="CLINICAL REMINDER EXTRACT"
186 S ^TMP("PXRMXMZ",$J,1,0)=TEXT
187 D SEND^PXRMMSG(XMSUB)
188 Q
189 ;
190 ;=================================================
191PERIOD(FREQ) ;Calculate next period
192 N CMON,CUR,CYR,ETYPE,NEXT,PERIOD,YEAR
193 ;Format current date YY/MM/DD
194 S CUR=$$FMTE^XLFDT($$NOW^XLFDT,7)
195 ;extract year and period
196 S YEAR=$P(CUR,"/"),PERIOD=$P(CUR,"/",2)
197 ;If yearly current year
198 I FREQ="Y" D
199 .S NEXT=YEAR
200 ;If quarterly use current quarter
201 I FREQ="Q" D
202 .S NEXT="Q"_((PERIOD-1\3)+1)_"/"_YEAR
203 ;If monthly use current month
204 I FREQ="M" D
205 .S NEXT="M"_PERIOD_"/"_YEAR
206 Q NEXT
207 ;
208 ;=================================================
209RMPAT(NODE,INDP,INTP) ;Remove dead and test patients from
210 ;the list.
211 I INDP,INTP Q
212 N DFN,DOD,REMOVE
213 S DFN=0
214 F S DFN=$O(^TMP($J,NODE,DFN)) Q:DFN="" D
215 .;DBIA 3744
216 . S REMOVE=$S('INTP:$$TESTPAT^VADPT(DFN),1:0)
217 . I REMOVE K ^TMP($J,NODE,DFN) Q
218 . I INDP Q
219 .;DBIA #10035
220 . S DOD=+$P($G(^DPT(DFN,.35)),U,1)
221 . I DOD=0 Q
222 . K ^TMP($J,NODE,DFN)
223 Q
224 ;
Note: See TracBrowser for help on using the repository browser.