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

EASMTL1.m

Go to the documentation of this file. 
  1. EASMTL1 ;MIN/TCM ALB/SCK/AEG/PHH - AUTOMATED MEANS TEST LETTER - PATIENT SEARCH ; 07/2/01
  1.  ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,12,20,54**;MAR 15,2001
  1.  ; Conversion from class III software
  1.  ;
  1. QUEUE ; Main entry point for tasked (background) letter search
  1.  N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,ZDATE
  1.  ;
  1.  S ZTRTN="EN^EASMTL1"
  1.  S ZTDESC="AUTOMATED MT LETTERS GENERATOR"
  1.  S (ZTDTH,ZDATE)=$$NOW^XLFDT
  1.  S ZTIO=""
  1.  D ^%ZTLOAD
  1.  Q
  1.  ;
  1. SETDT(EASRUN) ;
  1.  ; Input
  1.  ;    EASRUN   - Default start date for processing
  1.  ;
  1.  ; Output
  1.  ;    1 - Ok
  1.  ;    0 - Quit
  1.  ;    EASRUN - Accepted start date for processing
  1.  ;
  1.  N DIR,DIRUT,RSLT
  1.  ;
  1.  S DIR("A",1)="The prior processing date is not available.  A default date"
  1.  S DIR("A",2)="of "_$$FMTE^XLFDT(EASRUN)_" will be used."
  1.  S DIR("A")="Ok to continue? "
  1.  S DIR(0)="YAO",DIR("B")="YES"
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) Q 0
  1.  Q:Y Y
  1.  ;
  1.  S DIR(0)="DAO^:DT:EX",DIR("B")=$$FMTE^XLFDT(EASRUN)
  1.  S DIR("?")="^D HELP^%DTC"
  1.  S DIR("A",1)=""
  1.  S DIR("A")="Select new start date: "
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) Q 0
  1.  S EASRUN=Y
  1.  Q 1
  1.  ;
  1. EN ; Main entry point for processing
  1.  N EASLAST,X,EASLST,EASABRT,EASN,EAS6CNT,EAS3CNT,EAS0CNT,EASDT,EASDTFLG,EADT,MSG,EASX
  1.  ;
  1.  ; Get last processing date, default to TODAY - 30 if date not available
  1.  S EASX=$$GET1^DIQ(713,1,2,"I")
  1.  S EADT=$$DT^XLFDT
  1.  ; If letter search has already been run for TODAY, quit
  1.  I EASX=EADT D  Q
  1.  . I '$D(ZTQUEUED) D
  1.  . . W !!,$CHAR(7),">> The Means Test Letter search has been run for today.",!
  1.  . . D PAUSE^EASMTUTL
  1.  ;
  1.  I EASX S EASLAST=$$FMADD^XLFDT(EASX,1)
  1.  I '$G(EASX) D  Q:$G(EASABRT)
  1.  . S EASLAST=$$FMADD^XLFDT(DT,-30)
  1.  . I '$D(ZTQUEUED) S:'$$SETDT(.EASLAST) EASABRT=1
  1.  ;
  1.  ; Check lock on parameter file, one process at a time, quit if locked
  1.  I '$$LOCK^EASMTUTL(1) D  Q
  1.  . I $D(ZTQUEUED) D  Q
  1.  . . D ALERT^EASMTUTL("Auto MT Letters: This process is already running, "_$$FMTE^XLFDT(EADT,"2D"))
  1.  . W !!,$CHAR(7),"This process is already running, please try again later"
  1.  . D PAUSE^EASMTUTL
  1.  ;
  1.  D BLDLST(EASLAST,EADT)    ; Build processing date list
  1.  D PROCESS                 ; Process dates
  1.  S EASX=$$LOCK^EASMTUTL(0)
  1.  D UPDPARAM(EADT)
  1.  D STATS(EASLAST,.EAS6CNT,EADT)
  1.  ;
  1.  I $D(ZTQUEUED) D
  1.  . S MSG="Auto-Letters Search completed: "_$$FMTE^XLFDT($$NOW^XLFDT)
  1.  . D ALERT^EASMTUTL(MSG)
  1.  Q
  1.  ;
  1. BLDLST(FRDT,TODT) ; Build processing date list
  1.  ; Input
  1.  ;   FRDT - Beginning date for processing list
  1.  ;   TODT - Ending date for processing list
  1.  ;
  1.  N EASN
  1.  ;
  1.  S EASN=FRDT,EASLST(FRDT)="",EASLST(TODT)=""
  1.  F  S EASN=$$FMADD^XLFDT(EASN,1) Q:EASN>TODT  S EASLST(EASN)=""
  1.  Q
  1.  ;
  1. PROCESS ;  Get anniversary and threshold dates
  1.  N EASPRCDT
  1.  ;
  1.  S (EAS0CNT,EAS3CNT,EAS6CNT)=0
  1.  ; Calculate Anniverary date and 60/30/0 dates based on the Anniverary date
  1.  S EASPRCDT=0 ; Begin loop through processing dates
  1.  F  S EASPRCDT=$O(EASLST(EASPRCDT)) Q:EASPRCDT'>0  D  Q:$G(ZTSTOP)  ; Quit if stop request
  1.  . K EASDT
  1.  . I '$D(ZTQUEUED) W !?5,">> Processing date  "_$$FMTE^XLFDT(EASPRCDT)_"  in progress <<",!
  1.  . ; Anniversary date is processing date minus one year plus sixty days
  1.  . ;
  1.  . S EASDT("ANV")=$$FMADD^XLFDT($$SUBLEAP^EASMTUTL(EASPRCDT),60) ; Anv date: 1 Year - 60 days
  1.  . S EASDT("60")=$$FMADD^XLFDT(EASDT("ANV"),(365-60)) ; Define 60 day letter print date
  1.  . S EASDT("30")=$$FMADD^XLFDT(EASDT("ANV"),(365-30)) ; Define 30 day letter print date
  1.  . S EASDT("0")=$$FMADD^XLFDT(EASDT("ANV"),365) ; Define 0 day letter print date
  1.  . ;
  1.  . ; Call the threshold date search
  1.  . D EN60^EASMTL2
  1.  . ; Check for stop request if queued
  1.  . I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1
  1.  Q
  1.  ;
  1. UPDPARAM(EASDT) ; Update the EAS Parameter file, #713
  1.  ; Input
  1.  ;   EASDT - Today's date
  1.  ;
  1.  N DIE,DA,DR
  1.  ;
  1.  S DIE="^EAS(713,",DA=1,DR="2////^S X=EASDT"
  1.  S:'$D(ZTQUEUED) DR=DR_";3////^S X=DUZ;4////^S X=EASDT"
  1.  D ^DIE K DIE
  1.  Q
  1.  ;
  1. STATS(EASLAST,EAS6CNT,EASDT) ;Gather and print statistics
  1.  ; Input
  1.  ;    EASLAST  - Last date processed (Beginning date)
  1.  ;    EAS6CNT  - Array of 60 day letters
  1.  ;    EASDT    - Ending date of processing
  1.  ;
  1.  N MSG,EASD,LINE,TOT,XMSUB,XMY,XMTEXT,XMDUZ,ZDCD
  1.  ;
  1.  ; EAS*1*12 modification
  1.  S ZDCD=$S($$VERSION^XPDUTL("IVMC"):0,1:60)
  1.  ; ** 
  1.  ; EAS*1*20 modification
  1.  I $G(ZDCD)'>0,$G(DT)>3021014 S ZDCD=60
  1.  ;
  1.  S MSG(.1)="Automated Means Test Letter Generator Statistics"
  1.  S MSG(.2)="------------------------------------------------"
  1.  S MSG(.3)=""
  1.  S MSG(.4)="Beginning Processing Date: "_$$FMTE^XLFDT(EASLAST)
  1.  S MSG(.5)="Ending Processing Date:    "_$$FMTE^XLFDT(EASDT)
  1.  S MSG(.6)=""
  1.  S MSG(11)="  "_ZDCD_"-day Letters: "_EAS6CNT
  1.  S MSG(16)=""
  1.  S LINE=18
  1.  ;
  1.  S LINE=LINE+1
  1.  S MSG(LINE)=ZDCD_" Day Letter Totals:    "
  1.  S EASD=0
  1.  F  S EASD=$O(EAS6CNT(EASD)) Q:'EASD  D
  1.  . I +$G(EAS6CNT(EASD)) D
  1.  . . S LINE=LINE+1
  1.  . . S MSG(LINE)="  "_$$FMTE^XLFDT(EASD)_" : "_EAS6CNT(EASD)
  1.  ;
  1.  S XMSUB="AUTO MT LETTER RESULTS - "_$$FMTE^XLFDT(EASDT)
  1.  S XMTEXT="MSG("
  1.  S XMY("G.EAS MTLETTERS")=""
  1.  S XMDUZ="AUTOMATED MT LETTERS"
  1.  D ^XMD
  1.  Q