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