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

EASMTL2.m

Go to the documentation of this file. 
  1. EASMTL2 ;MIN/TCM ALB/SCK/AEG - AUTOMATED MEANS TEST LETTER - SEARCH ; 7/3/01
  1.  ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,12,14,20,22,55**;MAR 15,2001
  1.  ;
  1. EN60 ; Entry point for inital 60-day letter search for candidates 
  1.  N EASIEN,DFN,VADM,CNT,ANNVDT,EASLAST
  1.  ;
  1.  K ^TMP("EASERR",$J)
  1.  S CNT=0 ; Initialize counter
  1.  S ANNVDT=EASDT("ANV")
  1.  ; Check for means test data to process, quit if none found
  1.  Q:'$D(^DGMT(408.31,"B",ANNVDT))
  1.  ;
  1.  ; Retieve data for each Means Test entry being processed
  1.  S EASIEN=0
  1.  F  S EASIEN=$O(^DGMT(408.31,"B",ANNVDT,EASIEN)) Q:EASIEN'>0  D
  1.  . ; Quit further processing if means test is not MEANS TEST type
  1.  . Q:'$$GET1^DIQ(408.31,EASIEN,.019,"I")=1
  1.  . S DFN=$$GET1^DIQ(408.31,EASIEN,.02,"I") ; get patient's DFN
  1.  . ; Check conditions; if all passed, add new entry to worklist file, #713.2
  1.  . Q:'DFN                         ; Safety check for DFN
  1.  . Q:'$$CHKDFN(DFN,EASIEN)          ; Check for valid PATIENT File entry, **55**
  1.  . Q:$$TEST(DFN)                  ; Quit if test patient
  1.  . S EASLAST=$$LST^DGMTU(DFN)     ; Get last MT on file
  1.  . Q:'(+EASLAST=EASIEN)  ; Not the latest MT record for patient
  1.  . Q:"L,N"[$P(EASLAST,U,4)        ; Quit, patient no longer requires means test (No Longer Applicable or No Longer Required)
  1.  . Q:$$DECEASED^EASMTUTL("",DFN)  ; Quit if patient deceased
  1.  . ;  If passed through all condition checks, update files
  1.  . Q:$$CHKSTAT(EASIEN,DFN)         ; Check current MT status
  1.  . Q:$$FUTURE(DFN)  ; Quit if a future means test is on file
  1.  . D NEWSTAT(DFN,.EASPT)
  1.  . Q:EASPT'>0  ; Safety check
  1.  . Q:'$$NEWLTR(EASPT,.EASDT)  ; Quit if letter status was not updated
  1.  . ; Finally, Update the counters
  1.  . S CNT=CNT+1
  1.  S EAS6CNT(EASPRCDT)=CNT,EAS6CNT=EAS6CNT+CNT
  1.  D ERRMSG
  1.  K ^TMP("EASERR",$J),^TMP("EASBDPTR",$J)
  1.  Q
  1.  ;
  1. NEWLTR(EASPT,EASDT) ; Add new entry to the work list file #713.2.
  1.  ; Input
  1.  ;   EASPT  - Ptr to 713.1 file
  1.  ;   EASDT  - Worklist date array
  1.  ;
  1.  ; Output
  1.  ;   RSLT   - 1 if new letter status entry added
  1.  ;            0 if new letter status was not added
  1.  ;
  1.  N ANNVDT,FDA,RSLT
  1.  ;
  1.  S ANNVDT=EASDT("ANV")
  1.  ;
  1.  ; Check for an existing entry for patient and anniversary date
  1.  I $D(^EAS(713.2,"AN",EASPT,ANNVDT)) Q 0 ; Quit if duplicate entry
  1.  ;
  1.  ; Add new entry to the letter status file, #713.2
  1.  S FDA(1,713.2,"+1,",.01)=EADT
  1.  S FDA(1,713.2,"+1,",2)=EASPT
  1.  S FDA(1,713.2,"+1,",3)=ANNVDT
  1.  S FDA(1,713.2,"+1,",4)=0
  1.  S FDA(1,713.2,"+1,",8)=EASDT("60")
  1.  S FDA(1,713.2,"+1,",11)=EASDT("30")
  1.  S FDA(1,713.2,"+1,",17)=EASDT("0")
  1.  S FDA(1,713.2,"+1,",9)=1
  1.  ; Modification for DCD sites which are required to print only the 0-day letters
  1.  ;; EAS*1*12
  1.  I $$VERSION^XPDUTL("IVMC"),$G(DT)'>3021014 D
  1.  . K FDA(1,713.2,"+1,",9)
  1.  . S FDA(1,713.2,"+1,",18)=1
  1.  ; ***
  1.  D UPDATE^DIE("","FDA(1)","","ERRMSG")
  1.  Q 1
  1.  ;
  1. UPDLTR(EAS1,TYPE) ; Update Flagged to print field for letter type
  1.  ; Input
  1.  ;   EAS1  - Ptr to file 713.2
  1.  ;   TYPE  - Letter type (1:60d, 2:30d, 4:0d)
  1.  ;
  1.  N DGFDA,ERRMSG
  1.  ;
  1.  S DGFDA(1,713.2,EAS1_",",$S(TYPE=2:12,1:18))=1
  1.  D UPDATE^DIE("","DGFDA(1)","","ERRMSG")
  1.  Q
  1.  ;
  1. NEWSTAT(DFN,EASPT) ; Update the Patient status file, #713.1
  1.  ; Input
  1.  ;   DFN   - Patient's DFN
  1.  ;   EASPT - Return Var, New IEN to 713.1 file
  1.  ;
  1.  N EASIEN,DGFDA,FDAIEN,ERROUT
  1.  ;
  1.  ; Create new entry in the patient status file
  1.  ;
  1.  I '$D(^EAS(713.1,"B",DFN)) D  Q
  1.  . S DGFDA(1,713.1,"+1,",.01)=DFN
  1.  . S DGFDA(1,713.1,"+1,",2)=0
  1.  . D UPDATE^DIE("","DGFDA(1)","FDAIEN","ERROUT(1)")
  1.  . I $D(ERROUT) D
  1.  . . S ^TMP("EASERR",$J,DFN)=ERROUT(1,"DIERR",1)_" - "_ERROUT(1,"DIERR",1,"TEXT",1)
  1.  . . S:+$G(FDAIEN(1))'>0 ^TMP("EASERR",$J,DFN)="Unable to generate entry in EAS MT PATIENT STATUS File, #713.1"
  1.  . S EASPT=+$G(FDAIEN(1))
  1.  ;
  1.  I $D(^EAS(713.1,"B",DFN)) D
  1.  . Q:'DFN
  1.  . S EASPT=$O(^EAS(713.1,"B",DFN,0))
  1.  Q
  1.  ;
  1. PRNTDT(EARY,ETYPE) ; Retrieve Print date and flagged to print status for letter type
  1.  ; Input
  1.  ;    EARY  - Data array from Patient Status file, #713.1, MT Anniversary date field, #11
  1.  ;    ETYPE - Search type, 30 or 0 day
  1.  ;
  1.  ; Output
  1.  ;    RSLT = Print date ^ Flagged to print status
  1.  ;           will be 0^0 if nothing found to return
  1.  ;
  1.  N RSLT
  1.  ;
  1.  S RSLT=$S(ETYPE=2:EARY(11,"I"),ETYPE=4:EARY(17,"I"),1:0)
  1.  S RSLT=RSLT_"^"_+$S(ETYPE=2:EARY(12,"I"),ETYPE=4:EARY(18,"I"),1:0)
  1.  Q RSLT
  1.  ;
  1. CHKSTAT(EASIEN,DFN) ; Check for means test status, still required or not
  1.  ; Input
  1.  ;    EASIEN  - Internal Entry Number to the ANNUAL MEANS TEST File, #408.31
  1.  ;
  1.  ; Output
  1.  ;    1 - if means test is no longer required or applicable
  1.  ;    0 - if means test is still required
  1.  ;
  1.  N RSLT,EASTAT
  1.  ;
  1.  ; If status = "NO LONGER REQUIRED" or "NO LONGER APPLICABLE" then set result to 1
  1.  ; The .03 field is a pointer to the MEANS TEST STATUS File, #408.32, checks
  1.  ; IEN=3 and IEN=10, NO LONGER REQUIRED and NO LONGER APPLICABLE entries respectively 
  1.  ; If the 408.32 file is changed, this code will need to be reviewed and updated if necessary.
  1.  ;
  1.  S RSLT=0,DFN=$G(DFN)
  1.  ;
  1.  S EASTAT=$$GET1^DIQ(408.31,EASIEN,.03,"I")
  1.  I (EASTAT=3)!(EASTAT=10) S RSLT=1
  1.  ;
  1.  ;; Check current MT Status from API (Looking for Cat-C, Agree to Pay Dedct, MT later than 10-5-99
  1.  I 'RSLT D
  1.  . S:'$$MTCHK^EASMTCHK(DFN,"L") RSLT=1
  1.  ;
  1.  Q $G(RSLT)
  1.  ;
  1. FUTURE(DFN) ; Future Means Test available?
  1.  N RSLT
  1.  ;
  1.  S RSLT=$$FUT^DGMTU(DFN)
  1.  Q $G(RSLT)
  1.  ;
  1. TEST(DFN) ; Test Patient?
  1.  N VAROOT,ZSSN,EASDEM
  1.  ;
  1.  S VAROOT="EASDEM"
  1.  D DEM^VADPT
  1.  S ZSSN=$P(EASDEM(2),U,1)
  1.  I $E(ZSSN,1,5)["00000" Q 1
  1.  ;
  1.  Q 0
  1.  ;
  1. CHKDFN(DFN,MTIEN) ; Checks for a valid zero node in the patient file entry.  
  1.  ; If no valid zero node, sets bad ptr entry
  1.  ;
  1.  N RSLT
  1.  ;
  1.  S DFN=$G(DFN),MTIEN=$G(MTIEN)
  1.  S RSLT=$D(^DPT(DFN,0))
  1.  I 'RSLT D
  1.  . S ^TMP("EASBDPTR",$J,DFN)=MTIEN
  1.  ;
  1.  Q $G(RSLT)
  1.  ;
  1. ERRMSG ; Send mail message if any errors were generated during processing
  1.  I $D(^TMP("EASERR",$J)) D ERRORS
  1.  I $D(^TMP("EASBDPTR",$J)) D BADPTR
  1.  Q
  1.  ;
  1. ERRORS ;
  1.  N EASDFN,EASERR,MSG,DFN,VA
  1.  ;
  1.  S MSG(.1)="The following issues were reported by the Means Test Letter Search Process:"
  1.  S MSG(.9)=""
  1.  ;
  1.  S EASDFN=0
  1.  F  S EASDFN=$O(^TMP("EASERR",$J,EASDFN)) Q:'EASDFN  D
  1.  . S DFN=EASDFN D PID^VADPT
  1.  . S MSG(EASDFN)=$$GET1^DIQ(2,EASDFN,.01)_" ("_VA("BID")_") "_$G(^TMP("EASERR",$J,EASDFN))
  1.  . K VA
  1.  ;
  1.  D SEND(.MSG)
  1.  Q
  1.  ;
  1. BADPTR ;
  1.  N EASDFN,EASERR,MSG,X
  1.  ;
  1.  S MSG(.1)="During the MT Letter Search, the following Annual Means Test "
  1.  S MSG(.2)="File entries (#408.31) were found which may point to a non-existent"
  1.  S MSG(.3)="Patient entry in the PATIENT File (#2):"
  1.  S MSG(.4)=""
  1.  S X=$$SETSTR^VALM1("PATIENT FILE (#2)","",5,20)
  1.  S X=$$SETSTR^VALM1("MT FILE (#408.31)",X,35,20)
  1.  S MSG(.5)=X
  1.  S X=$$SETSTR^VALM1("=================","",5,20)
  1.  S X=$$SETSTR^VALM1("=================",X,35,20)
  1.  S MSG(.6)=X
  1.  ;
  1.  S EASDFN=0
  1.  F  S EASDFN=$O(^TMP("EASBDPTR",$J,EASDFN)) Q:'EASDFN  D
  1.  . S X=$$SETSTR^VALM1(EASDFN,"",5,20)
  1.  . S X=$$SETSTR^VALM1($G(^TMP("EASBDPTR",$J,EASDFN)),X,35,20)
  1.  . S MSG(EASDFN)=X
  1.  ;
  1.  D SEND(.MSG)
  1.  Q
  1.  ;
  1. SEND(MSG) ;
  1.  S XMSUB="MT LETTERS SEARCH ISSUES - "_$$FMTE^XLFDT($$NOW^XLFDT,"D")
  1.  S XMTEXT="MSG("
  1.  S XMY("G.EAS MTLETTERS")=""
  1.  S XMDUZ="AUTOMATED MT LETTERS"
  1.  D ^XMD
  1.  Q