EASMTUTL ; ALB/SCK/BRM/PHH - AUTOMATED MEANS TEST LETTERS UTILITIES ; 7/2/01
;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,14,15,29,22,54**;MAR 15,2001
;
;
PAUSE ; Screen pause, user must press key to continue
S DIR(0)="FAO",DIR("A")="Press any key to continue..."
D ^DIR K DIR
Q
;
CLRFLG(EAX,DA) ; Clears flags in File #713.2, For development
N DIE,DR
;
Q:EAX=1
S:EAX=2 DR="9///0"
S:EAX=3 DR="9///0;12///0"
S:EAX=4 DR="9///0;12///0"
S:EAX=0 DR="9///0;12///0;18///0"
S DIE="^EAS(713.2,"
D ^DIE K DIE
Q
;
LOCK(ACTION) ; Flag IN USE field in EAS Parameters file, #713
; Input
; ACTION - Locking action
; 1 = Flag IN USE for Automated Generator is running
; 0 = Flag IN USE for Automated Generator is not running
; Output
; 1 if action was successful
; 0 if action was not successful
N RSLT
;
I ACTION,$D(^EAS(713,"ALOCK",1)) Q $G(RSLT)
;
S DIE="^EAS(713,",DA=1,DR="30////^S X=ACTION"
D ^DIE K DIE
S RSLT=1
Q +$G(RSLT)
;
ALERT(ERRMSG) ; Post an alert message to the EAS Letters Mail group
N XMY,XMTEXT,XMDUZ,XMSUB,MSG
;
S MSG(1)="Notification:"
S MSG(2)=ERRMSG
;
S XMY("G.EAS MTLETTERS")=""
S XMTEXT="MSG("
S XMDUZ="EAS Auto MT Letters"
S XMSUB="EAS Means Test Letter's Notice"
D ^XMD
Q
;
ADRERR(EASADD,DFN) ; Error notification for missing or invalid patient address
N MSG,XMY,XMTEXT,XMDUZ,XMSUB,VAROOT,EASDEM,VA,EASPRF
;
S VAROOT="EASDEM"
D DEM^VADPT
D PID^VADPT6
S EASPRF=$$GET1^DIQ(2,DFN,27.02)
I EASPRF']"" S EASPRF="No Preferred Facility"
;
S MSG(1)="The following patient does not have a complete permanent mailing"
S MSG(2)="address. A means test reminder letter could not be mailed."
S MSG(3)=" "
S MSG(4)=" Patient : "_EASDEM(1)
S MSG(5)=" Last 4 : "_VA("BID")
S MSG(6)="Address Line 1 : "_EASADD(1)
S MSG(7)=" City : "_EASADD(4)
S MSG(8)=" State : "_$P(EASADD(5),U,2)
S MSG(9)=" Zipcode : "_$P(EASADD(11),U,2)
S MSG(9.5)=" Bad Addr : "_$P(EASADD("BAI"),U,2)
S MSG(10)=""
S MSG(11)=" DFN : "_$G(DFN)
S MSG(13)=""
S MSG(14)="This patient's letter entry will stay in 'FLAGGED-TO-PRINT' status until"
S MSG(15)="the address is corrected."
;
I +EASADD(9)>0!(+EASADD(10)>0) D
. S MSG(5.5)="** Temporary Address in effect **"
S XMY("G.EAS MTLETTERS")=""
S XMTEXT="MSG("
S XMDUZ="EAS Auto MT Letters"
S XMSUB="Incomplete/Bad Addr: "_EASPRF
D ^XMD
Q
;
CLRLCK ; Clears IN USE field of the EAS MT PARAMETERS if an error occurs and locks the field
N DIE,DR,DA
;
S DA=1,DIE="^EAS(713,",DR="30///0"
D ^DIE
Q
;
PROHBIT ; Set or delete the Prohibit fields in the Patient Status file, #713.1
N DIR,DIRUT,EASF,Y,X,EASIEN,DFN,DGFDA,FDAIEN,ERRMSG
;
S DIR(0)="S^S:Set Prohibit Flag;R:Remove Prohibit Flag"
S DIR("A")="Set or remove the MT Prohibit flag"
S DIR("?")="Select 'S' to set flag, 'R' to remove the flag"
D ^DIR K DIR
Q:$D(DIRUT)
S EASF=Y
;
I EASF="R"!(EASF="r") D Q:$D(DIRUT)
. S DIR(0)="PAO^713.1:EMZ"
. S DIR("A")="Select Patient: "
. D ^DIR K DIR
. S EASIEN=+Y
;
I EASF="S"!(EASF="s") D Q:$D(DIRUT)
. S DIR(0)="PAO^2:EMZ"
. S DIR("A")="Select Patient: "
. D ^DIR K DIR
. Q:$D(DIRUT)
. S DFN=+Y
. I '$D(^EAS(713.1,"B",DFN)) D Q:$D(DIRUT)
. . S DIR(0)="Y",DIR("B")="YES"
. . S DIR("A")="Add patient to the Patient Status File"
. . D ^DIR K DIR
. . Q:$D(DIRUT)
. . I 'Y S DIRUT=1 Q
. . S DGFDA(1,713.1,"+1,",.01)=DFN
. . D UPDATE^DIE("","DGFDA(1)","FDAIEN","ERRMSG")
. . S EASIEN=FDAIEN(1)
. I $D(^EAS(713.1,"B",DFN)) S EASIEN=$O(^EAS(713.1,"B",DFN,0))
;
Q:'$G(EASIEN)
;
N DGFDA,DGIEN,DGEFF,DIR,DIRUT,DGERR,DIE
;
S DGIEN=EASIEN_","
I EASF="S" D
. S DIR(0)="DAO^"_$$DT^XLFDT_"::EX"
. S DIR("A")="Effective Date: "
. D ^DIR K DIR
. Q:$G(DIRUT)
. S DGFDA(1,713.1,DGIEN,3)=Y
. S DGFDA(1,713.1,DGIEN,2)=1
. S DGFDA(1,713.1,DGIEN,5)=$$NOW^XLFDT
. S DGFDA(1,713.1,DGIEN,4)=DUZ
. D:$D(DGFDA) FILE^DIE("","DGFDA(1)","DGERR")
. I $D(DGERR) D Q
. . D DSPLYER(.DGERR)
. S DIE="^EAS(713.1,",DA=EASIEN,DR="10"
. D ^DIE K DIE
;
I EASF="R" D
. S DGFDA(1,713.1,DGIEN,2)=0
. S DGFDA(1,713.1,DGIEN,3)="@"
. S DGFDA(1,713.1,DGIEN,5)="@"
. S DGFDA(1,713.1,DGIEN,4)="@"
. S DGFDA(1,713.1,DGIEN,10)="@"
. D:$D(DGFDA) FILE^DIE("","DGFDA(1)","DGERR")
. I $D(DGERR) D
. . D DSPLYER(.DGERR)
. E W !!?3,"Prohibit Flag Removed from Patient.",!
;
Q
;
DSPLYER(ERRARY) ;
N DGER
;
W !!?3,"The following error(s) occurred:"
S DGER=0
F S DGER=$O(ERRARY("DIERR",DGER)) Q:'DGER D
. W !?3,ERRARY("DIERR",DGER)," - ",ERRARY("DIERR",DGER,"TEXT",1)
W !?3,"Please check, this record update may not have processed completely."
Q
;
EDTLTRS ;
N DIR,EASIEN
;
S DIR(0)="P^713.3:EMZ"
S DIR("A")="Select Letter"
D ^DIR K DIR
Q:$D(DIRUT)
S EASIEN=+Y
;
S DIE="^EAS(713.3,",DA=EASIEN,DR="4"
D ^DIE
Q
;
MTRTN ; Update the letter status file, #713.2, with returned Means Test information
N DIE,DIC,EASIEN,DR,DA,Y
;
S DIC="^EAS(713.2,",DIC(0)="AEQM",DIC("A")="Select the Letter Status entry to update: "
D ^DIC K DIC
Q:Y<0
S EASIEN=+Y
;
S DIE="^EAS(713.2,",DA=EASIEN
S DR="4;I X=0 S Y=0;5;7;6////^S X=DUZ;9///0;12///0;18///0"
L +^EAS(713.2,EASIEN):0 I $T D
. D ^DIE K DIE
E W !,$CHAR(7),"Entry is being edited by another user."
L -^EAS(713.2,EASIEN)
;
Q
;
DECEASED(EASIEN,DFN) ; Check deceased status for patient
N RSLT,EADEM,EAS1,VAROOT
;
S EASIEN=$G(EASIEN)
S DFN=$G(DFN)
I EASIEN>0 D
. S EAS1=$$GET1^DIQ(713.2,EASIEN,2,"I")
. S DFN=$$GET1^DIQ(713.1,EAS1,.01,"I")
Q:'DFN 0
S RSLT=0
;
S VAROOT="EADEM"
D DEM^VADPT
S:+EADEM(6) RSLT=1
D KVA^VADPT
Q RSLT
;
CHECKMT(EASPT,EAIEN) ; Check current MT status
N DFN,RTN,EACHK,DIE,DR,DA
;
S RTN=0
I '$G(EASPT) S RTN=1 G CHKQ ; Safety check
S DFN=$$GET1^DIQ(713.1,EASPT,.01,"I") ; Get DFN
I '$G(DFN) S RTN=1 G CHKQ ; Safety check
;
S EACHK=$$MTCHK^EASMTCHK(DFN,"L") ; Check current MT to see if it's changed
I 'EACHK D ; If MT no longer required, update letter status file
. S DIE="^EAS(713.2,",DA=EAIEN
. S DR="4///YES;5///TODAY;7///AUTO-GENERATED;9///NO;12///NO;18///NO"
. D ^DIE K DIE ;; Remove before release
. S RTN=1
;
CHKQ Q RTN
;
FUTMT(EASIEN) ; Check for a future MT
; Input
; EASIEN - IEN for record in Letter Status file
;
; Output
; 1 - Future MT exist's (API call)
; 0 - Future MT does not exist
;
N EASPTR,DFN,EASFUT
;
S RTN=0
S EASPTR=$$GET1^DIQ(713.2,EASIEN,2,"I")
S DFN=$$GET1^DIQ(713.1,EASPTR,.01,"I")
;
;; Call API for future MT check
S EASFUT=$$FUT^DGMTU(DFN)
;
I +$G(EASFUT) D ; Turn off letters if future MT present
. Q:'EASIEN
. S DIE="^EAS(713.2,",DA=EASIEN
. S DR="4///YES;5///TODAY;7///FUTURE MEANS TEST;9///NO;12///NO;18///NO"
. D ^DIE K DIE
. S RTN=1
Q RTN
;
TESTLTR ;
N EASIEN,EATYP,DIR,DIRUT,ZTSAVE
;
S DIR(0)="SO^1:60-Day;2:30-Day;4:0-Day"
S DIR("A")="Select letter type to test"
S DIR("?")="Select the type of letter to print a test output of"
D ^DIR K DIR
Q:$D(DIRUT)
S EATYP=+Y
S EASIEN=-1
S ZTSAVE("EASIEN")="",ZTSAVE("EATYP")=""
D EN^XUTMDEVQ("ZTEST^EASMTUTL","EAS MT TEST LETTER",.ZTSAVE)
Q
;
TESTIT ;
D LETTER^EASMTL6A(EASIEN,EATYP)
Q
;
ZTEST ;
D LETTER^EASMTL6A(EASIEN,EATYP)
Q
ADDLEAP(DATE) ; Adding a year with Leap Year checking
; Input:
; DATE - Date passed in.
;
; Output:
; Date passed in plus one year (with leap year ck/adj).
;
N YEAR
S YEAR=$E($$FMTHL7^XLFDT(DATE),1,4)
I $E(DATE,4,7)="0229",'$$LEAP^XLFDT3(YEAR+1) D
.S DATE=$$FMADD^XLFDT(DATE,-1)
Q $E(DATE,1,3)+1_$E(DATE,4,7)
;
SUBLEAP(DATE) ; Subtracting a year with Leap Year checking
; Input:
; DATE - Date passed in.
;
; Output:
; Date passed in minus one year (with leap year ck/adj).
;
N YEAR
S YEAR=$E($$FMTHL7^XLFDT(DATE),1,4)
I $E(DATE,4,7)="0229",'$$LEAP^XLFDT3(YEAR-1) D
.S DATE=$$FMADD^XLFDT(DATE,-1)
Q $E(DATE,1,3)-1_$E(DATE,4,7)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASMTUTL 8153 printed Oct 16, 2024@17:56:22 Page 2
EASMTUTL ; ALB/SCK/BRM/PHH - AUTOMATED MEANS TEST LETTERS UTILITIES ; 7/2/01
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,14,15,29,22,54**;MAR 15,2001
+2 ;
+3 ;
PAUSE ; Screen pause, user must press key to continue
+1 SET DIR(0)="FAO"
SET DIR("A")="Press any key to continue..."
+2 DO ^DIR
KILL DIR
+3 QUIT
+4 ;
CLRFLG(EAX,DA) ; Clears flags in File #713.2, For development
+1 NEW DIE,DR
+2 ;
+3 if EAX=1
QUIT
+4 if EAX=2
SET DR="9///0"
+5 if EAX=3
SET DR="9///0;12///0"
+6 if EAX=4
SET DR="9///0;12///0"
+7 if EAX=0
SET DR="9///0;12///0;18///0"
+8 SET DIE="^EAS(713.2,"
+9 DO ^DIE
KILL DIE
+10 QUIT
+11 ;
LOCK(ACTION) ; Flag IN USE field in EAS Parameters file, #713
+1 ; Input
+2 ; ACTION - Locking action
+3 ; 1 = Flag IN USE for Automated Generator is running
+4 ; 0 = Flag IN USE for Automated Generator is not running
+5 ; Output
+6 ; 1 if action was successful
+7 ; 0 if action was not successful
+8 NEW RSLT
+9 ;
+10 IF ACTION
IF $DATA(^EAS(713,"ALOCK",1))
QUIT $GET(RSLT)
+11 ;
+12 SET DIE="^EAS(713,"
SET DA=1
SET DR="30////^S X=ACTION"
+13 DO ^DIE
KILL DIE
+14 SET RSLT=1
+15 QUIT +$GET(RSLT)
+16 ;
ALERT(ERRMSG) ; Post an alert message to the EAS Letters Mail group
+1 NEW XMY,XMTEXT,XMDUZ,XMSUB,MSG
+2 ;
+3 SET MSG(1)="Notification:"
+4 SET MSG(2)=ERRMSG
+5 ;
+6 SET XMY("G.EAS MTLETTERS")=""
+7 SET XMTEXT="MSG("
+8 SET XMDUZ="EAS Auto MT Letters"
+9 SET XMSUB="EAS Means Test Letter's Notice"
+10 DO ^XMD
+11 QUIT
+12 ;
ADRERR(EASADD,DFN) ; Error notification for missing or invalid patient address
+1 NEW MSG,XMY,XMTEXT,XMDUZ,XMSUB,VAROOT,EASDEM,VA,EASPRF
+2 ;
+3 SET VAROOT="EASDEM"
+4 DO DEM^VADPT
+5 DO PID^VADPT6
+6 SET EASPRF=$$GET1^DIQ(2,DFN,27.02)
+7 IF EASPRF']""
SET EASPRF="No Preferred Facility"
+8 ;
+9 SET MSG(1)="The following patient does not have a complete permanent mailing"
+10 SET MSG(2)="address. A means test reminder letter could not be mailed."
+11 SET MSG(3)=" "
+12 SET MSG(4)=" Patient : "_EASDEM(1)
+13 SET MSG(5)=" Last 4 : "_VA("BID")
+14 SET MSG(6)="Address Line 1 : "_EASADD(1)
+15 SET MSG(7)=" City : "_EASADD(4)
+16 SET MSG(8)=" State : "_$PIECE(EASADD(5),U,2)
+17 SET MSG(9)=" Zipcode : "_$PIECE(EASADD(11),U,2)
+18 SET MSG(9.5)=" Bad Addr : "_$PIECE(EASADD("BAI"),U,2)
+19 SET MSG(10)=""
+20 SET MSG(11)=" DFN : "_$GET(DFN)
+21 SET MSG(13)=""
+22 SET MSG(14)="This patient's letter entry will stay in 'FLAGGED-TO-PRINT' status until"
+23 SET MSG(15)="the address is corrected."
+24 ;
+25 IF +EASADD(9)>0!(+EASADD(10)>0)
Begin DoDot:1
+26 SET MSG(5.5)="** Temporary Address in effect **"
End DoDot:1
+27 SET XMY("G.EAS MTLETTERS")=""
+28 SET XMTEXT="MSG("
+29 SET XMDUZ="EAS Auto MT Letters"
+30 SET XMSUB="Incomplete/Bad Addr: "_EASPRF
+31 DO ^XMD
+32 QUIT
+33 ;
CLRLCK ; Clears IN USE field of the EAS MT PARAMETERS if an error occurs and locks the field
+1 NEW DIE,DR,DA
+2 ;
+3 SET DA=1
SET DIE="^EAS(713,"
SET DR="30///0"
+4 DO ^DIE
+5 QUIT
+6 ;
PROHBIT ; Set or delete the Prohibit fields in the Patient Status file, #713.1
+1 NEW DIR,DIRUT,EASF,Y,X,EASIEN,DFN,DGFDA,FDAIEN,ERRMSG
+2 ;
+3 SET DIR(0)="S^S:Set Prohibit Flag;R:Remove Prohibit Flag"
+4 SET DIR("A")="Set or remove the MT Prohibit flag"
+5 SET DIR("?")="Select 'S' to set flag, 'R' to remove the flag"
+6 DO ^DIR
KILL DIR
+7 if $DATA(DIRUT)
QUIT
+8 SET EASF=Y
+9 ;
+10 IF EASF="R"!(EASF="r")
Begin DoDot:1
+11 SET DIR(0)="PAO^713.1:EMZ"
+12 SET DIR("A")="Select Patient: "
+13 DO ^DIR
KILL DIR
+14 SET EASIEN=+Y
End DoDot:1
if $DATA(DIRUT)
QUIT
+15 ;
+16 IF EASF="S"!(EASF="s")
Begin DoDot:1
+17 SET DIR(0)="PAO^2:EMZ"
+18 SET DIR("A")="Select Patient: "
+19 DO ^DIR
KILL DIR
+20 if $DATA(DIRUT)
QUIT
+21 SET DFN=+Y
+22 IF '$DATA(^EAS(713.1,"B",DFN))
Begin DoDot:2
+23 SET DIR(0)="Y"
SET DIR("B")="YES"
+24 SET DIR("A")="Add patient to the Patient Status File"
+25 DO ^DIR
KILL DIR
+26 if $DATA(DIRUT)
QUIT
+27 IF 'Y
SET DIRUT=1
QUIT
+28 SET DGFDA(1,713.1,"+1,",.01)=DFN
+29 DO UPDATE^DIE("","DGFDA(1)","FDAIEN","ERRMSG")
+30 SET EASIEN=FDAIEN(1)
End DoDot:2
if $DATA(DIRUT)
QUIT
+31 IF $DATA(^EAS(713.1,"B",DFN))
SET EASIEN=$ORDER(^EAS(713.1,"B",DFN,0))
End DoDot:1
if $DATA(DIRUT)
QUIT
+32 ;
+33 if '$GET(EASIEN)
QUIT
+34 ;
+35 NEW DGFDA,DGIEN,DGEFF,DIR,DIRUT,DGERR,DIE
+36 ;
+37 SET DGIEN=EASIEN_","
+38 IF EASF="S"
Begin DoDot:1
+39 SET DIR(0)="DAO^"_$$DT^XLFDT_"::EX"
+40 SET DIR("A")="Effective Date: "
+41 DO ^DIR
KILL DIR
+42 if $GET(DIRUT)
QUIT
+43 SET DGFDA(1,713.1,DGIEN,3)=Y
+44 SET DGFDA(1,713.1,DGIEN,2)=1
+45 SET DGFDA(1,713.1,DGIEN,5)=$$NOW^XLFDT
+46 SET DGFDA(1,713.1,DGIEN,4)=DUZ
+47 if $DATA(DGFDA)
DO FILE^DIE("","DGFDA(1)","DGERR")
+48 IF $DATA(DGERR)
Begin DoDot:2
+49 DO DSPLYER(.DGERR)
End DoDot:2
QUIT
+50 SET DIE="^EAS(713.1,"
SET DA=EASIEN
SET DR="10"
+51 DO ^DIE
KILL DIE
End DoDot:1
+52 ;
+53 IF EASF="R"
Begin DoDot:1
+54 SET DGFDA(1,713.1,DGIEN,2)=0
+55 SET DGFDA(1,713.1,DGIEN,3)="@"
+56 SET DGFDA(1,713.1,DGIEN,5)="@"
+57 SET DGFDA(1,713.1,DGIEN,4)="@"
+58 SET DGFDA(1,713.1,DGIEN,10)="@"
+59 if $DATA(DGFDA)
DO FILE^DIE("","DGFDA(1)","DGERR")
+60 IF $DATA(DGERR)
Begin DoDot:2
+61 DO DSPLYER(.DGERR)
End DoDot:2
+62 IF '$TEST
WRITE !!?3,"Prohibit Flag Removed from Patient.",!
End DoDot:1
+63 ;
+64 QUIT
+65 ;
DSPLYER(ERRARY) ;
+1 NEW DGER
+2 ;
+3 WRITE !!?3,"The following error(s) occurred:"
+4 SET DGER=0
+5 FOR
SET DGER=$ORDER(ERRARY("DIERR",DGER))
if 'DGER
QUIT
Begin DoDot:1
+6 WRITE !?3,ERRARY("DIERR",DGER)," - ",ERRARY("DIERR",DGER,"TEXT",1)
End DoDot:1
+7 WRITE !?3,"Please check, this record update may not have processed completely."
+8 QUIT
+9 ;
EDTLTRS ;
+1 NEW DIR,EASIEN
+2 ;
+3 SET DIR(0)="P^713.3:EMZ"
+4 SET DIR("A")="Select Letter"
+5 DO ^DIR
KILL DIR
+6 if $DATA(DIRUT)
QUIT
+7 SET EASIEN=+Y
+8 ;
+9 SET DIE="^EAS(713.3,"
SET DA=EASIEN
SET DR="4"
+10 DO ^DIE
+11 QUIT
+12 ;
MTRTN ; Update the letter status file, #713.2, with returned Means Test information
+1 NEW DIE,DIC,EASIEN,DR,DA,Y
+2 ;
+3 SET DIC="^EAS(713.2,"
SET DIC(0)="AEQM"
SET DIC("A")="Select the Letter Status entry to update: "
+4 DO ^DIC
KILL DIC
+5 if Y<0
QUIT
+6 SET EASIEN=+Y
+7 ;
+8 SET DIE="^EAS(713.2,"
SET DA=EASIEN
+9 SET DR="4;I X=0 S Y=0;5;7;6////^S X=DUZ;9///0;12///0;18///0"
+10 LOCK +^EAS(713.2,EASIEN):0
IF $TEST
Begin DoDot:1
+11 DO ^DIE
KILL DIE
End DoDot:1
+12 IF '$TEST
WRITE !,$CHAR(7),"Entry is being edited by another user."
+13 LOCK -^EAS(713.2,EASIEN)
+14 ;
+15 QUIT
+16 ;
DECEASED(EASIEN,DFN) ; Check deceased status for patient
+1 NEW RSLT,EADEM,EAS1,VAROOT
+2 ;
+3 SET EASIEN=$GET(EASIEN)
+4 SET DFN=$GET(DFN)
+5 IF EASIEN>0
Begin DoDot:1
+6 SET EAS1=$$GET1^DIQ(713.2,EASIEN,2,"I")
+7 SET DFN=$$GET1^DIQ(713.1,EAS1,.01,"I")
End DoDot:1
+8 if 'DFN
QUIT 0
+9 SET RSLT=0
+10 ;
+11 SET VAROOT="EADEM"
+12 DO DEM^VADPT
+13 if +EADEM(6)
SET RSLT=1
+14 DO KVA^VADPT
+15 QUIT RSLT
+16 ;
CHECKMT(EASPT,EAIEN) ; Check current MT status
+1 NEW DFN,RTN,EACHK,DIE,DR,DA
+2 ;
+3 SET RTN=0
+4 ; Safety check
IF '$GET(EASPT)
SET RTN=1
GOTO CHKQ
+5 ; Get DFN
SET DFN=$$GET1^DIQ(713.1,EASPT,.01,"I")
+6 ; Safety check
IF '$GET(DFN)
SET RTN=1
GOTO CHKQ
+7 ;
+8 ; Check current MT to see if it's changed
SET EACHK=$$MTCHK^EASMTCHK(DFN,"L")
+9 ; If MT no longer required, update letter status file
IF 'EACHK
Begin DoDot:1
+10 SET DIE="^EAS(713.2,"
SET DA=EAIEN
+11 SET DR="4///YES;5///TODAY;7///AUTO-GENERATED;9///NO;12///NO;18///NO"
+12 ;; Remove before release
DO ^DIE
KILL DIE
+13 SET RTN=1
End DoDot:1
+14 ;
CHKQ QUIT RTN
+1 ;
FUTMT(EASIEN) ; Check for a future MT
+1 ; Input
+2 ; EASIEN - IEN for record in Letter Status file
+3 ;
+4 ; Output
+5 ; 1 - Future MT exist's (API call)
+6 ; 0 - Future MT does not exist
+7 ;
+8 NEW EASPTR,DFN,EASFUT
+9 ;
+10 SET RTN=0
+11 SET EASPTR=$$GET1^DIQ(713.2,EASIEN,2,"I")
+12 SET DFN=$$GET1^DIQ(713.1,EASPTR,.01,"I")
+13 ;
+14 ;; Call API for future MT check
+15 SET EASFUT=$$FUT^DGMTU(DFN)
+16 ;
+17 ; Turn off letters if future MT present
IF +$GET(EASFUT)
Begin DoDot:1
+18 if 'EASIEN
QUIT
+19 SET DIE="^EAS(713.2,"
SET DA=EASIEN
+20 SET DR="4///YES;5///TODAY;7///FUTURE MEANS TEST;9///NO;12///NO;18///NO"
+21 DO ^DIE
KILL DIE
+22 SET RTN=1
End DoDot:1
+23 QUIT RTN
+24 ;
TESTLTR ;
+1 NEW EASIEN,EATYP,DIR,DIRUT,ZTSAVE
+2 ;
+3 SET DIR(0)="SO^1:60-Day;2:30-Day;4:0-Day"
+4 SET DIR("A")="Select letter type to test"
+5 SET DIR("?")="Select the type of letter to print a test output of"
+6 DO ^DIR
KILL DIR
+7 if $DATA(DIRUT)
QUIT
+8 SET EATYP=+Y
+9 SET EASIEN=-1
+10 SET ZTSAVE("EASIEN")=""
SET ZTSAVE("EATYP")=""
+11 DO EN^XUTMDEVQ("ZTEST^EASMTUTL","EAS MT TEST LETTER",.ZTSAVE)
+12 QUIT
+13 ;
TESTIT ;
+1 DO LETTER^EASMTL6A(EASIEN,EATYP)
+2 QUIT
+3 ;
ZTEST ;
+1 DO LETTER^EASMTL6A(EASIEN,EATYP)
+2 QUIT
ADDLEAP(DATE) ; Adding a year with Leap Year checking
+1 ; Input:
+2 ; DATE - Date passed in.
+3 ;
+4 ; Output:
+5 ; Date passed in plus one year (with leap year ck/adj).
+6 ;
+7 NEW YEAR
+8 SET YEAR=$EXTRACT($$FMTHL7^XLFDT(DATE),1,4)
+9 IF $EXTRACT(DATE,4,7)="0229"
IF '$$LEAP^XLFDT3(YEAR+1)
Begin DoDot:1
+10 SET DATE=$$FMADD^XLFDT(DATE,-1)
End DoDot:1
+11 QUIT $EXTRACT(DATE,1,3)+1_$EXTRACT(DATE,4,7)
+12 ;
SUBLEAP(DATE) ; Subtracting a year with Leap Year checking
+1 ; Input:
+2 ; DATE - Date passed in.
+3 ;
+4 ; Output:
+5 ; Date passed in minus one year (with leap year ck/adj).
+6 ;
+7 NEW YEAR
+8 SET YEAR=$EXTRACT($$FMTHL7^XLFDT(DATE),1,4)
+9 IF $EXTRACT(DATE,4,7)="0229"
IF '$$LEAP^XLFDT3(YEAR-1)
Begin DoDot:1
+10 SET DATE=$$FMADD^XLFDT(DATE,-1)
End DoDot:1
+11 QUIT $EXTRACT(DATE,1,3)-1_$EXTRACT(DATE,4,7)
