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

EAS155PT.m

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