BLR6249P ; IHS/OIT/MKK - CHANGE LA7 MESSAGE QUEUE ERROR MESSAGES TO PURGEABLE MESSAGES ; [ 03/24/2006 08:00 AM ]
;;5.2;LR;**1022**;September 20, 2007
;; Routine to change the status of entries in the LA7 MESSAGE QUEUE
;; file (62.49) from "ERROR" to "PURGEABLE". This will prevent the
;; queue from growing forever. This will only be done on errors
;; that are greater than 30 days old.
;;
EP ;
W $C(7),$C(7),$C(7),!
W !,"Run at Label",!
Q
;
PEP ; EP
NEW CNT,CURDATE,MSG,MSGDATE,FDA,STATUS,ERRS
NEW DTBEG,DTEND,HEADER
;
D ^XBCLS
S HEADER(1)="LA7 MESSAGE QUEUE (#62.49)"
S HEADER(2)="MODIFY ERROR MESSAGES 30 Days or Older to PURGEABLE MESSAGE"
D BLRGSHSH^BLRGMENU
;
S (CNT,MSG)=0
W !,?5,"Making LA7 MESSAGE QUEUE ERROR MESSAGES Purgeable",!
F S MSG=$O(^LAHM(62.49,MSG)) Q:MSG=""!(MSG'?.N) D
. D ^XBFMK ; Clear FileMan variables
. K ERRS,FDA
. S STATUS=$$GET1^DIQ(62.49,MSG_",","STATUS","I",,"ERRS")
. ;
. ; If FileMan ERROR, output error message and get next message
. I $D(ERRS("DIERR"))>0 D ERRORMSG("GET1^DIQ") Q
. ;
. I STATUS'["E" Q ; If Status not Error, skip
. ;
. ; Get the message date
. K ERRS,FDA
. S MSGDATE=$$GET1^DIQ(62.49,MSG_",","DATE/TIME ENTERED","I",,"ERRS")
. I $D(ERRS("DIERR"))>0 D ERRORMSG("GET1^DIQ") Q
. ;
. S MSGDATE=+$P(MSGDATE,".",1)
. S CURDATE=$P($$HTFM^XLFDT($H),".",1)
. ;
. ; Only change those Messages that are older than 30 days.
. I +$$FMDIFF^XLFDT(CURDATE,MSGDATE,"1")<30 Q
. ;
. D ^XBFMK
. K ERRS,FDA
. ; NOTE: Even though STATUS is piece 3, the field number is 2
. S FDA(62.49,MSG_",",2)="X"
. ;
. D FILE^DIE("K","FDA","ERRS")
. I $D(ERRS("DIERR"))>0 D ERRORMSG("FILE^DIE") Q
. ;
. S CNT=CNT+1
. I CNT=1 W ?7,""
. W "."
. I $X>69 W !,?7,""
. ;
;
I CNT>0 W !,!,?10,"Number of ""Errors"" in 62.49 Changed to Purgeable:",CNT,!,!
I CNT<1 W !,!,?10,"No ""Errors"" found in 62.49",!,!
;
D ^XBFMK
S DIR(0)="FO"
S DIR("A")="Enter RETURN to Continue"
D ^DIR
; It's irrelevant what the answer is
Q
;
; Display Error Message -- it's known to be a FileMan error
ERRORMSG(WOT) ;
W !!,$TR($RE($J($RE("FILEMAN_ERROR_"),IOM))," _","* "),! ; Trick
W ?10,"ERROR Occurred during ",$G(WOT),!
I $D(FDA)>0 D ARRYDUMP("FDA")
I $D(ERRS)>0 D ARRYDUMP("ERRS")
W $TR($J("_FILEMAN_ERROR",IOM)," _","* "),!!
Q
;
; Because the use of Z functions are not allowed,
; I've written my own version of ZW.
ARRYDUMP(ARRY) ;
NEW STR1
;
S STR1=$Q(@ARRY@(""))
W !,?5,ARRY,!
W ?10,STR1,"=",@STR1,!
F S STR1=$Q(@STR1) Q:STR1="" D
. W ?10,STR1,"=",@STR1,!
Q
;
; Temp code to reset STATUS back to ERROR -- this is supposed to be
; removed BEFORE the national release of IHS LAB PATCH 1022.
MAKERRS ; EP
NEW HEADER
S HEADER(1)="LA7 MESSAGE QUEUE (#62.49)"
S HEADER(2)="MODIFY PURGEABLE MESSAGE to ERROR MESSAGE"
D BLRGSHSH^BLRGMENU
;
S (CNT,MSG)=0
W !,?5,"Making LA7 MESSAGE QUEUE PURGEABLE MESSAGES into ERROR MESSAGES again",!
F S MSG=$O(^LAHM(62.49,MSG)) Q:MSG=""!(MSG'?.N) D
. D ^XBFMK ; Clear FileMan variables
. K ERRS,FDA
. S STATUS=$$GET1^DIQ(62.49,MSG_",","STATUS","I",,"ERRS")
. ;
. ; If FileMan ERROR, output error message and continue
. I $D(ERRS("DIERR"))>0 D ERRORMSG("GET1^DIQ") Q
. ;
. I STATUS'["X" Q ; If not purgeable, skip
. ;
. D ^XBFMK
. K ERRS,FDA
. ; NOTE: Even though STATUS is piece 3, the field number is 2
. S FDA(62.49,MSG_",",2)="E"
. ;
. D FILE^DIE("K","FDA","ERRS")
. I $D(ERRS("DIERR"))>0 D ERRORMSG("FILE^DIE") Q
. I $D(ERRS("DIERR"))<1 D Q
.. S CNT=CNT+1
.. I CNT=1 W ?7,""
.. W "."
.. I $X>69 W !,?7,""
. ;
;
I CNT>0 W !,!,?10,"Number of ""Purgeable"" Messages in 62.49 Changed to ""Errors"":",CNT,!,!
I CNT<1 W !,!,?10,"No ""Purgeable"" Messages found in 62.49",!,!
;
D ^XBFMK
S DIR(0)="FO"
S DIR("A")="Enter RETURN to Continue"
D ^DIR
; Don't care what the answer is
Q
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
+2 ;; Routine to change the status of entries in the LA7 MESSAGE QUEUE
+3 ;; file (62.49) from "ERROR" to "PURGEABLE". This will prevent the
+4 ;; queue from growing forever. This will only be done on errors
+5 ;; that are greater than 30 days old.
+6 ;;
EP ;
+1 WRITE $CHAR(7),$CHAR(7),$CHAR(7),!
+2 WRITE !,"Run at Label",!
+3 QUIT
+4 ;
PEP ; EP
+1 NEW CNT,CURDATE,MSG,MSGDATE,FDA,STATUS,ERRS
+2 NEW DTBEG,DTEND,HEADER
+3 ;
+4 DO ^XBCLS
+5 SET HEADER(1)="LA7 MESSAGE QUEUE (#62.49)"
+6 SET HEADER(2)="MODIFY ERROR MESSAGES 30 Days or Older to PURGEABLE MESSAGE"
+7 DO BLRGSHSH^BLRGMENU
+8 ;
+9 SET (CNT,MSG)=0
+10 WRITE !,?5,"Making LA7 MESSAGE QUEUE ERROR MESSAGES Purgeable",!
+11 FOR
SET MSG=$ORDER(^LAHM(62.49,MSG))
IF MSG=""!(MSG'?.N)
QUIT
Begin DoDot:1
+12 ; Clear FileMan variables
DO ^XBFMK
+13 KILL ERRS,FDA
+14 SET STATUS=$$GET1^DIQ(62.49,MSG_",","STATUS","I",,"ERRS")
+15 ;
+16 ; If FileMan ERROR, output error message and get next message
+17 IF $DATA(ERRS("DIERR"))>0
DO ERRORMSG("GET1^DIQ")
QUIT
+18 ;
+19 ; If Status not Error, skip
IF STATUS'["E"
QUIT
+20 ;
+21 ; Get the message date
+22 KILL ERRS,FDA
+23 SET MSGDATE=$$GET1^DIQ(62.49,MSG_",","DATE/TIME ENTERED","I",,"ERRS")
+24 IF $DATA(ERRS("DIERR"))>0
DO ERRORMSG("GET1^DIQ")
QUIT
+25 ;
+26 SET MSGDATE=+$PIECE(MSGDATE,".",1)
+27 SET CURDATE=$PIECE($$HTFM^XLFDT($HOROLOG),".",1)
+28 ;
+29 ; Only change those Messages that are older than 30 days.
+30 IF +$$FMDIFF^XLFDT(CURDATE,MSGDATE,"1")<30
QUIT
+31 ;
+32 DO ^XBFMK
+33 KILL ERRS,FDA
+34 ; NOTE: Even though STATUS is piece 3, the field number is 2
+35 SET FDA(62.49,MSG_",",2)="X"
+36 ;
+37 DO FILE^DIE("K","FDA","ERRS")
+38 IF $DATA(ERRS("DIERR"))>0
DO ERRORMSG("FILE^DIE")
QUIT
+39 ;
+40 SET CNT=CNT+1
+41 IF CNT=1
WRITE ?7,""
+42 WRITE "."
+43 IF $X>69
WRITE !,?7,""
+44 ;
End DoDot:1
+45 ;
+46 IF CNT>0
WRITE !,!,?10,"Number of ""Errors"" in 62.49 Changed to Purgeable:",CNT,!,!
+47 IF CNT<1
WRITE !,!,?10,"No ""Errors"" found in 62.49",!,!
+48 ;
+49 DO ^XBFMK
+50 SET DIR(0)="FO"
+51 SET DIR("A")="Enter RETURN to Continue"
+52 DO ^DIR
+53 ; It's irrelevant what the answer is
+54 QUIT
+55 ;
+56 ; Display Error Message -- it's known to be a FileMan error
ERRORMSG(WOT) ;
+1 ; Trick
WRITE !!,$TRANSLATE($REVERSE($JUSTIFY($REVERSE("FILEMAN_ERROR_"),IOM))," _","* "),!
+2 WRITE ?10,"ERROR Occurred during ",$GET(WOT),!
+3 IF $DATA(FDA)>0
DO ARRYDUMP("FDA")
+4 IF $DATA(ERRS)>0
DO ARRYDUMP("ERRS")
+5 WRITE $TRANSLATE($JUSTIFY("_FILEMAN_ERROR",IOM)," _","* "),!!
+6 QUIT
+7 ;
+8 ; Because the use of Z functions are not allowed,
+9 ; I've written my own version of ZW.
ARRYDUMP(ARRY) ;
+1 NEW STR1
+2 ;
+3 SET STR1=$QUERY(@ARRY@(""))
+4 WRITE !,?5,ARRY,!
+5 WRITE ?10,STR1,"=",@STR1,!
+6 FOR
SET STR1=$QUERY(@STR1)
IF STR1=""
QUIT
Begin DoDot:1
+7 WRITE ?10,STR1,"=",@STR1,!
End DoDot:1
+8 QUIT
+9 ;
+10 ; Temp code to reset STATUS back to ERROR -- this is supposed to be
+11 ; removed BEFORE the national release of IHS LAB PATCH 1022.
MAKERRS ; EP
+1 NEW HEADER
+2 SET HEADER(1)="LA7 MESSAGE QUEUE (#62.49)"
+3 SET HEADER(2)="MODIFY PURGEABLE MESSAGE to ERROR MESSAGE"
+4 DO BLRGSHSH^BLRGMENU
+5 ;
+6 SET (CNT,MSG)=0
+7 WRITE !,?5,"Making LA7 MESSAGE QUEUE PURGEABLE MESSAGES into ERROR MESSAGES again",!
+8 FOR
SET MSG=$ORDER(^LAHM(62.49,MSG))
IF MSG=""!(MSG'?.N)
QUIT
Begin DoDot:1
+9 ; Clear FileMan variables
DO ^XBFMK
+10 KILL ERRS,FDA
+11 SET STATUS=$$GET1^DIQ(62.49,MSG_",","STATUS","I",,"ERRS")
+12 ;
+13 ; If FileMan ERROR, output error message and continue
+14 IF $DATA(ERRS("DIERR"))>0
DO ERRORMSG("GET1^DIQ")
QUIT
+15 ;
+16 ; If not purgeable, skip
IF STATUS'["X"
QUIT
+17 ;
+18 DO ^XBFMK
+19 KILL ERRS,FDA
+20 ; NOTE: Even though STATUS is piece 3, the field number is 2
+21 SET FDA(62.49,MSG_",",2)="E"
+22 ;
+23 DO FILE^DIE("K","FDA","ERRS")
+24 IF $DATA(ERRS("DIERR"))>0
DO ERRORMSG("FILE^DIE")
QUIT
+25 IF $DATA(ERRS("DIERR"))<1
Begin DoDot:2
+26 SET CNT=CNT+1
+27 IF CNT=1
WRITE ?7,""
+28 WRITE "."
+29 IF $X>69
WRITE !,?7,""
End DoDot:2
QUIT
+30 ;
End DoDot:1
+31 ;
+32 IF CNT>0
WRITE !,!,?10,"Number of ""Purgeable"" Messages in 62.49 Changed to ""Errors"":",CNT,!,!
+33 IF CNT<1
WRITE !,!,?10,"No ""Purgeable"" Messages found in 62.49",!,!
+34 ;
+35 DO ^XBFMK
+36 SET DIR(0)="FO"
+37 SET DIR("A")="Enter RETURN to Continue"
+38 DO ^DIR
+39 ; Don't care what the answer is
+40 QUIT
