EAS155PT ;ALB/SCK - PATCH 55 USER ENROLLEE MT LETTER CLEANUP ; 9-AUG-04
;;1.0;ENROLLMENT APPLICATION SYSTEM;**55**;Mar 15, 2004
;
Q
;
CHECK ;
N CURSTN,CURSITE,PRNT,PTYP
N MSG,XMDUZ,XMSUB,XMTEXT,XMY,XX
;
S XMSUB="EAS*1*55 PARENT CHECK"
S XMDUZ="EAS*1*55"
S XMY(.5)="",XMY(DUZ)=""
S XMTEXT="MSG("
;
S CURSITE=$P($$SITE^VASITE,U,3)
S CURSTN=$$STA^XUAF4(CURSITE)
S PRNT=$$PRNT^XUAF4(CURSITE)
S PTYP=$$GET1^DIQ(4,+PRNT,13)
;
S MSG(1)="Current Site: "_CURSITE
S MSG(2)="Current Station: "_$$GET1^DIQ(4,CURSTN,.01)_" ("_CURSTN_")"
S MSG(3)="Parent Facility: "_$P(PRNT,U,3)
S MSG(4)="Parent Type: "_PTYP
S MSG(5)=""
I PTYP="HCS" D
. S MSG(6)="Because your parent facility type is ""HCS"", it's recommended that you run"
. S MSG(7)="the MT Letter cleanup at this time. Please refer to the patch for directions"
E D
. S MSG(6)="Your parent facility type does not appear to be of type ""HCS"". "
. S MSG(7)="It is not recommended that you run the MT letter cleanup at this time"
. S MSG(8)="If you are experiencing problems with the MT Letters, please contact EVS."
D MES^XPDUTL(.MSG)
D ^XMD
;
Q
;
EN ; Que off the background task
N ZTRTN,ZTDESC,ZTSK,ZTIO,ZTDH,MSG,ZTSAVE
;
W !,"Preparing to run the EAS*1*55 MT Letters Cleanup"
W !,"After the cleanup, you will be sent a MailMan summary of the cleanup"
W !,"statistics. You will also be asked to select a printer to send the"
W !,"detailed results to. This report could be quite lengthy. Please "
W !,"DO NOT run the report to your screen!",!
D ^%ZIS
S ZTRTN="LETTERS^EAS155PT"
S ZTDH=$$NOW^XLFDT
S ZTSAVE("DUZ")=""
S ZTDESC="EAS155 MT LETTER CLEANUP FOR UE STATUS"
D ^%ZTLOAD
I $D(ZTSK) W !!?5,"Task: "_ZTSK_" Queued."
D HOME^%ZIS
Q
;
LETTERS ; Reflag those MT letters which need to be updated for UE Status update
N EASIEN,EASPTR,EASDFN,EASLTR,EASCNT,XX
;
K ^TMP("EAS155P",$J)
S ^TMP("EAS155P",$J,"START")=$H,^TMP("EAS155P",$J,"COUNT")=0,^TMP("EAS155P",$J,"NOCHANGE")=0
;
F XX="60D","30D","0D","OFF" S EASCNT(XX)=0
S EASIEN=0
F S EASIEN=$O(^EAS(713.2,"AC",0,EASIEN)) Q:'EASIEN D
. S EASPTR=$$GET1^DIQ(713.2,EASIEN,2,"I")
. Q:$D(^EAS(713.1,"AP",1,EASPTR)) ; Quit if Letter Prohibit Flag set
. Q:$$DECEASED^EASMTUTL(EASIEN) ; Quit if patient deceased
. ; ** Safety check for bad patient pointers in 713.1
. Q:$$GET1^DIQ(713.2,EASIEN,2)']""
. D TESTLTR(EASIEN)
;
S ^TMP("EAS155P",$J,"END")=$H
D MAIL
D REPORT
Q
;
TESTLTR(EASIEN) ; Test letter conditions
N NODE6,NODE4,NODEZ,IENS,FDA,FIN
;
S ^TMP("EAS155P",$J,"COUNT")=^TMP("EAS155P",$J,"COUNT")+1
; Piece 1: Threshold date, Piece 2: Flag-to-print, Piece 3: Letter Printed?, Piece 4: Date printed
S NODE6=$G(^EAS(713.2,EASIEN,6))
S NODE4=$G(^EAS(713.2,EASIEN,4))
S NODEZ=$G(^EAS(713.2,EASIEN,"Z"))
;
; Check 1, check if letters have been completely turned off, No flags to print and no letters printed. Turn back on most appropriate letter.
I '$P(NODE6,U,3),'$P(NODE4,U,3),'$P(NODEZ,U,3) D Q:$G(FIN)
. I '$P(NODE6,U,2),'$P(NODE4,U,2),'$P(NODEZ,U,2) D
. . I $P(NODEZ,U)<DT D Q
. . . S EASCNT("0D")=EASCNT("0D")+1
. . . S ^TMP("EAS155P",$J,"0D",EASIEN)=""
. . . S FDA(1,713.2,EASIEN_",",18)="YES"
. . . S FDA(1,713.2,EASIEN_",",9)="NO"
. . . S FDA(1,713.2,EASIEN_",",12)="NO",FIN=1
. . . D FILE^DIE("E","FDA(1)")
. . I $P(NODE4,U)<DT D Q
. . . S EASCNT("30D")=EASCNT("30D")+1
. . . S ^TMP("EAS155P",$J,"30D",EASIEN)=""
. . . S FDA(1,713.2,EASIEN_",",12)="YES"
. . . S FDA(1,713.2,EASIEN_",",9)="NO"
. . . S FDA(1,713.2,EASIEN_",",18)="NO",FIN=1
. . . D FILE^DIE("E","FDA(1)")
. . S EASCNT("60D")=EASCNT("6OD")+1
. . S ^TMP("EAS155P",$J,"60D",EASIEN)=""
. . S FDA(1,713.2,EASIEN_",",9)="YES"
. . S FDA(1,713.2,EASIEN_",",12)="NO"
. . S FDA(1,713.2,EASIEN_",",18)="NO",FIN=1
. . D FILE^DIE("E","FDA(1)")
;
; Check 2, check if 60d ltrs have not been printed, but 30d ltrs are flagged to print.
I '$P(NODE6,U,3)&($P(NODE4,U,2))&($P(NODE4,U,1)>DT) D Q:$G(FIN)
. S EASCNT("60D")=EASCNT("60D")+1
. S ^TMP("EAS155P",$J,"60D",EASIEN)=""
. S FDA(1,713.2,EASIEN_",",9)="YES"
. S FDA(1,713.2,EASIEN_",",12)="NO"
. D FILE^DIE("E","FDA(1)")
. S FIN=1
;
; Check 3, if the 60d ltr has been printed AND the 30d ltr has not AND the
; 0d ltr is flagged to print.
I $P(NODE6,U,3)&('$P(NODE4,U,3))&($P(NODEZ,U,2))&($P(NODEZ,U,1)>DT) D Q:$G(FIN)
. S EASCNT("30D")=EASCNT("30D")+1
. S ^TMP("EAS155P",$J,"30D",EASIEN)=""
. S FDA(1,713.2,EASIEN_",",12)="YES"
. S FDA(1,713.2,EASIEN_",",18)="NO"
. D FILE^DIE("E","FDA(1)")
. S FIN=1
;
; Check 4, if the 30d ltr has been printed and the 0d has not AND is not flagged.
I $P(NODE4,U,3)&('$P(NODEZ,U,3))&('$P(NODEZ,U,2)) D Q
. S EASCNT("0D")=EASCNT("0D")+1
. S ^TMP("EAS155P",$J,"0D",EASIEN)=""
. S FDA(1,713.2,EASIEN_",",18)="YES"
. D FILE^DIE("E","FDA(1)")
;
S ^TMP("EAS155P",$J,"NOCHANGE")=^TMP("EAS155P",$J,"NOCHANGE")+1
Q
;
UPD(FDA) ; Update file entry
N ERR
;
D FILE^DIE("E","FDA(1)","ERR")
Q
;
MAIL ;
N MSG,XMDUZ,XMSUB,XMTEXT,XMY,XX
;
S (XMDUZ,XMSUB)="EAS*1*55 CLEANUP"
S XMY(.5)="",XMY(DUZ)=""
S XMTEXT="MSG("
S MSG(10)="Begin: "_$$HTE^XLFDT(^TMP("EAS155P",$J,"START"))
S MSG(20)="End: "_$$HTE^XLFDT(^TMP("EAS155P",$J,"END"))
S MSG(30)="Processing Time: "_$$HDIFF^XLFDT(^TMP("EAS155P",$J,"END"),^TMP("EAS155P",$J,"START"),3)
S MSG(31)=""
S MSG(35)=" Turned Off: "_EASCNT("OFF")
S MSG(40)="60-Day Letters: "_EASCNT("60D")
S MSG(50)="30-Day Letters: "_EASCNT("30D")
S MSG(60)=" 0-Day Letters: "_EASCNT("0D")
S MSG(65)=""
S MSG(70)="No action required: "_^TMP("EAS155P",$J,"NOCHANGE")
D ^XMD
Q
;
REPORT ;
N EAX,PAGE,EANAME,EASIEN,EASLTR
;
U IO
S (PAGE,EAX)=0
F EASLTR="60D","30D","0D" D
. D HDR
. I EASCNT(EASLTR)'>0 D Q
. . W !!,"There were no letters reset for this letter type"
. S EASIEN=0
. F S EASIEN=$O(^TMP("EAS155P",$J,EASLTR,EASIEN)) Q:EASIEN']"" D
. . W !,$$GET1^DIQ(713.2,EASIEN,2),?35,EASIEN,?55,$$GET1^DIQ(713.2,EASIEN,.01)
. . I ($Y+6)>IOSL D HDR
D FTR
Q
;
HDR ;
N DDASH,LINE,PART1,PART2,SPACE
;
W @IOF
S PAGE=PAGE+1
W !,"Patch EAS*1*55 MT Letter Cleanup Results"
S PART1="Run Date: "_$$FMTE^XLFDT(DT)
S PART2="Page: "_PAGE
S SPACE=IOM,SPACE=SPACE-($L(PART1)+$L(PART2))
S $P(LINE," ",SPACE)=""
W !,PART1,LINE,PART2
W !!,$S(EASLTR="60D":"60-Day",EASLTR="30D":"30-Day",EASLTR="0D":"0-Day",1:"")," Letters for the following Veterans have been reset"
W !?5,"Name",?35,"File 713.2 IEN",?55,"Processing Date"
S $P(DDASH,"=",IOM)="" W !,DDASH
Q
;
FTR ;
W !!!!?5,"60-Day Letters: "_EASCNT("60D")
W !?5,"30-Day Letters: "_EASCNT("30D")
W !?5," 0-Day Letters: "_EASCNT("0D")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEAS155PT 6822 printed Nov 22, 2024@17:03:38 Page 2
EAS155PT ;ALB/SCK - PATCH 55 USER ENROLLEE MT LETTER CLEANUP ; 9-AUG-04
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**55**;Mar 15, 2004
+2 ;
+3 QUIT
+4 ;
CHECK ;
+1 NEW CURSTN,CURSITE,PRNT,PTYP
+2 NEW MSG,XMDUZ,XMSUB,XMTEXT,XMY,XX
+3 ;
+4 SET XMSUB="EAS*1*55 PARENT CHECK"
+5 SET XMDUZ="EAS*1*55"
+6 SET XMY(.5)=""
SET XMY(DUZ)=""
+7 SET XMTEXT="MSG("
+8 ;
+9 SET CURSITE=$PIECE($$SITE^VASITE,U,3)
+10 SET CURSTN=$$STA^XUAF4(CURSITE)
+11 SET PRNT=$$PRNT^XUAF4(CURSITE)
+12 SET PTYP=$$GET1^DIQ(4,+PRNT,13)
+13 ;
+14 SET MSG(1)="Current Site: "_CURSITE
+15 SET MSG(2)="Current Station: "_$$GET1^DIQ(4,CURSTN,.01)_" ("_CURSTN_")"
+16 SET MSG(3)="Parent Facility: "_$PIECE(PRNT,U,3)
+17 SET MSG(4)="Parent Type: "_PTYP
+18 SET MSG(5)=""
+19 IF PTYP="HCS"
Begin DoDot:1
+20 SET MSG(6)="Because your parent facility type is ""HCS"", it's recommended that you run"
+21 SET MSG(7)="the MT Letter cleanup at this time. Please refer to the patch for directions"
End DoDot:1
+22 IF '$TEST
Begin DoDot:1
+23 SET MSG(6)="Your parent facility type does not appear to be of type ""HCS"". "
+24 SET MSG(7)="It is not recommended that you run the MT letter cleanup at this time"
+25 SET MSG(8)="If you are experiencing problems with the MT Letters, please contact EVS."
End DoDot:1
+26 DO MES^XPDUTL(.MSG)
+27 DO ^XMD
+28 ;
+29 QUIT
+30 ;
EN ; Que off the background task
+1 NEW ZTRTN,ZTDESC,ZTSK,ZTIO,ZTDH,MSG,ZTSAVE
+2 ;
+3 WRITE !,"Preparing to run the EAS*1*55 MT Letters Cleanup"
+4 WRITE !,"After the cleanup, you will be sent a MailMan summary of the cleanup"
+5 WRITE !,"statistics. You will also be asked to select a printer to send the"
+6 WRITE !,"detailed results to. This report could be quite lengthy. Please "
+7 WRITE !,"DO NOT run the report to your screen!",!
+8 DO ^%ZIS
+9 SET ZTRTN="LETTERS^EAS155PT"
+10 SET ZTDH=$$NOW^XLFDT
+11 SET ZTSAVE("DUZ")=""
+12 SET ZTDESC="EAS155 MT LETTER CLEANUP FOR UE STATUS"
+13 DO ^%ZTLOAD
+14 IF $DATA(ZTSK)
WRITE !!?5,"Task: "_ZTSK_" Queued."
+15 DO HOME^%ZIS
+16 QUIT
+17 ;
LETTERS ; Reflag those MT letters which need to be updated for UE Status update
+1 NEW EASIEN,EASPTR,EASDFN,EASLTR,EASCNT,XX
+2 ;
+3 KILL ^TMP("EAS155P",$JOB)
+4 SET ^TMP("EAS155P",$JOB,"START")=$HOROLOG
SET ^TMP("EAS155P",$JOB,"COUNT")=0
SET ^TMP("EAS155P",$JOB,"NOCHANGE")=0
+5 ;
+6 FOR XX="60D","30D","0D","OFF"
SET EASCNT(XX)=0
+7 SET EASIEN=0
+8 FOR
SET EASIEN=$ORDER(^EAS(713.2,"AC",0,EASIEN))
if 'EASIEN
QUIT
Begin DoDot:1
+9 SET EASPTR=$$GET1^DIQ(713.2,EASIEN,2,"I")
+10 ; Quit if Letter Prohibit Flag set
if $DATA(^EAS(713.1,"AP",1,EASPTR))
QUIT
+11 ; Quit if patient deceased
if $$DECEASED^EASMTUTL(EASIEN)
QUIT
+12 ; ** Safety check for bad patient pointers in 713.1
+13 if $$GET1^DIQ(713.2,EASIEN,2)']""
QUIT
+14 DO TESTLTR(EASIEN)
End DoDot:1
+15 ;
+16 SET ^TMP("EAS155P",$JOB,"END")=$HOROLOG
+17 DO MAIL
+18 DO REPORT
+19 QUIT
+20 ;
TESTLTR(EASIEN) ; Test letter conditions
+1 NEW NODE6,NODE4,NODEZ,IENS,FDA,FIN
+2 ;
+3 SET ^TMP("EAS155P",$JOB,"COUNT")=^TMP("EAS155P",$JOB,"COUNT")+1
+4 ; Piece 1: Threshold date, Piece 2: Flag-to-print, Piece 3: Letter Printed?, Piece 4: Date printed
+5 SET NODE6=$GET(^EAS(713.2,EASIEN,6))
+6 SET NODE4=$GET(^EAS(713.2,EASIEN,4))
+7 SET NODEZ=$GET(^EAS(713.2,EASIEN,"Z"))
+8 ;
+9 ; Check 1, check if letters have been completely turned off, No flags to print and no letters printed. Turn back on most appropriate letter.
+10 IF '$PIECE(NODE6,U,3)
IF '$PIECE(NODE4,U,3)
IF '$PIECE(NODEZ,U,3)
Begin DoDot:1
+11 IF '$PIECE(NODE6,U,2)
IF '$PIECE(NODE4,U,2)
IF '$PIECE(NODEZ,U,2)
Begin DoDot:2
+12 IF $PIECE(NODEZ,U)<DT
Begin DoDot:3
+13 SET EASCNT("0D")=EASCNT("0D")+1
+14 SET ^TMP("EAS155P",$JOB,"0D",EASIEN)=""
+15 SET FDA(1,713.2,EASIEN_",",18)="YES"
+16 SET FDA(1,713.2,EASIEN_",",9)="NO"
+17 SET FDA(1,713.2,EASIEN_",",12)="NO"
SET FIN=1
+18 DO FILE^DIE("E","FDA(1)")
End DoDot:3
QUIT
+19 IF $PIECE(NODE4,U)<DT
Begin DoDot:3
+20 SET EASCNT("30D")=EASCNT("30D")+1
+21 SET ^TMP("EAS155P",$JOB,"30D",EASIEN)=""
+22 SET FDA(1,713.2,EASIEN_",",12)="YES"
+23 SET FDA(1,713.2,EASIEN_",",9)="NO"
+24 SET FDA(1,713.2,EASIEN_",",18)="NO"
SET FIN=1
+25 DO FILE^DIE("E","FDA(1)")
End DoDot:3
QUIT
+26 SET EASCNT("60D")=EASCNT("6OD")+1
+27 SET ^TMP("EAS155P",$JOB,"60D",EASIEN)=""
+28 SET FDA(1,713.2,EASIEN_",",9)="YES"
+29 SET FDA(1,713.2,EASIEN_",",12)="NO"
+30 SET FDA(1,713.2,EASIEN_",",18)="NO"
SET FIN=1
+31 DO FILE^DIE("E","FDA(1)")
End DoDot:2
End DoDot:1
if $GET(FIN)
QUIT
+32 ;
+33 ; Check 2, check if 60d ltrs have not been printed, but 30d ltrs are flagged to print.
+34 IF '$PIECE(NODE6,U,3)&($PIECE(NODE4,U,2))&($PIECE(NODE4,U,1)>DT)
Begin DoDot:1
+35 SET EASCNT("60D")=EASCNT("60D")+1
+36 SET ^TMP("EAS155P",$JOB,"60D",EASIEN)=""
+37 SET FDA(1,713.2,EASIEN_",",9)="YES"
+38 SET FDA(1,713.2,EASIEN_",",12)="NO"
+39 DO FILE^DIE("E","FDA(1)")
+40 SET FIN=1
End DoDot:1
if $GET(FIN)
QUIT
+41 ;
+42 ; Check 3, if the 60d ltr has been printed AND the 30d ltr has not AND the
+43 ; 0d ltr is flagged to print.
+44 IF $PIECE(NODE6,U,3)&('$PIECE(NODE4,U,3))&($PIECE(NODEZ,U,2))&($PIECE(NODEZ,U,1)>DT)
Begin DoDot:1
+45 SET EASCNT("30D")=EASCNT("30D")+1
+46 SET ^TMP("EAS155P",$JOB,"30D",EASIEN)=""
+47 SET FDA(1,713.2,EASIEN_",",12)="YES"
+48 SET FDA(1,713.2,EASIEN_",",18)="NO"
+49 DO FILE^DIE("E","FDA(1)")
+50 SET FIN=1
End DoDot:1
if $GET(FIN)
QUIT
+51 ;
+52 ; Check 4, if the 30d ltr has been printed and the 0d has not AND is not flagged.
+53 IF $PIECE(NODE4,U,3)&('$PIECE(NODEZ,U,3))&('$PIECE(NODEZ,U,2))
Begin DoDot:1
+54 SET EASCNT("0D")=EASCNT("0D")+1
+55 SET ^TMP("EAS155P",$JOB,"0D",EASIEN)=""
+56 SET FDA(1,713.2,EASIEN_",",18)="YES"
+57 DO FILE^DIE("E","FDA(1)")
End DoDot:1
QUIT
+58 ;
+59 SET ^TMP("EAS155P",$JOB,"NOCHANGE")=^TMP("EAS155P",$JOB,"NOCHANGE")+1
+60 QUIT
+61 ;
UPD(FDA) ; Update file entry
+1 NEW ERR
+2 ;
+3 DO FILE^DIE("E","FDA(1)","ERR")
+4 QUIT
+5 ;
MAIL ;
+1 NEW MSG,XMDUZ,XMSUB,XMTEXT,XMY,XX
+2 ;
+3 SET (XMDUZ,XMSUB)="EAS*1*55 CLEANUP"
+4 SET XMY(.5)=""
SET XMY(DUZ)=""
+5 SET XMTEXT="MSG("
+6 SET MSG(10)="Begin: "_$$HTE^XLFDT(^TMP("EAS155P",$JOB,"START"))
+7 SET MSG(20)="End: "_$$HTE^XLFDT(^TMP("EAS155P",$JOB,"END"))
+8 SET MSG(30)="Processing Time: "_$$HDIFF^XLFDT(^TMP("EAS155P",$JOB,"END"),^TMP("EAS155P",$JOB,"START"),3)
+9 SET MSG(31)=""
+10 SET MSG(35)=" Turned Off: "_EASCNT("OFF")
+11 SET MSG(40)="60-Day Letters: "_EASCNT("60D")
+12 SET MSG(50)="30-Day Letters: "_EASCNT("30D")
+13 SET MSG(60)=" 0-Day Letters: "_EASCNT("0D")
+14 SET MSG(65)=""
+15 SET MSG(70)="No action required: "_^TMP("EAS155P",$JOB,"NOCHANGE")
+16 DO ^XMD
+17 QUIT
+18 ;
REPORT ;
+1 NEW EAX,PAGE,EANAME,EASIEN,EASLTR
+2 ;
+3 USE IO
+4 SET (PAGE,EAX)=0
+5 FOR EASLTR="60D","30D","0D"
Begin DoDot:1
+6 DO HDR
+7 IF EASCNT(EASLTR)'>0
Begin DoDot:2
+8 WRITE !!,"There were no letters reset for this letter type"
End DoDot:2
QUIT
+9 SET EASIEN=0
+10 FOR
SET EASIEN=$ORDER(^TMP("EAS155P",$JOB,EASLTR,EASIEN))
if EASIEN']""
QUIT
Begin DoDot:2
+11 WRITE !,$$GET1^DIQ(713.2,EASIEN,2),?35,EASIEN,?55,$$GET1^DIQ(713.2,EASIEN,.01)
+12 IF ($Y+6)>IOSL
DO HDR
End DoDot:2
End DoDot:1
+13 DO FTR
+14 QUIT
+15 ;
HDR ;
+1 NEW DDASH,LINE,PART1,PART2,SPACE
+2 ;
+3 WRITE @IOF
+4 SET PAGE=PAGE+1
+5 WRITE !,"Patch EAS*1*55 MT Letter Cleanup Results"
+6 SET PART1="Run Date: "_$$FMTE^XLFDT(DT)
+7 SET PART2="Page: "_PAGE
+8 SET SPACE=IOM
SET SPACE=SPACE-($LENGTH(PART1)+$LENGTH(PART2))
+9 SET $PIECE(LINE," ",SPACE)=""
+10 WRITE !,PART1,LINE,PART2
+11 WRITE !!,$SELECT(EASLTR="60D":"60-Day",EASLTR="30D":"30-Day",EASLTR="0D":"0-Day",1:"")," Letters for the following Veterans have been reset"
+12 WRITE !?5,"Name",?35,"File 713.2 IEN",?55,"Processing Date"
+13 SET $PIECE(DDASH,"=",IOM)=""
WRITE !,DDASH
+14 QUIT
+15 ;
FTR ;
+1 WRITE !!!!?5,"60-Day Letters: "_EASCNT("60D")
+2 WRITE !?5,"30-Day Letters: "_EASCNT("30D")
+3 WRITE !?5," 0-Day Letters: "_EASCNT("0D")
+4 QUIT
