LA7UXQA ;DALOI/JMC - HL7 Utility - Send alert to users ;04/13/10 14:41
;;5.2;AUTOMATED LAB INSTRUMENTS;**27,67,74**;Sep 27, 1994;Build 229
;
XQA(LA7CTYP,LA76248,LA762485,LA76249,LA7AMSG,LA7DATA,LA7PALRT) ; Send alert when requested.
; Input
; LA7CTYP - Condition for alert (1=New Results, 2=Error on message, 3=New Orders)
; LA76248 - Pointer to file 62.48
; LA762485 - Optional, pointer to file 62.485 if condition=2
; LA76249 - Optional, pointer to file 62.49 if condition=2 or 3
; LA7AMSG - Optional, alert message, if missing will use default message^id to add to XQAID
; LA7DATA - Optional, pass values for specific conditions
; LA7PALRT - Keep previous alerts (1-yes,0-no)
;
; Called by LA7LOG, LA7UIIN, LA7VORM, LRVRPOC, LA7VIN1
;
N XQA,XQADATA,XQAFLAG,XQAID,XQAMSG,XQAOPT,XQAROU,X,Y
S XQAMSG=$P($G(LA7AMSG),"^"),XQAID=""
;
I $G(LA7CTYP)=1 D
. S XQAID="LA7-CONFIG-"_$S($G(LA76248):LA76248,1:"UNKNOWN-"_$H)
. I XQAMSG="" S XQAMSG="Lab Messaging - New results received for "_$P($G(^LAHM(62.48,+$G(LA76248),0),"UNKNOWN"),"^")
;
I $G(LA7CTYP)=2 D
. S XQAID="LA7-MESSAGE-"_$S($G(LA76249):LA76249,1:"UNKNOWN-"_$H)
. I XQAMSG="" S XQAMSG="Lab Messaging error #"_$G(LA762485,"UNKNOWN")_" on message #"_$G(LA76249,"UNKNOWN")_" at "_$$HTE^XLFDT($H,"2M")
. I $G(LA76249) D ; Error processing message, setup action alert.
. . S XQAROU="DIS^LA7UXQA" ; Alert action.
. . S XQADATA=LA76249 ; Alert data (ien of message in 62.49, date of error and error number).
;
I $G(LA7CTYP)=3 D
. S LA7DATA=$G(LA7DATA)
. S XQAID="LA7-ORDERS-"_$S(LA7DATA'="":$P(LA7DATA,"^"),$G(LA76249):LA76249,1:"UNKNOWN-"_$H)
. I XQAMSG="" S XQAMSG="Lab Messaging - Manifest# "_$P(LA7DATA,"^")_" received from "_$P($G(^LAHM(62.48,+$G(LA76248),0),"UNKNOWN"),"^")
;
I $P($G(LA7AMSG),"^",2)'="" S XQAID=XQAID_$S(XQAID'="":"-",1:"")_$P(LA7AMSG,"^",2)
;
; Determine mail group
S X=""
F S X=$O(^LAHM(62.48,+$G(LA76248),20,"B",LA7CTYP,X)) Q:'X D
. S Y=$G(^LAHM(62.48,LA76248,20,X,0))
. I $P(Y,"^",2)'="" S XQA("G."_$P(Y,"^",2))="" ; Send to mail group.
;
; Fail safe mail group when no mail group defined.
I '$D(XQA) S XQA("G.LAB MESSAGING")=""
;
; Delete previous alerts with same id
I '$G(LA7PALRT),$G(XQAID)'="" D DEL(XQAID)
;
D SETUP^XQALERT
Q
;
;
DEL(ID) ; Delete previous alerts if present
; Call with ID = alert id
; Clear previous alert with same pkg id.
N XQAID,XQAKLL,XQAMSG,XQAROU,XQADATA,XQA
S XQAKLL=0
S XQAID=ID
D DELETEA^XQALERT
Q
;
;
DIS ; Display alert
;
;ZEXCEPT: XQADATA
;
N DIR,I,J,K,LA7LIST,X,Y
K ^TMP("DDB",$J),^TMP($J)
I 'XQADATA W !,$C(7),"Missing message number, unable to proceed.",! Q
I '$D(^LAHM(62.49,XQADATA)) W !,$C(7),"Message number# ",XQADATA," has been deleted, unable to proceed.",! Q
S DIR(0)="YO",DIR("A")="Display message associated with this alert",DIR("B")="YES"
D ^DIR K DIR
I Y S LA7LIST(+XQADATA)="" D DEV^LA7UTILA
Q
;
;
DISIC ; Display Integrity Checker alert.
;
;ZEXCEPT: XQADATA
;
N DIR,I,J,K,LA7IC,X,Y
I XQADATA="" D Q
. W !,$C(7),"Missing error report to display, unable to proceed.",!
;
I '$D(^XTMP(XQADATA)) D Q
. W !,$C(7),"Message number# ",XQADATA," has been deleted, unable to proceed.",!
;
S DIR(0)="YO",DIR("A")="Display Integrity Check Report associated with this alert",DIR("B")="YES"
D ^DIR K DIR
I Y S LA7IC=XQADATA D DEV^LA7CHKFP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7UXQA 3453 printed Dec 13, 2024@01:40:05 Page 2
LA7UXQA ;DALOI/JMC - HL7 Utility - Send alert to users ;04/13/10 14:41
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,67,74**;Sep 27, 1994;Build 229
+2 ;
XQA(LA7CTYP,LA76248,LA762485,LA76249,LA7AMSG,LA7DATA,LA7PALRT) ; Send alert when requested.
+1 ; Input
+2 ; LA7CTYP - Condition for alert (1=New Results, 2=Error on message, 3=New Orders)
+3 ; LA76248 - Pointer to file 62.48
+4 ; LA762485 - Optional, pointer to file 62.485 if condition=2
+5 ; LA76249 - Optional, pointer to file 62.49 if condition=2 or 3
+6 ; LA7AMSG - Optional, alert message, if missing will use default message^id to add to XQAID
+7 ; LA7DATA - Optional, pass values for specific conditions
+8 ; LA7PALRT - Keep previous alerts (1-yes,0-no)
+9 ;
+10 ; Called by LA7LOG, LA7UIIN, LA7VORM, LRVRPOC, LA7VIN1
+11 ;
+12 NEW XQA,XQADATA,XQAFLAG,XQAID,XQAMSG,XQAOPT,XQAROU,X,Y
+13 SET XQAMSG=$PIECE($GET(LA7AMSG),"^")
SET XQAID=""
+14 ;
+15 IF $GET(LA7CTYP)=1
Begin DoDot:1
+16 SET XQAID="LA7-CONFIG-"_$SELECT($GET(LA76248):LA76248,1:"UNKNOWN-"_$HOROLOG)
+17 IF XQAMSG=""
SET XQAMSG="Lab Messaging - New results received for "_$PIECE($GET(^LAHM(62.48,+$GET(LA76248),0),"UNKNOWN"),"^")
End DoDot:1
+18 ;
+19 IF $GET(LA7CTYP)=2
Begin DoDot:1
+20 SET XQAID="LA7-MESSAGE-"_$SELECT($GET(LA76249):LA76249,1:"UNKNOWN-"_$HOROLOG)
+21 IF XQAMSG=""
SET XQAMSG="Lab Messaging error #"_$GET(LA762485,"UNKNOWN")_" on message #"_$GET(LA76249,"UNKNOWN")_" at "_$$HTE^XLFDT($HOROLOG,"2M")
+22 ; Error processing message, setup action alert.
IF $GET(LA76249)
Begin DoDot:2
+23 ; Alert action.
SET XQAROU="DIS^LA7UXQA"
+24 ; Alert data (ien of message in 62.49, date of error and error number).
SET XQADATA=LA76249
End DoDot:2
End DoDot:1
+25 ;
+26 IF $GET(LA7CTYP)=3
Begin DoDot:1
+27 SET LA7DATA=$GET(LA7DATA)
+28 SET XQAID="LA7-ORDERS-"_$SELECT(LA7DATA'="":$PIECE(LA7DATA,"^"),$GET(LA76249):LA76249,1:"UNKNOWN-"_$HOROLOG)
+29 IF XQAMSG=""
SET XQAMSG="Lab Messaging - Manifest# "_$PIECE(LA7DATA,"^")_" received from "_$PIECE($GET(^LAHM(62.48,+$GET(LA76248),0),"UNKNOWN"),"^")
End DoDot:1
+30 ;
+31 IF $PIECE($GET(LA7AMSG),"^",2)'=""
SET XQAID=XQAID_$SELECT(XQAID'="":"-",1:"")_$PIECE(LA7AMSG,"^",2)
+32 ;
+33 ; Determine mail group
+34 SET X=""
+35 FOR
SET X=$ORDER(^LAHM(62.48,+$GET(LA76248),20,"B",LA7CTYP,X))
if 'X
QUIT
Begin DoDot:1
+36 SET Y=$GET(^LAHM(62.48,LA76248,20,X,0))
+37 ; Send to mail group.
IF $PIECE(Y,"^",2)'=""
SET XQA("G."_$PIECE(Y,"^",2))=""
End DoDot:1
+38 ;
+39 ; Fail safe mail group when no mail group defined.
+40 IF '$DATA(XQA)
SET XQA("G.LAB MESSAGING")=""
+41 ;
+42 ; Delete previous alerts with same id
+43 IF '$GET(LA7PALRT)
IF $GET(XQAID)'=""
DO DEL(XQAID)
+44 ;
+45 DO SETUP^XQALERT
+46 QUIT
+47 ;
+48 ;
DEL(ID) ; Delete previous alerts if present
+1 ; Call with ID = alert id
+2 ; Clear previous alert with same pkg id.
+3 NEW XQAID,XQAKLL,XQAMSG,XQAROU,XQADATA,XQA
+4 SET XQAKLL=0
+5 SET XQAID=ID
+6 DO DELETEA^XQALERT
+7 QUIT
+8 ;
+9 ;
DIS ; Display alert
+1 ;
+2 ;ZEXCEPT: XQADATA
+3 ;
+4 NEW DIR,I,J,K,LA7LIST,X,Y
+5 KILL ^TMP("DDB",$JOB),^TMP($JOB)
+6 IF 'XQADATA
WRITE !,$CHAR(7),"Missing message number, unable to proceed.",!
QUIT
+7 IF '$DATA(^LAHM(62.49,XQADATA))
WRITE !,$CHAR(7),"Message number# ",XQADATA," has been deleted, unable to proceed.",!
QUIT
+8 SET DIR(0)="YO"
SET DIR("A")="Display message associated with this alert"
SET DIR("B")="YES"
+9 DO ^DIR
KILL DIR
+10 IF Y
SET LA7LIST(+XQADATA)=""
DO DEV^LA7UTILA
+11 QUIT
+12 ;
+13 ;
DISIC ; Display Integrity Checker alert.
+1 ;
+2 ;ZEXCEPT: XQADATA
+3 ;
+4 NEW DIR,I,J,K,LA7IC,X,Y
+5 IF XQADATA=""
Begin DoDot:1
+6 WRITE !,$CHAR(7),"Missing error report to display, unable to proceed.",!
End DoDot:1
QUIT
+7 ;
+8 IF '$DATA(^XTMP(XQADATA))
Begin DoDot:1
+9 WRITE !,$CHAR(7),"Message number# ",XQADATA," has been deleted, unable to proceed.",!
End DoDot:1
QUIT
+10 ;
+11 SET DIR(0)="YO"
SET DIR("A")="Display Integrity Check Report associated with this alert"
SET DIR("B")="YES"
+12 DO ^DIR
KILL DIR
+13 IF Y
SET LA7IC=XQADATA
DO DEV^LA7CHKFP
+14 QUIT
