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

LA7LOG.m

Go to the documentation of this file. 
  1. LA7LOG ;DALOI/STAFF - Log events and errors from Lab Messaging ;11/16/11  12:14
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**17,27,67,74**;Sep 27, 1994;Build 229
  1.  ;
  1.  QUIT
  1.  ;
  1. CREATE(LA762485,LA7FLAG) ;
  1.  ; Creates an entry in the log file to record events or errors
  1.  ; while processing messages.  The calling routine passes the 
  1.  ; ien for a bulletin in file 62.485.
  1.  ; Requires the variables:
  1.  ; LA762485 = 'ien of bulletin in 62.485'
  1.  ; LA76248  = 'ien of config in 62.48 or null if none is defined'
  1.  ; LA7FLAG  = 1 (return error msg text)
  1.  ;
  1.  ; logging turned off
  1.  ;I $G(LA7FLAG),'$P($G(^LAHM(62.48,+LA76248,0)),U,4) Q ""
  1.  ;I '$P($G(^LAHM(62.48,+LA76248,0)),U,4) Q
  1.  ;
  1.  N DA,DIE,DR,X,Y,DIERR
  1.  N LA7,LA7DT,LA7NOW,LA7TIM,LA7TXT,LOGIT
  1.  S LOGIT=$P($G(^LAHM(62.48,+LA76248,0)),U,4)
  1.  ;
  1.  ; change status to error.
  1.  I $G(LA76249)>0 D
  1.  . N LAFDA,LA7DIE
  1.  . S LAFDA(1,62.49,LA76249_",",2)="E"
  1.  . D FILE^DIE("","LAFDA(1)","LA7DIE(1)")
  1.  ;
  1.  I 'LOGIT Q:$Q!($G(LA7FLAG)) ""  Q  ;
  1.  ;
  1.  S LA7TXT=$P($G(^LAHM(62.485,LA762485,0)),"^",1,2)
  1.  S:LA7TXT="" LA7TXT="Log routine was called with a non-existent code number ("_LA762485_")."
  1.  I $G(^LAHM(62.485,LA762485,1))'="" X ^(1)
  1.  I $O(LA7TXT("")) D
  1.  . S LA7=""
  1.  . F  S LA7=$O(LA7TXT(LA7)) Q:LA7=""  D
  1.  . . S LA7TXT=$P(LA7TXT,"|"_LA7_"|")_LA7TXT(LA7)_$P(LA7TXT,"|"_LA7_"|",2)
  1.  ; Set current date/time.
  1.  S LA7NOW=$$HTFM^XLFDT($H),LA7DT=LA7NOW\1,LA7TM=LA7NOW#1
  1.  ;
  1.  ; Set lock on XTMP global.
  1.  L +^XTMP("LA7ERR^"_LA7DT,0):99
  1.  I '$D(^XTMP("LA7ERR^"_LA7DT,0)) S ^XTMP("LA7ERR^"_LA7DT,0)=$$HTFM^XLFDT($H+7,1)_"^"_LA7DT_"^"_"Lab Messaging Error Log"
  1.  F  Q:'$D(^XTMP("LA7ERR^"_LA7DT,LA7TM))  S LA7TM=LA7TM+.0000001
  1.  S ^XTMP("LA7ERR^"_LA7DT,LA7TM)=$G(LA76248)_"^"_$G(LA76249)_"^"_$P(LA7TXT,"^")_"^"_$$ENCODEUP^XMCU1($P(LA7TXT,"^",2,99))
  1.  ; Release lock on XTMP global.
  1.  L -^XTMP("LA7ERR^"_LA7DT,0)
  1.  ;
  1.  ;; change status to error.
  1.  ;I $G(LA76249) D
  1.  ;. N LAFDA,LA7DIE
  1.  ;. S LAFDA(1,62.49,LA76249_",",2)="E"
  1.  ;. D FILE^DIE("","LAFDA(1)","LA7DIE(1)")
  1.  ;
  1.  ; Send alert
  1.  I $P($G(^LAHM(62.485,LA762485,0)),"^",3),$D(^LAHM(62.48,+$G(LA76248),20,"B",2)) D XQA^LA7UXQA(2,$G(LA76248),$G(LA762485),$G(LA76249),$G(LA7AMSG))
  1.  ;
  1.  I $G(LA7FLAG) Q LA7TXT
  1.  I $Q Q LA7TXT
  1.  Q
  1.  ;
  1.  ;
  1. PRINT ;Print the error log which is stored in ^XTMP.  Errors are
  1.  ;logged only if the Debug Log field is turned on in 62.48
  1.  N DIR,LA7,LA76248,LA76249,LA7DT,LA7ETXT,LA7TM,LA7TXT,LA7XTMP
  1.  S DT=$$DT^XLFDT,LA7XTMP="LA7ERR^"_DT
  1.  I '$O(^XTMP(LA7XTMP,0)) W !!,?5,"Nothing logged for Today!"
  1.  E  S DIR("B")="TODAY"
  1.  S DIR("A")="Look at log for what date? "
  1.  S DIR("?")="^D HELP^%DTC"
  1.  S DIR(0)="DAO^:DT:EX"
  1.  D ^DIR K DIR
  1.  Q:$D(DIRUT)
  1.  S LA7XTMP="LA7ERR^"_Y
  1.  I '$O(^XTMP(LA7XTMP,0)) D  G PRINT
  1.  . W !!,?5,"Nothing logged for ",$$FMTE^XLFDT(Y)
  1.  S (LA76248,X,Y)=0 ; Find out if running multiple configurations.
  1.  F  S X=$O(^LAHM(62.48,X)) Q:'X  I $P($G(^LAHM(62.48,X,0)),"^",3) S Y=Y+1
  1.  I Y>1 D  Q:'LA76248
  1.  . N DIC,X,Y
  1.  . S DIC="^LAHM(62.48,",DIC(0)="AEMQ",DIC("A")="Select CONFIGURATION: " D ^DIC
  1.  . I Y>0 S LA76248=+Y
  1.  S DIR(0)="Y",DIR("A")="Print message text with error",DIR("B")="YES",DIR("?",1)="Do you want the text of the message also printed with the error",DIR("?")="Answer 'Y' or 'N'" D ^DIR K DIR Q:$D(DIRUT)
  1.  S LA7ETXT=Y ; Flag to print message text with error.
  1.  S %ZIS="Q"
  1.  D ^%ZIS
  1.  I POP D HOME^%ZIS K DIR,%ZIS,DIRUT,LA7XTMP QUIT
  1.  K ZTSK
  1.  I $D(IO("Q")) D  QUIT
  1.  . S ZTDESC="Lab Interface Error Log",ZTRTN="START^LA7LOG"
  1.  . S ZTSAVE("LA7XTMP")=LA7XTMP
  1.  . S ZTSAVE("LA76248")=LA76248
  1.  . S ZTSAVE("LA7ETXT")=LA7ETXT
  1.  . D ^%ZTLOAD
  1.  . I $D(ZTSK) U IO(0) W !?5,"Report queued...",!!
  1.  . D ^%ZISC K ZTDESC,ZTDTH,ZTSAVE,ZTRTN,ZTSK
  1.  U IO
  1. START ;
  1.  N LA76249,LA7FS,LA7QUIT,LA7SEG,LA7TM
  1.  S LA7TM=""
  1.  W:$Y @IOF
  1.  F  S LA7TM=$O(^XTMP(LA7XTMP,LA7TM),-1) Q:LA7TM=0  D  Q:LA7QUIT
  1.  . S LA7QUIT=0
  1.  . I LA76248,+^XTMP(LA7XTMP,LA7TM),+^XTMP(LA7XTMP,LA7TM)'=LA76248 Q  ; Error message not for requested configuration.
  1.  . S LA76249=+$P(^XTMP(LA7XTMP,LA7TM),"^",2)
  1.  . I $Y>(IOSL-5) D  Q:LA7QUIT
  1.  . . I '$D(ZTQUEUED),"Pp"'[$E(IOST) K DIR S DIR(0)="E" D ^DIR I 'Y S LA7QUIT=1 Q
  1.  . . W @IOF
  1.  . W:$X !! W $$FMTE^XLFDT($P(LA7XTMP,"^",2)+LA7TM)," "
  1.  . W $P(^XTMP(LA7XTMP,LA7TM),"^",3)," " S X=$$DECODEUP^XMCU1($P(^(LA7TM),"^",4,99))
  1.  . F LA7=1:1:$L(X," ") S Y=$P(X," ",LA7) W:($L(Y)+$X+1)>IOM ! W Y," "
  1.  . I 'LA76249!('LA7ETXT) Q  ; Don't print message if no text or not requested.
  1.  . Q:'$O(^LAHM(62.49,LA76249,150,0))
  1.  . S LA7=0,LA7FS=" "
  1.  . F  S LA7=$O(^LAHM(62.49,LA76249,150,LA7)) Q:'LA7  D  Q:LA7QUIT
  1.  . . S LA7SEG=$G(^LAHM(62.49,LA76249,150,LA7,0))
  1.  . . I LA7SEG="" W ! Q
  1.  . . S LA7QUIT=0
  1.  . . I $Y>(IOSL-5) D  Q:LA7QUIT
  1.  . . . I '$D(ZTQUEUED),"Pp"'[$E(IOST) K DIR S DIR(0)="E" D ^DIR I 'Y S LA7QUIT=1 Q
  1.  . . . W @IOF
  1.  . . I LA7FS=" ",$E(LA7SEG,1,3)?1(1"MSH",1"FSH",1"BSH") S LA7FS=$E(LA7SEG,4)
  1.  . . W !
  1.  . . F I=1:1:$L(LA7SEG,LA7FS) S Y=$P(LA7SEG,LA7FS,I) W:($L(Y)+$X+1)>IOM ! W ?2,Y,LA7FS
  1.  . W !
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  E  D ^%ZISC
  1.  K LA7,LA76248,LA76249,LA7FS,LA7QUIT,LA7SEG,LA7TM,LA7XTMP
  1.  K DIR,DIRUT,DTOUT,X,Y
  1.  Q