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

BLRCLRAL.m

Go to the documentation of this file. 
  1. BLRCLRAL ;IHS/OIT/MKK - Clear ALL Lab Module Errors in the Error Trap ; 22-Apr-2016 15:09 ; MKK
  1.  ;;5.2;LR;**1024,1039**;NOV 01, 1997;Build 38
  1.  ;
  1.  ;Clear ALL BLR Errors from ERROR LOG, no matter the date
  1.  ;Code cloned from CLRERRS^BLRUTIL.
  1. CLRALLER ; EP
  1.  NEW BLRERLIM,BLRERRS,CURUCI,ERRDT,ERRNUM,HEADER,RTN,TODAY,TONLERRS
  1.  NEW ERRTOTAL      ; IHS/MSC/MKK - LR*5.2*1039
  1.  ;
  1.  S HEADER(1)="CLEAR ALL BLR ERRORS IN ERROR TRAP"
  1.  D HEADERDT^BLRGMENU
  1.  W ?4    ; IHS/MSC/MKK - LR*5.2*1039
  1.  ;
  1.  S STARTDT=$O(^%ZTER(1,0))                     ; Earliest date in Error Trap
  1.  S TODAY=+$H
  1.  S BLRQSITE=$P($G(^AUTTSITE(1,0)),U)           ; Division
  1.  S BLRERLIM=$P($G(^BLRSITE(BLRQSITE,0)),U,11)  ; GET ERROR OVERFLOW LIMIT
  1.  X ^%ZOSF("UCI")
  1.  ; S CURUCI=Y
  1.  S CURUCI=$P(Y,",")     ; IHS/MSC/MKK - LR*5.2*1039
  1.  ;
  1.  S ERRTOTAL=0           ; IHS/MSC/MKK - LR*5.2*1039
  1.  S (BLRERRS,TONLERRS)=0
  1.  ; F ERRDT=STARTDT:1:TODAY  Q:+$G(BLRERRS)>5  D          ; <<<<<<<DEBUG
  1.  F ERRDT=STARTDT:1:TODAY  D       ; IHS/MSC/MKK - LR*5.2*1039 -- Remove DEBUG limit
  1.  . S ERRNUM=0
  1.  . F  S ERRNUM=$O(^%ZTER(1,ERRDT,1,ERRNUM)) Q:ERRNUM=""!(ERRNUM'?.N)  D
  1.  .. ; Q:$P($G(^%ZTER(1,ERRDT,1,ERRNUM,"J")),U,4)'=CURUCI
  1.  .. ;
  1.  .. ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1039
  1.  .. S ERRUCI=$P($G(^%ZTER(1,ERRDT,1,ERRNUM,"J")),U,4)
  1.  .. S ERRUCI=$S(ERRUCI[":":$P(ERRUCI,":"),1:$P(ERRUCI,","))
  1.  .. Q:ERRUCI'=CURUCI
  1.  .. ;
  1.  .. S ERRTOTAL=ERRTOTAL+1
  1.  .. I (ERRTOTAL#100)=0 W "."  W:$X>74 !,?4
  1.  .. ; ----- END IHS/MSC/MKK - LR*5.2*1039
  1.  .. ;
  1.  .. I $G(^%ZTER(1,ERRDT,1,ERRNUM,"ZE"))'[("^BLR") D  Q
  1.  ... S TONLERRS=1+$G(TONLERRS)               ; Count # of Non-BLR errors
  1.  .. ;
  1.  .. S BLRERRS(ERRDT)=1+$G(BLRERRS(ERRDT))
  1.  .. S BLRERRS=1+$G(BLRERRS)
  1.  .. ; K ^%ZTER(1,ERRDT,1,ERRNUM)
  1.  .. ; S $P(^%ZTER(1,ERRDT,0),U,2)=$P($G(^%ZTER(1,ERRDT,0)),U,2)-1
  1.  .. ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1039
  1.  .. D ^XBFMK
  1.  .. S DA=ERRNUM,DA(1)=ERRDT
  1.  .. S DIK="^%ZTER(1,"_DA(1)_",1,"
  1.  .. D ^DIK
  1.  .. ;
  1.  .. ; If deletion successful, have to manually reset the Error Counter
  1.  .. S:$D(^%ZTER(1,ERRDT,1,ERRNUM))<1 $P(^%ZTER(1,ERRDT,0),U,2)=$P($G(^%ZTER(1,ERRDT,0)),U,2)-1
  1.  .. ; ----- END IHS/MSC/MKK - LR*5.2*1039
  1.  ;
  1.  ; W !!
  1.  ; I +$G(TONLERRS)>0 W ?5,"Total Non-Link Errors = ",TONLERRS,!
  1.  W !!,?4,$FN(ERRTOTAL,",")," Errors analyzed.",!     ; IHS/MSC/MKK - LR*5.2*1039
  1.  ;
  1.  I +$G(BLRERRS)<1 D
  1.  . ; W !,?5,"No link errors were found for Date Range: "
  1.  . W !,?9,"No link errors were found for Date Range: "     ; IHS/MSC/MKK - LR*5.2*1039
  1.  . W $$HTE^XLFDT(STARTDT,"2DZ")
  1.  . W " thru "
  1.  . W $$HTE^XLFDT(TODAY,"2DZ")
  1.  . W !
  1.  ;
  1.  I +$G(BLRERRS)>0 D
  1.  . W !
  1.  . ; W +$G(BLRERRS)
  1.  . ; W ?5,"Link Errors were found and cleared from the error log!",!!
  1.  . W ?9,BLRERRS," Link Errors were found and cleared from the error log.",!    ; IHS/MSC/MKK - LR*5.2*1039
  1.  . S ERRDT=0
  1.  . F  S ERRDT=$O(BLRERRS(ERRDT))  Q:ERRDT=""  D
  1.  .. ; W ?10,"Date: "
  1.  .. W ?14,"Date: "      ; IHS/MSC/MKK - LR*5.2*1039
  1.  .. W $$HTE^XLFDT(ERRDT,"2DZ")    ; External Date format
  1.  .. W " had "
  1.  .. W +$G(BLRERRS(ERRDT))         ; # of errors on that date
  1.  .. W " link error"
  1.  .. I +$G(BLRERRS(ERRDT))>1 W "s" ; if > 1 then make plural
  1.  .. W "."
  1.  .. W !
  1.  . S $P(^BLRSITE(BLRQSITE,0),U,9)=0 ; Clear BLR MASTER CONTROL (#9009029) file's STOP PROCESSOR field
  1.  ;
  1.  D BLRGPGR^BLRGMENU(20)           ; Press Return
  1.  ;
  1.  Q