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

BLR6249P.m

Go to the documentation of this file. 
  1. BLR6249P ; IHS/OIT/MKK - CHANGE LA7 MESSAGE QUEUE ERROR MESSAGES TO PURGEABLE MESSAGES ; [ 03/24/2006 08:00 AM ]
  1.  ;;5.2;LR;**1022**;September 20, 2007
  1.  ;; Routine to change the status of entries in the LA7 MESSAGE QUEUE
  1.  ;; file (62.49) from "ERROR" to "PURGEABLE".  This will prevent the
  1.  ;; queue from growing forever.  This will only be done on errors
  1.  ;; that are greater than 30 days old.
  1.  ;;
  1. EP ; 
  1.  W $C(7),$C(7),$C(7),!
  1.  W !,"Run at Label",!
  1.  Q
  1.  ;
  1. PEP ; EP
  1.  NEW CNT,CURDATE,MSG,MSGDATE,FDA,STATUS,ERRS
  1.  NEW DTBEG,DTEND,HEADER
  1.  ;
  1.  D ^XBCLS
  1.  S HEADER(1)="LA7 MESSAGE QUEUE (#62.49)"
  1.  S HEADER(2)="MODIFY ERROR MESSAGES 30 Days or Older to PURGEABLE MESSAGE"
  1.  D BLRGSHSH^BLRGMENU
  1.  ;
  1.  S (CNT,MSG)=0
  1.  W !,?5,"Making LA7 MESSAGE QUEUE ERROR MESSAGES Purgeable",!
  1.  F  S MSG=$O(^LAHM(62.49,MSG))  Q:MSG=""!(MSG'?.N)  D
  1.  . D ^XBFMK                   ; Clear FileMan variables
  1.  . K ERRS,FDA
  1.  . S STATUS=$$GET1^DIQ(62.49,MSG_",","STATUS","I",,"ERRS")
  1.  . ;
  1.  . ; If FileMan ERROR, output error message and get next message
  1.  . I $D(ERRS("DIERR"))>0 D ERRORMSG("GET1^DIQ")  Q
  1.  . ;
  1.  . I STATUS'["E" Q            ; If Status not Error, skip
  1.  . ;
  1.  . ; Get the message date
  1.  . K ERRS,FDA
  1.  . S MSGDATE=$$GET1^DIQ(62.49,MSG_",","DATE/TIME ENTERED","I",,"ERRS")
  1.  . I $D(ERRS("DIERR"))>0 D ERRORMSG("GET1^DIQ")  Q
  1.  . ;
  1.  . S MSGDATE=+$P(MSGDATE,".",1)
  1.  . S CURDATE=$P($$HTFM^XLFDT($H),".",1)
  1.  . ;
  1.  . ; Only change those Messages that are older than 30 days.
  1.  . I +$$FMDIFF^XLFDT(CURDATE,MSGDATE,"1")<30 Q
  1.  . ;
  1.  . D ^XBFMK
  1.  . K ERRS,FDA
  1.  . ; NOTE: Even though STATUS is piece 3, the field number is 2
  1.  . S FDA(62.49,MSG_",",2)="X"
  1.  . ;
  1.  . D FILE^DIE("K","FDA","ERRS")
  1.  . I $D(ERRS("DIERR"))>0 D ERRORMSG("FILE^DIE")  Q
  1.  . ;
  1.  . S CNT=CNT+1
  1.  . I CNT=1 W ?7,""
  1.  . W "."
  1.  . I $X>69 W !,?7,""
  1.  . ;
  1.  ;
  1.  I CNT>0 W !,!,?10,"Number of ""Errors"" in 62.49 Changed to Purgeable:",CNT,!,!
  1.  I CNT<1 W !,!,?10,"No ""Errors"" found in 62.49",!,!
  1.  ;
  1.  D ^XBFMK
  1.  S DIR(0)="FO"
  1.  S DIR("A")="Enter RETURN to Continue"
  1.  D ^DIR
  1.  ; It's irrelevant what the answer is
  1.  Q
  1.  ;
  1.  ; Display Error Message -- it's known to be a FileMan error
  1. ERRORMSG(WOT) ;
  1.  W !!,$TR($RE($J($RE("FILEMAN_ERROR_"),IOM))," _","* "),!   ; Trick
  1.  W ?10,"ERROR Occurred during ",$G(WOT),!
  1.  I $D(FDA)>0 D ARRYDUMP("FDA")
  1.  I $D(ERRS)>0 D ARRYDUMP("ERRS")
  1.  W $TR($J("_FILEMAN_ERROR",IOM)," _","* "),!!
  1.  Q
  1.  ;
  1.  ; Because the use of Z functions are not allowed, 
  1.  ; I've written my own version of ZW.
  1. ARRYDUMP(ARRY) ;
  1.  NEW STR1
  1.  ;
  1.  S STR1=$Q(@ARRY@(""))
  1.  W !,?5,ARRY,!
  1.  W ?10,STR1,"=",@STR1,!
  1.  F  S STR1=$Q(@STR1)  Q:STR1=""  D
  1.  . W ?10,STR1,"=",@STR1,!
  1.  Q
  1.  ;
  1.  ; Temp code to reset STATUS back to ERROR -- this is supposed to be
  1.  ; removed BEFORE the national release of IHS LAB PATCH 1022.
  1. MAKERRS ; EP
  1.  NEW HEADER
  1.  S HEADER(1)="LA7 MESSAGE QUEUE (#62.49)"
  1.  S HEADER(2)="MODIFY PURGEABLE MESSAGE to ERROR MESSAGE"
  1.  D BLRGSHSH^BLRGMENU
  1.  ;
  1.  S (CNT,MSG)=0
  1.  W !,?5,"Making LA7 MESSAGE QUEUE PURGEABLE MESSAGES into ERROR MESSAGES again",!
  1.  F  S MSG=$O(^LAHM(62.49,MSG))  Q:MSG=""!(MSG'?.N)  D
  1.  . D ^XBFMK                   ; Clear FileMan variables
  1.  . K ERRS,FDA
  1.  . S STATUS=$$GET1^DIQ(62.49,MSG_",","STATUS","I",,"ERRS")
  1.  . ;
  1.  . ; If FileMan ERROR, output error message and continue
  1.  . I $D(ERRS("DIERR"))>0 D ERRORMSG("GET1^DIQ")  Q
  1.  . ;
  1.  . I STATUS'["X" Q            ; If not purgeable, skip
  1.  . ;
  1.  . D ^XBFMK
  1.  . K ERRS,FDA
  1.  . ; NOTE: Even though STATUS is piece 3, the field number is 2
  1.  . S FDA(62.49,MSG_",",2)="E"
  1.  . ;
  1.  . D FILE^DIE("K","FDA","ERRS")
  1.  . I $D(ERRS("DIERR"))>0 D ERRORMSG("FILE^DIE")  Q
  1.  . I $D(ERRS("DIERR"))<1 D  Q
  1.  .. S CNT=CNT+1
  1.  .. I CNT=1 W ?7,""
  1.  .. W "."
  1.  .. I $X>69 W !,?7,""
  1.  . ;
  1.  ;
  1.  I CNT>0 W !,!,?10,"Number of ""Purgeable"" Messages in 62.49 Changed to ""Errors"":",CNT,!,!
  1.  I CNT<1 W !,!,?10,"No ""Purgeable"" Messages found in 62.49",!,!
  1.  ;
  1.  D ^XBFMK
  1.  S DIR(0)="FO"
  1.  S DIR("A")="Enter RETURN to Continue"
  1.  D ^DIR
  1.  ; Don't care what the answer is
  1.  Q