200 lines
6.5 KiB
Mathematica
200 lines
6.5 KiB
Mathematica
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
|