Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMG2M1

PXRMG2M1.m

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