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

EASMTUTL.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;
  1. PAUSE ;  Screen pause, user must press key to continue
  1.  S DIR(0)="FAO",DIR("A")="Press any key to continue..."
  1.  D ^DIR K DIR
  1.  Q
  1.  ;
  1. CLRFLG(EAX,DA) ; Clears flags in File #713.2, For development
  1.  N DIE,DR
  1.  ;
  1.  Q:EAX=1
  1.  S:EAX=2 DR="9///0"
  1.  S:EAX=3 DR="9///0;12///0"
  1.  S:EAX=4 DR="9///0;12///0"
  1.  S:EAX=0 DR="9///0;12///0;18///0"
  1.  S DIE="^EAS(713.2,"
  1.  D ^DIE K DIE
  1.  Q
  1.  ;
  1. LOCK(ACTION) ; Flag IN USE field in EAS Parameters file, #713
  1.  ; Input
  1.  ;   ACTION - Locking action
  1.  ;            1 = Flag IN USE for Automated Generator is running
  1.  ;            0 = Flag IN USE for Automated Generator is not running
  1.  ; Output
  1.  ;        1 if action was successful
  1.  ;        0 if action was not successful
  1.  N RSLT
  1.  ;
  1.  I ACTION,$D(^EAS(713,"ALOCK",1)) Q $G(RSLT)
  1.  ;
  1.  S DIE="^EAS(713,",DA=1,DR="30////^S X=ACTION"
  1.  D ^DIE K DIE
  1.  S RSLT=1
  1.  Q +$G(RSLT)
  1.  ;
  1. ALERT(ERRMSG) ; Post an alert message to the EAS Letters Mail group
  1.  N XMY,XMTEXT,XMDUZ,XMSUB,MSG
  1.  ;
  1.  S MSG(1)="Notification:"
  1.  S MSG(2)=ERRMSG
  1.  ;
  1.  S XMY("G.EAS MTLETTERS")=""
  1.  S XMTEXT="MSG("
  1.  S XMDUZ="EAS Auto MT Letters"
  1.  S XMSUB="EAS Means Test Letter's Notice"
  1.  D ^XMD
  1.  Q
  1.  ;
  1. ADRERR(EASADD,DFN) ; Error notification for missing or invalid patient address
  1.  N MSG,XMY,XMTEXT,XMDUZ,XMSUB,VAROOT,EASDEM,VA,EASPRF
  1.  ;
  1.  S VAROOT="EASDEM"
  1.  D DEM^VADPT
  1.  D PID^VADPT6
  1.  S EASPRF=$$GET1^DIQ(2,DFN,27.02)
  1.  I EASPRF']"" S EASPRF="No Preferred Facility"
  1.  ;
  1.  S MSG(1)="The following patient does not have a complete permanent mailing"
  1.  S MSG(2)="address.  A means test reminder letter could not be mailed."
  1.  S MSG(3)=" "
  1.  S MSG(4)="       Patient : "_EASDEM(1)
  1.  S MSG(5)="        Last 4 : "_VA("BID")
  1.  S MSG(6)="Address Line 1 : "_EASADD(1)
  1.  S MSG(7)="          City : "_EASADD(4)
  1.  S MSG(8)="         State : "_$P(EASADD(5),U,2)
  1.  S MSG(9)="       Zipcode : "_$P(EASADD(11),U,2)
  1.  S MSG(9.5)="      Bad Addr : "_$P(EASADD("BAI"),U,2)
  1.  S MSG(10)=""
  1.  S MSG(11)="           DFN : "_$G(DFN)
  1.  S MSG(13)=""
  1.  S MSG(14)="This patient's letter entry will stay in 'FLAGGED-TO-PRINT' status until"
  1.  S MSG(15)="the address is corrected."
  1.  ;
  1.  I +EASADD(9)>0!(+EASADD(10)>0) D
  1.  . S MSG(5.5)="** Temporary Address in effect **"
  1.  S XMY("G.EAS MTLETTERS")=""
  1.  S XMTEXT="MSG("
  1.  S XMDUZ="EAS Auto MT Letters"
  1.  S XMSUB="Incomplete/Bad Addr: "_EASPRF
  1.  D ^XMD
  1.  Q
  1.  ;
  1. CLRLCK ;  Clears IN USE field of the EAS MT PARAMETERS if an error occurs and locks the field
  1.  N DIE,DR,DA
  1.  ;
  1.  S DA=1,DIE="^EAS(713,",DR="30///0"
  1.  D ^DIE
  1.  Q
  1.  ;
  1. PROHBIT ; Set or delete the Prohibit fields in the Patient Status file, #713.1
  1.  N DIR,DIRUT,EASF,Y,X,EASIEN,DFN,DGFDA,FDAIEN,ERRMSG
  1.  ;
  1.  S DIR(0)="S^S:Set Prohibit Flag;R:Remove Prohibit Flag"
  1.  S DIR("A")="Set or remove the MT Prohibit flag"
  1.  S DIR("?")="Select 'S' to set flag, 'R' to remove the flag"
  1.  D ^DIR K DIR
  1.  Q:$D(DIRUT)
  1.  S EASF=Y
  1.  ;
  1.  I EASF="R"!(EASF="r") D  Q:$D(DIRUT) 
  1.  . S DIR(0)="PAO^713.1:EMZ"
  1.  . S DIR("A")="Select Patient: "
  1.  . D ^DIR K DIR
  1.  . S EASIEN=+Y
  1.  ;
  1.  I EASF="S"!(EASF="s") D  Q:$D(DIRUT)
  1.  . S DIR(0)="PAO^2:EMZ"
  1.  . S DIR("A")="Select Patient: "
  1.  . D ^DIR K DIR
  1.  . Q:$D(DIRUT)
  1.  . S DFN=+Y
  1.  . I '$D(^EAS(713.1,"B",DFN)) D  Q:$D(DIRUT)
  1.  . . S DIR(0)="Y",DIR("B")="YES"
  1.  . . S DIR("A")="Add patient to the Patient Status File"
  1.  . . D ^DIR K DIR
  1.  . . Q:$D(DIRUT)
  1.  . . I 'Y S DIRUT=1 Q
  1.  . . S DGFDA(1,713.1,"+1,",.01)=DFN
  1.  . . D UPDATE^DIE("","DGFDA(1)","FDAIEN","ERRMSG")
  1.  . . S EASIEN=FDAIEN(1)
  1.  . I $D(^EAS(713.1,"B",DFN)) S EASIEN=$O(^EAS(713.1,"B",DFN,0))
  1.  ;
  1.  Q:'$G(EASIEN)
  1.  ;
  1.  N DGFDA,DGIEN,DGEFF,DIR,DIRUT,DGERR,DIE
  1.  ;
  1.  S DGIEN=EASIEN_","
  1.  I EASF="S" D
  1.  . S DIR(0)="DAO^"_$$DT^XLFDT_"::EX"
  1.  . S DIR("A")="Effective Date: "
  1.  . D ^DIR K DIR
  1.  . Q:$G(DIRUT)
  1.  . S DGFDA(1,713.1,DGIEN,3)=Y
  1.  . S DGFDA(1,713.1,DGIEN,2)=1
  1.  . S DGFDA(1,713.1,DGIEN,5)=$$NOW^XLFDT
  1.  . S DGFDA(1,713.1,DGIEN,4)=DUZ
  1.  . D:$D(DGFDA) FILE^DIE("","DGFDA(1)","DGERR")
  1.  . I $D(DGERR) D  Q
  1.  . . D DSPLYER(.DGERR)
  1.  . S DIE="^EAS(713.1,",DA=EASIEN,DR="10"
  1.  . D ^DIE K DIE
  1.  ;
  1.  I EASF="R" D
  1.  . S DGFDA(1,713.1,DGIEN,2)=0
  1.  . S DGFDA(1,713.1,DGIEN,3)="@"
  1.  . S DGFDA(1,713.1,DGIEN,5)="@"
  1.  . S DGFDA(1,713.1,DGIEN,4)="@"
  1.  . S DGFDA(1,713.1,DGIEN,10)="@"
  1.  . D:$D(DGFDA) FILE^DIE("","DGFDA(1)","DGERR")
  1.  . I $D(DGERR) D
  1.  . . D DSPLYER(.DGERR)
  1.  . E  W !!?3,"Prohibit Flag Removed from Patient.",!
  1.  ;
  1.  Q
  1.  ;
  1. DSPLYER(ERRARY) ;
  1.  N DGER
  1.  ;
  1.  W !!?3,"The following error(s) occurred:"
  1.  S DGER=0
  1.  F  S DGER=$O(ERRARY("DIERR",DGER)) Q:'DGER  D
  1.  . W !?3,ERRARY("DIERR",DGER)," - ",ERRARY("DIERR",DGER,"TEXT",1)
  1.  W !?3,"Please check, this record update may not have processed completely."
  1.  Q
  1.  ;
  1. EDTLTRS ;
  1.  N DIR,EASIEN
  1.  ;
  1.  S DIR(0)="P^713.3:EMZ"
  1.  S DIR("A")="Select Letter"
  1.  D ^DIR K DIR
  1.  Q:$D(DIRUT)
  1.  S EASIEN=+Y
  1.  ;
  1.  S DIE="^EAS(713.3,",DA=EASIEN,DR="4"
  1.  D ^DIE
  1.  Q
  1.  ;
  1. MTRTN ; Update the letter status file, #713.2, with returned Means Test information
  1.  N DIE,DIC,EASIEN,DR,DA,Y
  1.  ;
  1.  S DIC="^EAS(713.2,",DIC(0)="AEQM",DIC("A")="Select the Letter Status entry to update: "
  1.  D ^DIC K DIC
  1.  Q:Y<0
  1.  S EASIEN=+Y
  1.  ;
  1.  S DIE="^EAS(713.2,",DA=EASIEN
  1.  S DR="4;I X=0 S Y=0;5;7;6////^S X=DUZ;9///0;12///0;18///0"
  1.  L +^EAS(713.2,EASIEN):0 I $T D 
  1.  . D ^DIE K DIE
  1.  E  W !,$CHAR(7),"Entry is being edited by another user."
  1.  L -^EAS(713.2,EASIEN)
  1.  ;
  1.  Q
  1.  ;
  1. DECEASED(EASIEN,DFN) ;  Check deceased status for patient
  1.  N RSLT,EADEM,EAS1,VAROOT
  1.  ;
  1.  S EASIEN=$G(EASIEN)
  1.  S DFN=$G(DFN)
  1.  I EASIEN>0 D
  1.  . S EAS1=$$GET1^DIQ(713.2,EASIEN,2,"I")
  1.  . S DFN=$$GET1^DIQ(713.1,EAS1,.01,"I")
  1.  Q:'DFN 0
  1.  S RSLT=0
  1.  ;
  1.  S VAROOT="EADEM"
  1.  D DEM^VADPT
  1.  S:+EADEM(6) RSLT=1
  1.  D KVA^VADPT
  1.  Q RSLT
  1.  ;
  1. CHECKMT(EASPT,EAIEN) ; Check current MT status
  1.  N DFN,RTN,EACHK,DIE,DR,DA
  1.  ;
  1.  S RTN=0
  1.  I '$G(EASPT) S RTN=1 G CHKQ ; Safety check
  1.  S DFN=$$GET1^DIQ(713.1,EASPT,.01,"I") ; Get DFN
  1.  I '$G(DFN) S RTN=1 G CHKQ ; Safety check
  1.  ;
  1.  S EACHK=$$MTCHK^EASMTCHK(DFN,"L") ; Check current MT to see if it's changed
  1.  I 'EACHK D  ; If MT no longer required, update letter status file
  1.  . S DIE="^EAS(713.2,",DA=EAIEN
  1.  . S DR="4///YES;5///TODAY;7///AUTO-GENERATED;9///NO;12///NO;18///NO"
  1.  . D ^DIE K DIE ;; Remove before release
  1.  . S RTN=1
  1.  ;
  1. CHKQ Q RTN
  1.  ;
  1. FUTMT(EASIEN) ; Check for a future MT
  1.  ;  Input
  1.  ;    EASIEN - IEN for record in Letter Status file
  1.  ;
  1.  ;  Output
  1.  ;     1 - Future MT exist's (API call)
  1.  ;     0 - Future MT does not exist
  1.  ;
  1.  N EASPTR,DFN,EASFUT
  1.  ;
  1.  S RTN=0
  1.  S EASPTR=$$GET1^DIQ(713.2,EASIEN,2,"I")
  1.  S DFN=$$GET1^DIQ(713.1,EASPTR,.01,"I")
  1.  ;
  1.  ;; Call API for future MT check
  1.  S EASFUT=$$FUT^DGMTU(DFN)
  1.  ;
  1.  I +$G(EASFUT) D  ; Turn off letters if future MT present
  1.  . Q:'EASIEN
  1.  . S DIE="^EAS(713.2,",DA=EASIEN
  1.  . S DR="4///YES;5///TODAY;7///FUTURE MEANS TEST;9///NO;12///NO;18///NO"
  1.  . D ^DIE K DIE
  1.  . S RTN=1
  1.  Q RTN
  1.  ;
  1. TESTLTR ;
  1.  N EASIEN,EATYP,DIR,DIRUT,ZTSAVE
  1.  ;
  1.  S DIR(0)="SO^1:60-Day;2:30-Day;4:0-Day"
  1.  S DIR("A")="Select letter type to test"
  1.  S DIR("?")="Select the type of letter to print a test output of"
  1.  D ^DIR K DIR
  1.  Q:$D(DIRUT)
  1.  S EATYP=+Y
  1.  S EASIEN=-1
  1.  S ZTSAVE("EASIEN")="",ZTSAVE("EATYP")=""
  1.  D EN^XUTMDEVQ("ZTEST^EASMTUTL","EAS MT TEST LETTER",.ZTSAVE)
  1.  Q
  1.  ;
  1. TESTIT ;
  1.  D LETTER^EASMTL6A(EASIEN,EATYP)
  1.  Q
  1.  ;
  1. ZTEST ;
  1.  D LETTER^EASMTL6A(EASIEN,EATYP)
  1.  Q
  1. ADDLEAP(DATE) ; Adding a year with Leap Year checking
  1.  ; Input:
  1.  ;       DATE   -  Date passed in.
  1.  ;
  1.  ; Output:
  1.  ;       Date passed in plus one year (with leap year ck/adj).
  1.  ;
  1.  N YEAR
  1.  S YEAR=$E($$FMTHL7^XLFDT(DATE),1,4)
  1.  I $E(DATE,4,7)="0229",'$$LEAP^XLFDT3(YEAR+1) D
  1.  .S DATE=$$FMADD^XLFDT(DATE,-1)
  1.  Q $E(DATE,1,3)+1_$E(DATE,4,7)
  1.  ;
  1. SUBLEAP(DATE) ; Subtracting a year with Leap Year checking
  1.  ; Input:
  1.  ;       DATE   -  Date passed in.
  1.  ;
  1.  ; Output:
  1.  ;       Date passed in minus one year (with leap year ck/adj).
  1.  ;
  1.  N YEAR
  1.  S YEAR=$E($$FMTHL7^XLFDT(DATE),1,4)
  1.  I $E(DATE,4,7)="0229",'$$LEAP^XLFDT3(YEAR-1) D
  1.  .S DATE=$$FMADD^XLFDT(DATE,-1)
  1.  Q $E(DATE,1,3)-1_$E(DATE,4,7)