- 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 Jan 18, 2025@02:41:19 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