source: FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMG2M1.m

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

initial load of FOIAVistA 6/30/08 version
File size: 5.4 KB
Line 
1PXRMG2M1 ;SLC/JVS -GEC #2 MAIL MESSAGES ;7/14/05 08:12
2 ;;2.0;CLINICAL REMINDERS;**2,4**;Feb 04, 2005;Build 21
3 Q
4 ;=================================================
5TASK ;Start queued option PXRM GEC QUARTERLY ROLLUP
6 Q:'$D(DT)
7 D CALCMON
8 D EN^PXRMG2E2
9 D MAIL
10 Q
11START ;Start queued option PXRM GEC QUARTERLY ROLLUP
12 Q:'$D(DT)
13 D CALC
14 D EN^PXRMG2E2
15 D MAIL
16 Q
17MAIL ;MAIL OUT the STAT array
18 N SITE,XMZ,XMY,XMSUB,XMDUZ,SITE2
19 S XMSUB="GEC FISCAL QUARTER "_FQUARTER_" "_YEAR_" Rollup Data"
20 I DT<3050401 S XMSUB="TEST DATA-- "_XMSUB
21 S SITE=$P($$SITE^VASITE,"^",2)_" #"_$P($$SITE^VASITE,"^",3)
22 S SITE2=$P($$SITE^VASITE,"^",3)_" "_$P($$SITE^VASITE,"^",2)
23 S XMDUZ=SITE2_" GEC Rollup Data"
24RETRY D XMZ^XMA2
25 I XMZ<1 G RETRY
26 ;
27 N PROG,MON,L,LINE,MGIEN,MGROUP
28 S L=0
29 S PROG="AD" F S PROG=$O(STAT(PROG)) Q:PROG="" D
30 .S MON=0 F S MON=$O(STAT(PROG,MON)) Q:MON="" D
31 ..S L=L+1
32 ..S ^XMB(3.9,XMZ,2,L,0)=$G(STAT(PROG,MON))
33 ;
34 I L>10 D
35 .F I=(L+1):1:14 S ^XMB(3.9,XMZ,2,I,0)=$P($T(TEXT+(I-12)),";",3)
36 .S ^XMB(3.9,XMZ,2,15,0)="data from "_SITE_" for Fiscal Quarter # "_FQUARTER_" of "_YEAR_". (Calendar Quarter "_QUARTER_")"
37 .S L=15 F I=(L+1):1:55 S ^XMB(3.9,XMZ,2,I,0)=$P($T(TEXT+(I-12)),";",3)
38 .;
39 .S ^XMB(3.9,XMZ,2,0)="^3.92^"_I_"^"_I_"^"_DT
40 .S XMDUZ="GEC Project"
41 .I $$PROD^XUPROD(1) S XMY("G.GEC2 NATIONAL ROLLUP")=""
42 .S MGIEN=$G(^PXRM(800,1,"MGFE"))
43 .I MGIEN'="" D
44 ..S MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
45 ..S XMY(MGROUP)=""
46 .D ENT1^XMD
47 .D EXIT
48 Q
49TEXT ;Text added to the bottom of the mail message
50 ;13;
51 ;14; The above information is Geriatric Extended Care "Home" Referral
52 ;15;
53 ;16;-------------------------------------------------
54 ;17; Each section of data is separated by a comma. The table below
55 ;18;defines the sections. Numbers represent Patients. Patient only counted once.
56 ;19;
57 ;20; 1 Number for the site.
58 ;21; 2 Number that stands for the Month (1=January)...
59 ;22; 3 Acronym for the Program (ADHC,HHHA,VAIHR,CC)
60 ;23; 4 Total number of patients referred to the program that month
61 ;24; 5 Number that DID NOT MEET ANY of the criteria
62 ;25; 6 Number that only met criteria 1
63 ;26; 7 Number that only met criteria 2
64 ;27; 8 Number that only met criteria 3
65 ;28; 9 Number that only met criteria 4
66 ;29; 10 Number that only met both criteria's 1 and 2
67 ;30; 11 Number that only met both criteria's 1 and 3
68 ;31; 12 Number that only met both criteria's 1 and 4
69 ;32; 13 Number that only met both criteria's 2 and 3
70 ;34; 14 Number that only met both criteria's 2 and 4
71 ;35; 15 Number that only met both criteria's 3 and 4
72 ;36; 16 Number that only met the criteria's 1 and 2 and 3
73 ;37; 17 Number that only met the criteria's 1 and 2 and 4
74 ;38; 18 Number that only met the criteria's 1 and 3 and 4
75 ;39; 19 Number that only met the criteria's 2 and 3 and 4
76 ;40; 20 Number that met all criteria's 1 and 2 and 3 and 4
77 ;41;
78 ;42;--------------------------------------------------
79 ;43;The Basic Criteria for Eligibility is shown below.
80 ;44;
81 ;45; 1: Problems with 3 or more ADL's.
82 ;46; 2: 1 or more patient behavior or cognitive problem.
83 ;47; 3: Expected life limit of less than 6 months.
84 ;48; 4: Combination of the following:
85 ;49; 2 or more ADL dependencies.
86 ;50; <AND> 2 or more of the following:
87 ;51; problems with 3 or more IADL's.
88 ;52; <OR> age of patients is 75 or more.
89 ;53; <OR> living alone in the community.
90 ;54; <OR> utilizes the clinics 12 or more times in the
91 ;55; preceding 12 months.
92 ;============================================
93EXIT ;Exit and Clean up Variables
94 K ^TMP("PXRMGEC",$J)
95 Q
96CALC ;Calculate the quarter number
97 N MON,YER,CQTR,BCQTR,BQTR,BYER,FQTR
98 S MON=+$E(DT,4,5),YER=1700+$E(DT,1,3)
99 ;
100 I MON=1!(MON=2)!(MON=3) S CQTR=1
101 I MON=4!(MON=5)!(MON=6) S CQTR=2
102 I MON=7!(MON=8)!(MON=9) S CQTR=3
103 I MON=10!(MON=11)!(MON=12) S CQTR=4
104 ;
105 I CQTR=1 S BYER=YER-1
106 E S BYER=YER
107 I CQTR=1 S BQTR=4
108 E S BQTR=CQTR-1
109 ;
110 I BQTR=1 S FQTR=2
111 I BQTR=2 S FQTR=3
112 I BQTR=3 S FQTR=4
113 I BQTR=4 S FQTR=1
114 S QUARTER=BQTR,FQUARTER=FQTR,YEAR=BYER,DFNONLY=0
115 ;After april 1 2005 no test patients
116 S TPAT=0
117 Q
118 ;
119CALCMON ;Calculate the quarter number for current quarter
120 N MON,YER,CQTR,BQTR,BCQTR,BYER,FQTR
121 S MON=+$E(DT,4,5),YER=1700+$E(DT,1,3)
122 ;
123 I MON=1!(MON=2)!(MON=3) S CQTR=1
124 I MON=4!(MON=5)!(MON=6) S CQTR=2
125 I MON=7!(MON=8)!(MON=9) S CQTR=3
126 I MON=10!(MON=11)!(MON=12) S CQTR=4
127 ;
128 S BYER=YER
129 S BQTR=CQTR
130 ;
131 I BQTR=1 S FQTR=2
132 I BQTR=2 S FQTR=3
133 I BQTR=3 S FQTR=4
134 I BQTR=4 S FQTR=1
135 ;
136 S QUARTER=BQTR,FQUARTER=FQTR,YEAR=BYER,DFNONLY=0
137 ;After april 1 2005 no test patients
138 S TPAT=0
139 S ZTREQ="@"
140 ;
141 Q
142 ;
143POST ;Post installation routine
144 ;add remote members to mail group
145 D ADDMBRS^XMXAPIG(DUZ,"GEC2 NATIONAL ROLLUP","VAUGHN.SMITH@MED.VA.GOV")
146 D ADDMBRS^XMXAPIG(DUZ,"GEC2 NATIONAL ROLLUP","patrick.brady@e2k.hq.med.va.gov")
147 D ADDMBRS^XMXAPIG(DUZ,"GEC2 NATIONAL ROLLUP","daniel.schoeps@e2k.hq.med.va.gov")
148 ;
149TASKRPT ;This will task a monthy report for 4 month.
150 ;May 8th 2005,June 8th 2005,AUG 8th 2005,Sept 8th 2005
151 N ZTRTN,ZTDESC,ZTDTH,ZTIO,MON,ZTREQ,ZTSK
152 S MON=0
153 Q:$D(^TMP("PXRMG2TSK"))
154 F ZTDTH="3050508.0200","3050608.0200","3050808.0200","3050908.0200" D
155 .S MON=MON+1
156 .I MON=1 S MONTH="MAY"
157 .I MON=2 S MONTH="JUNE"
158 .I MON=3 S MONTH="AUGUST"
159 .I MON=4 S MONTH="SEPT"
160 .S ZTRTN="TASK^PXRMG2M1"
161 .S ZTDESC=MONTH_" 2005 GEC National Report"
162 .S ZTIO=""
163 .D ^%ZTLOAD
164 .D BMES^XPDUTL(MONTH_" 8th's GEC Tasked Job number "_ZTSK)
165 S ^TMP("PXRMG2TSK",$J)="DT"
166CLEAN ;Clean up after previous builds
167 K ^PXRMD(801.5,"ATASK")
168 Q
Note: See TracBrowser for help on using the repository browser.