LA7LOG ;DALOI/STAFF - Log events and errors from Lab Messaging ;11/16/11 12:14
;;5.2;AUTOMATED LAB INSTRUMENTS;**17,27,67,74**;Sep 27, 1994;Build 229
;
QUIT
;
CREATE(LA762485,LA7FLAG) ;
; Creates an entry in the log file to record events or errors
; while processing messages. The calling routine passes the
; ien for a bulletin in file 62.485.
; Requires the variables:
; LA762485 = 'ien of bulletin in 62.485'
; LA76248 = 'ien of config in 62.48 or null if none is defined'
; LA7FLAG = 1 (return error msg text)
;
; logging turned off
;I $G(LA7FLAG),'$P($G(^LAHM(62.48,+LA76248,0)),U,4) Q ""
;I '$P($G(^LAHM(62.48,+LA76248,0)),U,4) Q
;
N DA,DIE,DR,X,Y,DIERR
N LA7,LA7DT,LA7NOW,LA7TIM,LA7TXT,LOGIT
S LOGIT=$P($G(^LAHM(62.48,+LA76248,0)),U,4)
;
; change status to error.
I $G(LA76249)>0 D
. N LAFDA,LA7DIE
. S LAFDA(1,62.49,LA76249_",",2)="E"
. D FILE^DIE("","LAFDA(1)","LA7DIE(1)")
;
I 'LOGIT Q:$Q!($G(LA7FLAG)) "" Q ;
;
S LA7TXT=$P($G(^LAHM(62.485,LA762485,0)),"^",1,2)
S:LA7TXT="" LA7TXT="Log routine was called with a non-existent code number ("_LA762485_")."
I $G(^LAHM(62.485,LA762485,1))'="" X ^(1)
I $O(LA7TXT("")) D
. S LA7=""
. F S LA7=$O(LA7TXT(LA7)) Q:LA7="" D
. . S LA7TXT=$P(LA7TXT,"|"_LA7_"|")_LA7TXT(LA7)_$P(LA7TXT,"|"_LA7_"|",2)
; Set current date/time.
S LA7NOW=$$HTFM^XLFDT($H),LA7DT=LA7NOW\1,LA7TM=LA7NOW#1
;
; Set lock on XTMP global.
L +^XTMP("LA7ERR^"_LA7DT,0):99
I '$D(^XTMP("LA7ERR^"_LA7DT,0)) S ^XTMP("LA7ERR^"_LA7DT,0)=$$HTFM^XLFDT($H+7,1)_"^"_LA7DT_"^"_"Lab Messaging Error Log"
F Q:'$D(^XTMP("LA7ERR^"_LA7DT,LA7TM)) S LA7TM=LA7TM+.0000001
S ^XTMP("LA7ERR^"_LA7DT,LA7TM)=$G(LA76248)_"^"_$G(LA76249)_"^"_$P(LA7TXT,"^")_"^"_$$ENCODEUP^XMCU1($P(LA7TXT,"^",2,99))
; Release lock on XTMP global.
L -^XTMP("LA7ERR^"_LA7DT,0)
;
;; change status to error.
;I $G(LA76249) D
;. N LAFDA,LA7DIE
;. S LAFDA(1,62.49,LA76249_",",2)="E"
;. D FILE^DIE("","LAFDA(1)","LA7DIE(1)")
;
; Send alert
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))
;
I $G(LA7FLAG) Q LA7TXT
I $Q Q LA7TXT
Q
;
;
PRINT ;Print the error log which is stored in ^XTMP. Errors are
;logged only if the Debug Log field is turned on in 62.48
N DIR,LA7,LA76248,LA76249,LA7DT,LA7ETXT,LA7TM,LA7TXT,LA7XTMP
S DT=$$DT^XLFDT,LA7XTMP="LA7ERR^"_DT
I '$O(^XTMP(LA7XTMP,0)) W !!,?5,"Nothing logged for Today!"
E S DIR("B")="TODAY"
S DIR("A")="Look at log for what date? "
S DIR("?")="^D HELP^%DTC"
S DIR(0)="DAO^:DT:EX"
D ^DIR K DIR
Q:$D(DIRUT)
S LA7XTMP="LA7ERR^"_Y
I '$O(^XTMP(LA7XTMP,0)) D G PRINT
. W !!,?5,"Nothing logged for ",$$FMTE^XLFDT(Y)
S (LA76248,X,Y)=0 ; Find out if running multiple configurations.
F S X=$O(^LAHM(62.48,X)) Q:'X I $P($G(^LAHM(62.48,X,0)),"^",3) S Y=Y+1
I Y>1 D Q:'LA76248
. N DIC,X,Y
. S DIC="^LAHM(62.48,",DIC(0)="AEMQ",DIC("A")="Select CONFIGURATION: " D ^DIC
. I Y>0 S LA76248=+Y
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)
S LA7ETXT=Y ; Flag to print message text with error.
S %ZIS="Q"
D ^%ZIS
I POP D HOME^%ZIS K DIR,%ZIS,DIRUT,LA7XTMP QUIT
K ZTSK
I $D(IO("Q")) D QUIT
. S ZTDESC="Lab Interface Error Log",ZTRTN="START^LA7LOG"
. S ZTSAVE("LA7XTMP")=LA7XTMP
. S ZTSAVE("LA76248")=LA76248
. S ZTSAVE("LA7ETXT")=LA7ETXT
. D ^%ZTLOAD
. I $D(ZTSK) U IO(0) W !?5,"Report queued...",!!
. D ^%ZISC K ZTDESC,ZTDTH,ZTSAVE,ZTRTN,ZTSK
U IO
START ;
N LA76249,LA7FS,LA7QUIT,LA7SEG,LA7TM
S LA7TM=""
W:$Y @IOF
F S LA7TM=$O(^XTMP(LA7XTMP,LA7TM),-1) Q:LA7TM=0 D Q:LA7QUIT
. S LA7QUIT=0
. I LA76248,+^XTMP(LA7XTMP,LA7TM),+^XTMP(LA7XTMP,LA7TM)'=LA76248 Q ; Error message not for requested configuration.
. S LA76249=+$P(^XTMP(LA7XTMP,LA7TM),"^",2)
. I $Y>(IOSL-5) D Q:LA7QUIT
. . I '$D(ZTQUEUED),"Pp"'[$E(IOST) K DIR S DIR(0)="E" D ^DIR I 'Y S LA7QUIT=1 Q
. . W @IOF
. W:$X !! W $$FMTE^XLFDT($P(LA7XTMP,"^",2)+LA7TM)," "
. W $P(^XTMP(LA7XTMP,LA7TM),"^",3)," " S X=$$DECODEUP^XMCU1($P(^(LA7TM),"^",4,99))
. F LA7=1:1:$L(X," ") S Y=$P(X," ",LA7) W:($L(Y)+$X+1)>IOM ! W Y," "
. I 'LA76249!('LA7ETXT) Q ; Don't print message if no text or not requested.
. Q:'$O(^LAHM(62.49,LA76249,150,0))
. S LA7=0,LA7FS=" "
. F S LA7=$O(^LAHM(62.49,LA76249,150,LA7)) Q:'LA7 D Q:LA7QUIT
. . S LA7SEG=$G(^LAHM(62.49,LA76249,150,LA7,0))
. . I LA7SEG="" W ! Q
. . S LA7QUIT=0
. . I $Y>(IOSL-5) D Q:LA7QUIT
. . . I '$D(ZTQUEUED),"Pp"'[$E(IOST) K DIR S DIR(0)="E" D ^DIR I 'Y S LA7QUIT=1 Q
. . . W @IOF
. . I LA7FS=" ",$E(LA7SEG,1,3)?1(1"MSH",1"FSH",1"BSH") S LA7FS=$E(LA7SEG,4)
. . W !
. . F I=1:1:$L(LA7SEG,LA7FS) S Y=$P(LA7SEG,LA7FS,I) W:($L(Y)+$X+1)>IOM ! W ?2,Y,LA7FS
. W !
I $D(ZTQUEUED) S ZTREQ="@"
E D ^%ZISC
K LA7,LA76248,LA76249,LA7FS,LA7QUIT,LA7SEG,LA7TM,LA7XTMP
K DIR,DIRUT,DTOUT,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7LOG 5099 printed Nov 22, 2024@16:49:23 Page 2
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
+2 ;
+3 QUIT
+4 ;
CREATE(LA762485,LA7FLAG) ;
+1 ; Creates an entry in the log file to record events or errors
+2 ; while processing messages. The calling routine passes the
+3 ; ien for a bulletin in file 62.485.
+4 ; Requires the variables:
+5 ; LA762485 = 'ien of bulletin in 62.485'
+6 ; LA76248 = 'ien of config in 62.48 or null if none is defined'
+7 ; LA7FLAG = 1 (return error msg text)
+8 ;
+9 ; logging turned off
+10 ;I $G(LA7FLAG),'$P($G(^LAHM(62.48,+LA76248,0)),U,4) Q ""
+11 ;I '$P($G(^LAHM(62.48,+LA76248,0)),U,4) Q
+12 ;
+13 NEW DA,DIE,DR,X,Y,DIERR
+14 NEW LA7,LA7DT,LA7NOW,LA7TIM,LA7TXT,LOGIT
+15 SET LOGIT=$PIECE($GET(^LAHM(62.48,+LA76248,0)),U,4)
+16 ;
+17 ; change status to error.
+18 IF $GET(LA76249)>0
Begin DoDot:1
+19 NEW LAFDA,LA7DIE
+20 SET LAFDA(1,62.49,LA76249_",",2)="E"
+21 DO FILE^DIE("","LAFDA(1)","LA7DIE(1)")
End DoDot:1
+22 ;
+23 ;
IF 'LOGIT
if $QUIT!($GET(LA7FLAG))
QUIT ""
QUIT
+24 ;
+25 SET LA7TXT=$PIECE($GET(^LAHM(62.485,LA762485,0)),"^",1,2)
+26 if LA7TXT=""
SET LA7TXT="Log routine was called with a non-existent code number ("_LA762485_")."
+27 IF $GET(^LAHM(62.485,LA762485,1))'=""
XECUTE ^(1)
+28 IF $ORDER(LA7TXT(""))
Begin DoDot:1
+29 SET LA7=""
+30 FOR
SET LA7=$ORDER(LA7TXT(LA7))
if LA7=""
QUIT
Begin DoDot:2
+31 SET LA7TXT=$PIECE(LA7TXT,"|"_LA7_"|")_LA7TXT(LA7)_$PIECE(LA7TXT,"|"_LA7_"|",2)
End DoDot:2
End DoDot:1
+32 ; Set current date/time.
+33 SET LA7NOW=$$HTFM^XLFDT($HOROLOG)
SET LA7DT=LA7NOW\1
SET LA7TM=LA7NOW#1
+34 ;
+35 ; Set lock on XTMP global.
+36 LOCK +^XTMP("LA7ERR^"_LA7DT,0):99
+37 IF '$DATA(^XTMP("LA7ERR^"_LA7DT,0))
SET ^XTMP("LA7ERR^"_LA7DT,0)=$$HTFM^XLFDT($HOROLOG+7,1)_"^"_LA7DT_"^"_"Lab Messaging Error Log"
+38 FOR
if '$DATA(^XTMP("LA7ERR^"_LA7DT,LA7TM))
QUIT
SET LA7TM=LA7TM+.0000001
+39 SET ^XTMP("LA7ERR^"_LA7DT,LA7TM)=$GET(LA76248)_"^"_$GET(LA76249)_"^"_$PIECE(LA7TXT,"^")_"^"_$$ENCODEUP^XMCU1($PIECE(LA7TXT,"^",2,99))
+40 ; Release lock on XTMP global.
+41 LOCK -^XTMP("LA7ERR^"_LA7DT,0)
+42 ;
+43 ;; change status to error.
+44 ;I $G(LA76249) D
+45 ;. N LAFDA,LA7DIE
+46 ;. S LAFDA(1,62.49,LA76249_",",2)="E"
+47 ;. D FILE^DIE("","LAFDA(1)","LA7DIE(1)")
+48 ;
+49 ; Send alert
+50 IF $PIECE($GET(^LAHM(62.485,LA762485,0)),"^",3)
IF $DATA(^LAHM(62.48,+$GET(LA76248),20,"B",2))
DO XQA^LA7UXQA(2,$GET(LA76248),$GET(LA762485),$GET(LA76249),$GET(LA7AMSG))
+51 ;
+52 IF $GET(LA7FLAG)
QUIT LA7TXT
+53 IF $QUIT
QUIT LA7TXT
+54 QUIT
+55 ;
+56 ;
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
+2 NEW DIR,LA7,LA76248,LA76249,LA7DT,LA7ETXT,LA7TM,LA7TXT,LA7XTMP
+3 SET DT=$$DT^XLFDT
SET LA7XTMP="LA7ERR^"_DT
+4 IF '$ORDER(^XTMP(LA7XTMP,0))
WRITE !!,?5,"Nothing logged for Today!"
+5 IF '$TEST
SET DIR("B")="TODAY"
+6 SET DIR("A")="Look at log for what date? "
+7 SET DIR("?")="^D HELP^%DTC"
+8 SET DIR(0)="DAO^:DT:EX"
+9 DO ^DIR
KILL DIR
+10 if $DATA(DIRUT)
QUIT
+11 SET LA7XTMP="LA7ERR^"_Y
+12 IF '$ORDER(^XTMP(LA7XTMP,0))
Begin DoDot:1
+13 WRITE !!,?5,"Nothing logged for ",$$FMTE^XLFDT(Y)
End DoDot:1
GOTO PRINT
+14 ; Find out if running multiple configurations.
SET (LA76248,X,Y)=0
+15 FOR
SET X=$ORDER(^LAHM(62.48,X))
if 'X
QUIT
IF $PIECE($GET(^LAHM(62.48,X,0)),"^",3)
SET Y=Y+1
+16 IF Y>1
Begin DoDot:1
+17 NEW DIC,X,Y
+18 SET DIC="^LAHM(62.48,"
SET DIC(0)="AEMQ"
SET DIC("A")="Select CONFIGURATION: "
DO ^DIC
+19 IF Y>0
SET LA76248=+Y
End DoDot:1
if 'LA76248
QUIT
+20 SET DIR(0)="Y"
SET DIR("A")="Print message text with error"
SET DIR("B")="YES"
SET DIR("?",1)="Do you want the text of the message also printed with the error"
SET DIR("?")="Answer 'Y' or 'N'"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+21 ; Flag to print message text with error.
SET LA7ETXT=Y
+22 SET %ZIS="Q"
+23 DO ^%ZIS
+24 IF POP
DO HOME^%ZIS
KILL DIR,%ZIS,DIRUT,LA7XTMP
QUIT
+25 KILL ZTSK
+26 IF $DATA(IO("Q"))
Begin DoDot:1
+27 SET ZTDESC="Lab Interface Error Log"
SET ZTRTN="START^LA7LOG"
+28 SET ZTSAVE("LA7XTMP")=LA7XTMP
+29 SET ZTSAVE("LA76248")=LA76248
+30 SET ZTSAVE("LA7ETXT")=LA7ETXT
+31 DO ^%ZTLOAD
+32 IF $DATA(ZTSK)
USE IO(0)
WRITE !?5,"Report queued...",!!
+33 DO ^%ZISC
KILL ZTDESC,ZTDTH,ZTSAVE,ZTRTN,ZTSK
End DoDot:1
QUIT
+34 USE IO
START ;
+1 NEW LA76249,LA7FS,LA7QUIT,LA7SEG,LA7TM
+2 SET LA7TM=""
+3 if $Y
WRITE @IOF
+4 FOR
SET LA7TM=$ORDER(^XTMP(LA7XTMP,LA7TM),-1)
if LA7TM=0
QUIT
Begin DoDot:1
+5 SET LA7QUIT=0
+6 ; Error message not for requested configuration.
IF LA76248
IF +^XTMP(LA7XTMP,LA7TM)
IF +^XTMP(LA7XTMP,LA7TM)'=LA76248
QUIT
+7 SET LA76249=+$PIECE(^XTMP(LA7XTMP,LA7TM),"^",2)
+8 IF $Y>(IOSL-5)
Begin DoDot:2
+9 IF '$DATA(ZTQUEUED)
IF "Pp"'[$EXTRACT(IOST)
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF 'Y
SET LA7QUIT=1
QUIT
+10 WRITE @IOF
End DoDot:2
if LA7QUIT
QUIT
+11 if $X
WRITE !!
WRITE $$FMTE^XLFDT($PIECE(LA7XTMP,"^",2)+LA7TM)," "
+12 WRITE $PIECE(^XTMP(LA7XTMP,LA7TM),"^",3)," "
SET X=$$DECODEUP^XMCU1($PIECE(^(LA7TM),"^",4,99))
+13 FOR LA7=1:1:$LENGTH(X," ")
SET Y=$PIECE(X," ",LA7)
if ($LENGTH(Y)+$X+1)>IOM
WRITE !
WRITE Y," "
+14 ; Don't print message if no text or not requested.
IF 'LA76249!('LA7ETXT)
QUIT
+15 if '$ORDER(^LAHM(62.49,LA76249,150,0))
QUIT
+16 SET LA7=0
SET LA7FS=" "
+17 FOR
SET LA7=$ORDER(^LAHM(62.49,LA76249,150,LA7))
if 'LA7
QUIT
Begin DoDot:2
+18 SET LA7SEG=$GET(^LAHM(62.49,LA76249,150,LA7,0))
+19 IF LA7SEG=""
WRITE !
QUIT
+20 SET LA7QUIT=0
+21 IF $Y>(IOSL-5)
Begin DoDot:3
+22 IF '$DATA(ZTQUEUED)
IF "Pp"'[$EXTRACT(IOST)
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF 'Y
SET LA7QUIT=1
QUIT
+23 WRITE @IOF
End DoDot:3
if LA7QUIT
QUIT
+24 IF LA7FS=" "
IF $EXTRACT(LA7SEG,1,3)?1(1"MSH",1"FSH",1"BSH")
SET LA7FS=$EXTRACT(LA7SEG,4)
+25 WRITE !
+26 FOR I=1:1:$LENGTH(LA7SEG,LA7FS)
SET Y=$PIECE(LA7SEG,LA7FS,I)
if ($LENGTH(Y)+$X+1)>IOM
WRITE !
WRITE ?2,Y,LA7FS
End DoDot:2
if LA7QUIT
QUIT
+27 WRITE !
End DoDot:1
if LA7QUIT
QUIT
+28 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+29 IF '$TEST
DO ^%ZISC
+30 KILL LA7,LA76248,LA76249,LA7FS,LA7QUIT,LA7SEG,LA7TM,LA7XTMP
+31 KILL DIR,DIRUT,DTOUT,X,Y
+32 QUIT
