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