PXRMG2M1 ;SLC/JVS -GEC #2 MAIL MESSAGES ;7/14/05 08:12
;;2.0;CLINICAL REMINDERS;**2,4**;Feb 04, 2005;Build 21
Q
;=================================================
TASK ;Start queued option PXRM GEC QUARTERLY ROLLUP
Q:'$D(DT)
D CALCMON
D EN^PXRMG2E2
D MAIL
Q
START ;Start queued option PXRM GEC QUARTERLY ROLLUP
Q:'$D(DT)
D CALC
D EN^PXRMG2E2
D MAIL
Q
MAIL ;MAIL OUT the STAT array
N SITE,XMZ,XMY,XMSUB,XMDUZ,SITE2
S XMSUB="GEC FISCAL QUARTER "_FQUARTER_" "_YEAR_" Rollup Data"
I DT<3050401 S XMSUB="TEST DATA-- "_XMSUB
S SITE=$P($$SITE^VASITE,"^",2)_" #"_$P($$SITE^VASITE,"^",3)
S SITE2=$P($$SITE^VASITE,"^",3)_" "_$P($$SITE^VASITE,"^",2)
S XMDUZ=SITE2_" GEC Rollup Data"
RETRY D XMZ^XMA2
I XMZ<1 G RETRY
;
N PROG,MON,L,LINE,MGIEN,MGROUP
S L=0
S PROG="AD" F S PROG=$O(STAT(PROG)) Q:PROG="" D
.S MON=0 F S MON=$O(STAT(PROG,MON)) Q:MON="" D
..S L=L+1
..S ^XMB(3.9,XMZ,2,L,0)=$G(STAT(PROG,MON))
;
I L>10 D
.F I=(L+1):1:14 S ^XMB(3.9,XMZ,2,I,0)=$P($T(TEXT+(I-12)),";",3)
.S ^XMB(3.9,XMZ,2,15,0)="data from "_SITE_" for Fiscal Quarter # "_FQUARTER_" of "_YEAR_". (Calendar Quarter "_QUARTER_")"
.S L=15 F I=(L+1):1:55 S ^XMB(3.9,XMZ,2,I,0)=$P($T(TEXT+(I-12)),";",3)
.;
.S ^XMB(3.9,XMZ,2,0)="^3.92^"_I_"^"_I_"^"_DT
.S XMDUZ="GEC Project"
.I $$PROD^XUPROD(1) S XMY("G.GEC2 NATIONAL ROLLUP")=""
.S MGIEN=$G(^PXRM(800,1,"MGFE"))
.I MGIEN'="" D
..S MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
..S XMY(MGROUP)=""
.D ENT1^XMD
.D EXIT
Q
TEXT ;Text added to the bottom of the mail message
;13;
;14; The above information is Geriatric Extended Care "Home" Referral
;15;
;16;-------------------------------------------------
;17; Each section of data is separated by a comma. The table below
;18;defines the sections. Numbers represent Patients. Patient only counted once.
;19;
;20; 1 Number for the site.
;21; 2 Number that stands for the Month (1=January)...
;22; 3 Acronym for the Program (ADHC,HHHA,VAIHR,CC)
;23; 4 Total number of patients referred to the program that month
;24; 5 Number that DID NOT MEET ANY of the criteria
;25; 6 Number that only met criteria 1
;26; 7 Number that only met criteria 2
;27; 8 Number that only met criteria 3
;28; 9 Number that only met criteria 4
;29; 10 Number that only met both criteria's 1 and 2
;30; 11 Number that only met both criteria's 1 and 3
;31; 12 Number that only met both criteria's 1 and 4
;32; 13 Number that only met both criteria's 2 and 3
;34; 14 Number that only met both criteria's 2 and 4
;35; 15 Number that only met both criteria's 3 and 4
;36; 16 Number that only met the criteria's 1 and 2 and 3
;37; 17 Number that only met the criteria's 1 and 2 and 4
;38; 18 Number that only met the criteria's 1 and 3 and 4
;39; 19 Number that only met the criteria's 2 and 3 and 4
;40; 20 Number that met all criteria's 1 and 2 and 3 and 4
;41;
;42;--------------------------------------------------
;43;The Basic Criteria for Eligibility is shown below.
;44;
;45; 1: Problems with 3 or more ADL's.
;46; 2: 1 or more patient behavior or cognitive problem.
;47; 3: Expected life limit of less than 6 months.
;48; 4: Combination of the following:
;49; 2 or more ADL dependencies.
;50; <AND> 2 or more of the following:
;51; problems with 3 or more IADL's.
;52; <OR> age of patients is 75 or more.
;53; <OR> living alone in the community.
;54; <OR> utilizes the clinics 12 or more times in the
;55; preceding 12 months.
;============================================
EXIT ;Exit and Clean up Variables
K ^TMP("PXRMGEC",$J)
Q
CALC ;Calculate the quarter number
N MON,YER,CQTR,BCQTR,BQTR,BYER,FQTR
S MON=+$E(DT,4,5),YER=1700+$E(DT,1,3)
;
I MON=1!(MON=2)!(MON=3) S CQTR=1
I MON=4!(MON=5)!(MON=6) S CQTR=2
I MON=7!(MON=8)!(MON=9) S CQTR=3
I MON=10!(MON=11)!(MON=12) S CQTR=4
;
I CQTR=1 S BYER=YER-1
E S BYER=YER
I CQTR=1 S BQTR=4
E S BQTR=CQTR-1
;
I BQTR=1 S FQTR=2
I BQTR=2 S FQTR=3
I BQTR=3 S FQTR=4
I BQTR=4 S FQTR=1
S QUARTER=BQTR,FQUARTER=FQTR,YEAR=BYER,DFNONLY=0
;After april 1 2005 no test patients
S TPAT=0
Q
;
CALCMON ;Calculate the quarter number for current quarter
N MON,YER,CQTR,BQTR,BCQTR,BYER,FQTR
S MON=+$E(DT,4,5),YER=1700+$E(DT,1,3)
;
I MON=1!(MON=2)!(MON=3) S CQTR=1
I MON=4!(MON=5)!(MON=6) S CQTR=2
I MON=7!(MON=8)!(MON=9) S CQTR=3
I MON=10!(MON=11)!(MON=12) S CQTR=4
;
S BYER=YER
S BQTR=CQTR
;
I BQTR=1 S FQTR=2
I BQTR=2 S FQTR=3
I BQTR=3 S FQTR=4
I BQTR=4 S FQTR=1
;
S QUARTER=BQTR,FQUARTER=FQTR,YEAR=BYER,DFNONLY=0
;After april 1 2005 no test patients
S TPAT=0
S ZTREQ="@"
;
Q
;
POST ;Post installation routine
;add remote members to mail group
D ADDMBRS^XMXAPIG(DUZ,"GEC2 NATIONAL ROLLUP","VAUGHN.SMITH@MED.VA.GOV")
D ADDMBRS^XMXAPIG(DUZ,"GEC2 NATIONAL ROLLUP","patrick.brady@e2k.hq.med.va.gov")
D ADDMBRS^XMXAPIG(DUZ,"GEC2 NATIONAL ROLLUP","daniel.schoeps@e2k.hq.med.va.gov")
;
TASKRPT ;This will task a monthy report for 4 month.
;May 8th 2005,June 8th 2005,AUG 8th 2005,Sept 8th 2005
N ZTRTN,ZTDESC,ZTDTH,ZTIO,MON,ZTREQ,ZTSK
S MON=0
Q:$D(^TMP("PXRMG2TSK"))
F ZTDTH="3050508.0200","3050608.0200","3050808.0200","3050908.0200" D
.S MON=MON+1
.I MON=1 S MONTH="MAY"
.I MON=2 S MONTH="JUNE"
.I MON=3 S MONTH="AUGUST"
.I MON=4 S MONTH="SEPT"
.S ZTRTN="TASK^PXRMG2M1"
.S ZTDESC=MONTH_" 2005 GEC National Report"
.S ZTIO=""
.D ^%ZTLOAD
.D BMES^XPDUTL(MONTH_" 8th's GEC Tasked Job number "_ZTSK)
S ^TMP("PXRMG2TSK",$J)="DT"
CLEAN ;Clean up after previous builds
K ^PXRMD(801.5,"ATASK")
Q
PXRMG2M1 ;SLC/JVS -GEC #2 MAIL MESSAGES ;7/14/05 08:12
+1 ;;2.0;CLINICAL REMINDERS;**2,4**;Feb 04, 2005;Build 21
+2 QUIT
+3 ;=================================================
TASK ;Start queued option PXRM GEC QUARTERLY ROLLUP
+1 IF '$DATA(DT)
QUIT
+2 DO CALCMON
+3 DO EN^PXRMG2E2
+4 DO MAIL
+5 QUIT
START ;Start queued option PXRM GEC QUARTERLY ROLLUP
+1 IF '$DATA(DT)
QUIT
+2 DO CALC
+3 DO EN^PXRMG2E2
+4 DO MAIL
+5 QUIT
MAIL ;MAIL OUT the STAT array
+1 NEW SITE,XMZ,XMY,XMSUB,XMDUZ,SITE2
+2 SET XMSUB="GEC FISCAL QUARTER "_FQUARTER_" "_YEAR_" Rollup Data"
+3 IF DT<3050401
SET XMSUB="TEST DATA-- "_XMSUB
+4 SET SITE=$PIECE($$SITE^VASITE,"^",2)_" #"_$PIECE($$SITE^VASITE,"^",3)
+5 SET SITE2=$PIECE($$SITE^VASITE,"^",3)_" "_$PIECE($$SITE^VASITE,"^",2)
+6 SET XMDUZ=SITE2_" GEC Rollup Data"
RETRY DO XMZ^XMA2
+1 IF XMZ<1
GOTO RETRY
+2 ;
+3 NEW PROG,MON,L,LINE,MGIEN,MGROUP
+4 SET L=0
+5 SET PROG="AD"
FOR
SET PROG=$ORDER(STAT(PROG))
IF PROG=""
QUIT
Begin DoDot:1
+6 SET MON=0
FOR
SET MON=$ORDER(STAT(PROG,MON))
IF MON=""
QUIT
Begin DoDot:2
+7 SET L=L+1
+8 SET ^XMB(3.9,XMZ,2,L,0)=$GET(STAT(PROG,MON))
End DoDot:2
End DoDot:1
+9 ;
+10 IF L>10
Begin DoDot:1
+11 FOR I=(L+1):1:14
SET ^XMB(3.9,XMZ,2,I,0)=$PIECE($TEXT(TEXT+(I-12)),";",3)
+12 SET ^XMB(3.9,XMZ,2,15,0)="data from "_SITE_" for Fiscal Quarter # "_FQUARTER_" of "_YEAR_". (Calendar Quarter "_QUARTER_")"
+13 SET L=15
FOR I=(L+1):1:55
SET ^XMB(3.9,XMZ,2,I,0)=$PIECE($TEXT(TEXT+(I-12)),";",3)
+14 ;
+15 SET ^XMB(3.9,XMZ,2,0)="^3.92^"_I_"^"_I_"^"_DT
+16 SET XMDUZ="GEC Project"
+17 IF $$PROD^XUPROD(1)
SET XMY("G.GEC2 NATIONAL ROLLUP")=""
+18 SET MGIEN=$GET(^PXRM(800,1,"MGFE"))
+19 IF MGIEN'=""
Begin DoDot:2
+20 SET MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
+21 SET XMY(MGROUP)=""
End DoDot:2
+22 DO ENT1^XMD
+23 DO EXIT
End DoDot:1
+24 QUIT
TEXT ;Text added to the bottom of the mail message
+1 ;13;
+2 ;14; The above information is Geriatric Extended Care "Home" Referral
+3 ;15;
+4 ;16;-------------------------------------------------
+5 ;17; Each section of data is separated by a comma. The table below
+6 ;18;defines the sections. Numbers represent Patients. Patient only counted once.
+7 ;19;
+8 ;20; 1 Number for the site.
+9 ;21; 2 Number that stands for the Month (1=January)...
+10 ;22; 3 Acronym for the Program (ADHC,HHHA,VAIHR,CC)
+11 ;23; 4 Total number of patients referred to the program that month
+12 ;24; 5 Number that DID NOT MEET ANY of the criteria
+13 ;25; 6 Number that only met criteria 1
+14 ;26; 7 Number that only met criteria 2
+15 ;27; 8 Number that only met criteria 3
+16 ;28; 9 Number that only met criteria 4
+17 ;29; 10 Number that only met both criteria's 1 and 2
+18 ;30; 11 Number that only met both criteria's 1 and 3
+19 ;31; 12 Number that only met both criteria's 1 and 4
+20 ;32; 13 Number that only met both criteria's 2 and 3
+21 ;34; 14 Number that only met both criteria's 2 and 4
+22 ;35; 15 Number that only met both criteria's 3 and 4
+23 ;36; 16 Number that only met the criteria's 1 and 2 and 3
+24 ;37; 17 Number that only met the criteria's 1 and 2 and 4
+25 ;38; 18 Number that only met the criteria's 1 and 3 and 4
+26 ;39; 19 Number that only met the criteria's 2 and 3 and 4
+27 ;40; 20 Number that met all criteria's 1 and 2 and 3 and 4
+28 ;41;
+29 ;42;--------------------------------------------------
+30 ;43;The Basic Criteria for Eligibility is shown below.
+31 ;44;
+32 ;45; 1: Problems with 3 or more ADL's.
+33 ;46; 2: 1 or more patient behavior or cognitive problem.
+34 ;47; 3: Expected life limit of less than 6 months.
+35 ;48; 4: Combination of the following:
+36 ;49; 2 or more ADL dependencies.
+37 ;50; <AND> 2 or more of the following:
+38 ;51; problems with 3 or more IADL's.
+39 ;52; <OR> age of patients is 75 or more.
+40 ;53; <OR> living alone in the community.
+41 ;54; <OR> utilizes the clinics 12 or more times in the
+42 ;55; preceding 12 months.
+43 ;============================================
EXIT ;Exit and Clean up Variables
+1 KILL ^TMP("PXRMGEC",$JOB)
+2 QUIT
CALC ;Calculate the quarter number
+1 NEW MON,YER,CQTR,BCQTR,BQTR,BYER,FQTR
+2 SET MON=+$EXTRACT(DT,4,5)
SET YER=1700+$EXTRACT(DT,1,3)
+3 ;
+4 IF MON=1!(MON=2)!(MON=3)
SET CQTR=1
+5 IF MON=4!(MON=5)!(MON=6)
SET CQTR=2
+6 IF MON=7!(MON=8)!(MON=9)
SET CQTR=3
+7 IF MON=10!(MON=11)!(MON=12)
SET CQTR=4
+8 ;
+9 IF CQTR=1
SET BYER=YER-1
+10 IF '$TEST
SET BYER=YER
+11 IF CQTR=1
SET BQTR=4
+12 IF '$TEST
SET BQTR=CQTR-1
+13 ;
+14 IF BQTR=1
SET FQTR=2
+15 IF BQTR=2
SET FQTR=3
+16 IF BQTR=3
SET FQTR=4
+17 IF BQTR=4
SET FQTR=1
+18 SET QUARTER=BQTR
SET FQUARTER=FQTR
SET YEAR=BYER
SET DFNONLY=0
+19 ;After april 1 2005 no test patients
+20 SET TPAT=0
+21 QUIT
+22 ;
CALCMON ;Calculate the quarter number for current quarter
+1 NEW MON,YER,CQTR,BQTR,BCQTR,BYER,FQTR
+2 SET MON=+$EXTRACT(DT,4,5)
SET YER=1700+$EXTRACT(DT,1,3)
+3 ;
+4 IF MON=1!(MON=2)!(MON=3)
SET CQTR=1
+5 IF MON=4!(MON=5)!(MON=6)
SET CQTR=2
+6 IF MON=7!(MON=8)!(MON=9)
SET CQTR=3
+7 IF MON=10!(MON=11)!(MON=12)
SET CQTR=4
+8 ;
+9 SET BYER=YER
+10 SET BQTR=CQTR
+11 ;
+12 IF BQTR=1
SET FQTR=2
+13 IF BQTR=2
SET FQTR=3
+14 IF BQTR=3
SET FQTR=4
+15 IF BQTR=4
SET FQTR=1
+16 ;
+17 SET QUARTER=BQTR
SET FQUARTER=FQTR
SET YEAR=BYER
SET DFNONLY=0
+18 ;After april 1 2005 no test patients
+19 SET TPAT=0
+20 SET ZTREQ="@"
+21 ;
+22 QUIT
+23 ;
POST ;Post installation routine
+1 ;add remote members to mail group
+2 DO ADDMBRS^XMXAPIG(DUZ,"GEC2 NATIONAL ROLLUP","VAUGHN.SMITH@MED.VA.GOV")
+3 DO ADDMBRS^XMXAPIG(DUZ,"GEC2 NATIONAL ROLLUP","patrick.brady@e2k.hq.med.va.gov")
+4 DO ADDMBRS^XMXAPIG(DUZ,"GEC2 NATIONAL ROLLUP","daniel.schoeps@e2k.hq.med.va.gov")
+5 ;
TASKRPT ;This will task a monthy report for 4 month.
+1 ;May 8th 2005,June 8th 2005,AUG 8th 2005,Sept 8th 2005
+2 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,MON,ZTREQ,ZTSK
+3 SET MON=0
+4 IF $DATA(^TMP("PXRMG2TSK"))
QUIT
+5 FOR ZTDTH="3050508.0200","3050608.0200","3050808.0200","3050908.0200"
Begin DoDot:1
+6 SET MON=MON+1
+7 IF MON=1
SET MONTH="MAY"
+8 IF MON=2
SET MONTH="JUNE"
+9 IF MON=3
SET MONTH="AUGUST"
+10 IF MON=4
SET MONTH="SEPT"
+11 SET ZTRTN="TASK^PXRMG2M1"
+12 SET ZTDESC=MONTH_" 2005 GEC National Report"
+13 SET ZTIO=""
+14 DO ^%ZTLOAD
+15 DO BMES^XPDUTL(MONTH_" 8th's GEC Tasked Job number "_ZTSK)
End DoDot:1
+16 SET ^TMP("PXRMG2TSK",$JOB)="DT"
CLEAN ;Clean up after previous builds
+1 KILL ^PXRMD(801.5,"ATASK")
+2 QUIT
