LA7VCN1A ;VHA/DALOI/JMC - Process Incoming UI Msgs, continued ; 22-Oct-2013 09:22 ; MAW
;;5.2;AUTOMATED LAB INSTRUMENTS;**64,1027,1033**;NOV 01, 1997
; This routine is a continuation of LA7VIN1.
; It performs generation of any mail bulletins needed.
;
; Reference to DUZ^XUP supported by DBIA #4129
Q
;
;
SENDARB ; Send amended report bulletin
N LA76304,LA7BODY,LA7I,LA7IQSN,LA7TSK,LA7X,LWL
N XMBODY,XMDUZ,XMBNAME,XMINSTR,XMPARM,XMTO,X,Y
N XQA,XQAID,XQADATA,XQAFLAG,XQAMSG,XQAOPT,XQAROU
;
I '$G(DUZ) D DUZ^XUP(.5)
S XMBNAME="LA7 AMENDED RESULTS RECEIVED"
S LA7I=0
F S LA7I=$O(^TMP("LA7 AMENDED RESULTS",$J,LA7I)) Q:'LA7I D
. S LA7I(0)=^TMP("LA7 AMENDED RESULTS",$J,LA7I)
. S LWL=$P(LA7I(0),"^",1),LA7ISQN=$P(LA7I(0),"^",2),LA76304=$P(LA7I(0),"^",3)
. S XMPARM(1)=$$GET1^DIQ(62.48,$P(LA7I(0),"^",4)_",",.01)
. S XMPARM(2)=$P(LA7I(0),"^",5)
. S XMPARM(3)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","PNM"))
. S XMPARM(4)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","SSN"))
. S XMPARM(5)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID"))
. S XMPARM(6)=$$FMTE^XLFDT($G(^LAH(LWL,1,LA7ISQN,.1,"OBR","ORCDT")),"MZ")
.S XMPARM(7)=$P(LA7I(0),"^",8)_" ["_$P(LA7I(0),"^",7)_"]"
. S X=$G(^LAH(LWL,1,LA7ISQN,LA76304)),X(5)=$P(X,"^",5)
. S XMPARM(8)=$$GET1^DIQ(4,$P(X,"^",9)_",",.01)
. S XMPARM(9)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","FID"))
. S XMPARM(10)=$P(X,"^")
. S XMPARM(11)=$P(X(5),"!",7)
. S XMPARM(12)=$P(X(5),"!",2)_$S($P(X(5),"!",3)'="":"-"_$P(X(5),"!",3),1:"")
. S LA7X=$P(LA7I(0),"^",9),X=" L^ H^LL^HH^ <^ >^ N^ A^AA^ U^ D^ B^ W^ S^ R^ I^MS^VS"
. S I=$F(X,LA7X)\3 S:I LA7X=$P($T(ABFLAGS+I^LA7VHLU1),";;",2)
. S XMPARM(13)=LA7X
. S X="UNKNOWN"
. I $P(LA7I(0),"^",6)="C" S X="Record coming over is a correction and thus replaces a final result"
. I $P(LA7I(0),"^",6)="D" S X="Deletes the OBX record"
. I $P(LA7I(0),"^",6)="W" S X="Post original as wrong, e.g., transmitted for wrong patient"
. S XMPARM(14)=X
. S LA7BODY(1)=" ",LA7BODY(2)="Comments:"
. S I=0
. F S I=$O(^LAH(LWL,1,LA7ISQN,1,I)) Q:'I S LA7BODY(I+2)=$P(^(I),"^")
. D SMB
. S XQAMSG="Lab Messaging - Amended results received from "_XMPARM(1),XQAID="LA7-AMENDED-"_XMPARM(1)
. D SA
;
K ^TMP("LA7 AMENDED RESULTS",$J)
;
Q
;
;
SENDOSB ; Send order status bulletin when status not OK.
;
N I,J,K,LA76248,LA7BODY,LA7I,LA7IQSN,LA7ONLT,LA7TSK,LA7X,LWL
N X,XMDUZ,XMBNAME,XMINSTR,XMPARM,XMBODY,XMTO
I '$G(DUZ) D DUZ^XUP(.5)
;
S XMBNAME="LA7 ORDER STATUS CHANGED"
S LA7I=0
F S LA7I=$O(^TMP("LA7 ORDER STATUS",$J,LA7I)) Q:'LA7I D
. S LA7I(0)=^TMP("LA7 ORDER STATUS",$J,LA7I)
. S LWL=$P(LA7I(0),"^",1),LA7ISQN=$P(LA7I(0),"^",2),LA7ONLT=$P(LA7I(0),"^",3),LA76248=$P(LA7I(0),"^",5)
. S X="UNKNOWN"
. I $P(LA7I(0),"^",7)="UA" S X="Unable to accept order/service"
. I $P(LA7I(0),"^",7)="OC" S X="Order/service cancel"
. I $P(LA7I(0),"^",7)="CR" S X="Canceled as requested"
. I $P(LA7I(0),"^",8)="A" S X="Add ordered tests to the existing specimen"
. I $P(LA7I(0),"^",8)="G" S X="Generated order; reflex order"
. I $P(LA7I(0),"^",8)?1(1"A",1"G") Q:'$$CHKOK(LA7I)
. S XMPARM(1)=X
. S XMPARM(2)=$$GET1^DIQ(62.48,LA76248_",",.01)
. S XMPARM(3)=$P(LA7I(0),"^",6)
. S XMPARM(4)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","PNM"))
. S XMPARM(5)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","SSN"))
. S XMPARM(6)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID"))
. S XMPARM(7)=$$FMTE^XLFDT($G(^LAH(LWL,1,LA7ISQN,.1,"OBR","ORCDT")),"MZ")
. S XMPARM(8)=$P(LA7I(0),"^",4)_" ["_$P(LA7I(0),"^",3)_"]"
. S XMPARM(9)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","FID"))
. S XMPARM(10)=$P(LA7I(0),"^",9)
. S J=2,LA7BODY(1)=" ",LA7BODY(2)="Comments:"
. F K="MSA","OCR" D
. . S X=$G(^TMP("LA7 ORDER STATUS",$J,LA7I,K))
. . I X'="" S J=J+1,LA7BODY(J)=X
. S I=0
. F S I=$O(^LAH(LWL,1,LA7ISQN,1,I)) Q:'I S J=J+1,LA7BODY(J)=$P(^(I),"^")
. D SMB
. S XQAMSG="Lab Messaging - Order status change received from "_XMPARM(2),XQAID="LA7-ORDER STATUS-"_XMPARM(2)
. D SA
;
K ^TMP("LA7 ORDER STATUS",$J)
;
Q
;
;
SENDUNCB ; Send units/normals changed bulletin
;
N LA76248,LA76304,LA7BODY,LA7I,LA7IQSN,LA7TSK,LA7X,LWL
N XMBODY,XMDUZ,XMBNAME,XMINSTR,XMPARM,XMTO,X,Y
N XQA,XQAID,XQADATA,XQAFLAG,XQAMSG,XQAOPT,XQAROU
;
I '$G(DUZ) D DUZ^XUP(.5)
S XMBNAME="LA7 UNITS/NORMALS CHANGED"
S LA7I=0
F S LA7I=$O(^TMP("LA7 UNITS/NORMALS CHANGED",$J,LA7I)) Q:'LA7I D
. S LA7I(0)=^TMP("LA7 UNITS/NORMALS CHANGED",$J,LA7I)
. S LWL=$P(LA7I(0),"^",1),LA7ISQN=$P(LA7I(0),"^",2),LA76304=$P(LA7I(0),"^",3),LA76248=$P(LA7I(0),"^",4)
. S XMPARM(1)=$$GET1^DIQ(62.48,LA76248_",",.01)
. S XMPARM(2)=$P(LA7I(0),"^",5)
. S XMPARM(3)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","PNM"))
. S XMPARM(4)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","SSN"))
. S XMPARM(5)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID"))
. S XMPARM(6)=$$FMTE^XLFDT($G(^LAH(LWL,1,LA7ISQN,.1,"OBR","ORCDT")),"MZ")
.S XMPARM(7)=$P(LA7I(0),"^",8)_" ["_$P(LA7I(0),"^",7)_"]"
. S X=$G(^LAH(LWL,1,LA7ISQN,LA76304)),X(5)=$P(X,"^",5)
. S XMPARM(8)=$$GET1^DIQ(4,$P(X,"^",9)_",",.01)
. S XMPARM(9)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","FID"))
. S XMPARM(10)=$$GET1^DIQ(60,$P(LA7I(0),"^",10)_",",.01)
. S XMPARM(11)=$P(X(5),"!",7)
. S XMPARM(12)=$P(X(5),"!",2)_$S($P(X(5),"!",3)'="":"-"_$P(X(5),"!",3),1:"")
. S XMTO("G."_$$FAMG^LA7VHLU1(LA76248,2))=""
. D SMB
. S XQAMSG="Lab Messaging - Reference Lab Units/Normals Change received from "_XMPARM(1),XQAID="LA7-UNITS/NORMALS-CHANGED-"_XMPARM(1)
. D SA
;
K ^TMP("LA7 UNITS/NORMALS CHANGED",$J)
;
Q
;
;
SENDACB ; Send abnormal/critical bulletin
;
N LA76248,LA76304,LA7BODY,LA7I,LA7IQSN,LA7TSK,LA7X,LWL
N XMBODY,XMDUZ,XMBNAME,XMINSTR,XMPARM,XMTO,X,Y
N XQA,XQAID,XQADATA,XQAFLAG,XQAMSG,XQAOPT,XQAROU
;
I '$G(DUZ) D DUZ^XUP(.5)
S XMBNAME="LA7 ABNORMAL RESULTS RECEIVED"
S LA7I=0
F S LA7I=$O(^TMP("LA7 ABNORMAL RESULTS",$J,LA7I)) Q:'LA7I D
. S LA7I(0)=^TMP("LA7 ABNORMAL RESULTS",$J,LA7I)
. S LWL=$P(LA7I(0),"^",1),LA7ISQN=$P(LA7I(0),"^",2),LA76304=$P(LA7I(0),"^",3),LA76248=$P(LA7I(0),"^",4)
. S XMPARM(1)=$$GET1^DIQ(62.48,LA76248_",",.01)
. S XMPARM(2)=$P(LA7I(0),"^",5)
. S XMPARM(3)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","PNM"))
. S XMPARM(4)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","SSN"))
. S XMPARM(5)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID"))
. S XMPARM(6)=$$FMTE^XLFDT($G(^LAH(LWL,1,LA7ISQN,.1,"OBR","ORCDT")),"MZ")
.S XMPARM(7)=$P(LA7I(0),"^",8)_" ["_$P(LA7I(0),"^",7)_"]"
. S X=$G(^LAH(LWL,1,LA7ISQN,LA76304)),X(5)=$P(X,"^",5)
. S XMPARM(8)=$$GET1^DIQ(4,$P(X,"^",9)_",",.01)
. S XMPARM(9)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","FID"))
. S XMPARM(10)=$P(X,"^")
. S XMPARM(11)=$P(X(5),"!",7)
. S XMPARM(12)=$P(X(5),"!",2)_$S($P(X(5),"!",3)'="":"-"_$P(X(5),"!",3),1:"")
. S LA7X=$P(LA7I(0),"^",9),X=" L^ H^LL^HH^ <^ >^ N^ A^AA^ U^ D^ B^ W^ S^ R^ I^MS^VS"
. S I=$F(X,LA7X)\3 S:I LA7X=$P($T(ABFLAGS+I^LA7VHLU1),";;",2)
. S XMPARM(13)=LA7X
. D SMB
. S XQAMSG="Lab Messaging - Reference Lab Abnormal Results received from "_XMPARM(1),XQAID="LA7-ABNORMAL-RESULTS-"_XMPARM(1)
. D SA
. ;D:$P($G(^BLRSITE(BLRQSITE,0)),U,10) ENTRYAUD^BLRUTIL("SENDACB^LA7VCN1A 9.0","XMPARM","LA7I") ; <<<< DEBUG
;
K ^TMP("LA7 ABNORMAL RESULTS",$J)
;
Q
;
;
SMB ; Send mail bulletin
; Ignore any restrictions (domain closed or protected by security key)
;
S XMINSTR("ADDR FLAGS")="R"
S XMINSTR("FROM")="LAB PACKAGE"
S XMTO("G."_$$FAMG^LA7VHLU1(LA76248,1))=""
D SENDBULL^XMXAPI(DUZ,XMBNAME,.XMPARM,$S($D(LA7BODY):"LA7BODY",1:""),.XMTO,.XMINSTR,.LA7TSK,"")
;
Q
;
;
SA ; Send alert
;
; ---- BEGIN IHS/OIT/MKK -- LR*5.2*1027 -- Send information via alert as well
K XQADATA,XQAROU
S XQADATA=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","PNM"))
S XQADATA=XQADATA_"^"_$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID"))
S XQADATA=XQADATA_"^"_$P(LA7I(0),"^",8)_" ["_$P(LA7I(0),"^",7)_"]"
S XQAROU="ALERT^BLRUTIL3"
; ---- END IHS/OIT/MKK -- LR*5.2*1027
;
M XQA=XMTO
D DEL^LA7UXQA(XQAID)
D SETUP^XQALERT
;
Q
;
;
CHKOK(LA7INDX) ; Check if ok to send bulletin on added/reflexed tests order change
; Returns OK = 1 if results associated with added/reflex test are not
; on the accession.
; OK = 0 if accession already has tests on accession.
;
N LA760,LA7AA,LA7AD,LA7AN,LA7I,LA7TREEN,LRUID,OK,X
S OK=1,LRUID=$P($G(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID")),"^")
;
; Store all tests accessioned in ^TMP
S X=$Q(^LRO(68,"C",LRUID))
I X'="",$QS(X,3)=LRUID D
. K ^TMP("LA7TREE",$J)
. S LA7AA=$QS(X,4),LA7AD=$QS(X,5),LA7AN=$QS(X,6),LA7I=0
. F S LA7I=$O(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA7I)) Q:'LA7I D UNWIND^LA7UTIL(LA7I)
. S (LA7I,OK)=0
. F S LA7I=$O(^TMP("LA7 ORDER STATUS",$J,LA7INDX,LA7I)) Q:'LA7I D Q:OK
. . I '$D(^TMP("LA7TREE",$J,LA7I)) S OK=1 ;wasn't ordered
. K ^TMP("LA7TREE",$J)
Q OK
LA7VCN1A ;VHA/DALOI/JMC - Process Incoming UI Msgs, continued ; 22-Oct-2013 09:22 ; MAW
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**64,1027,1033**;NOV 01, 1997
+2 ; This routine is a continuation of LA7VIN1.
+3 ; It performs generation of any mail bulletins needed.
+4 ;
+5 ; Reference to DUZ^XUP supported by DBIA #4129
+6 QUIT
+7 ;
+8 ;
SENDARB ; Send amended report bulletin
+1 NEW LA76304,LA7BODY,LA7I,LA7IQSN,LA7TSK,LA7X,LWL
+2 NEW XMBODY,XMDUZ,XMBNAME,XMINSTR,XMPARM,XMTO,X,Y
+3 NEW XQA,XQAID,XQADATA,XQAFLAG,XQAMSG,XQAOPT,XQAROU
+4 ;
+5 IF '$GET(DUZ)
DO DUZ^XUP(.5)
+6 SET XMBNAME="LA7 AMENDED RESULTS RECEIVED"
+7 SET LA7I=0
+8 FOR
SET LA7I=$ORDER(^TMP("LA7 AMENDED RESULTS",$JOB,LA7I))
IF 'LA7I
QUIT
Begin DoDot:1
+9 SET LA7I(0)=^TMP("LA7 AMENDED RESULTS",$JOB,LA7I)
+10 SET LWL=$PIECE(LA7I(0),"^",1)
SET LA7ISQN=$PIECE(LA7I(0),"^",2)
SET LA76304=$PIECE(LA7I(0),"^",3)
+11 SET XMPARM(1)=$$GET1^DIQ(62.48,$PIECE(LA7I(0),"^",4)_",",.01)
+12 SET XMPARM(2)=$PIECE(LA7I(0),"^",5)
+13 SET XMPARM(3)=$GET(^LAH(LWL,1,LA7ISQN,.1,"PID","PNM"))
+14 SET XMPARM(4)=$GET(^LAH(LWL,1,LA7ISQN,.1,"PID","SSN"))
+15 SET XMPARM(5)=$GET(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID"))
+16 SET XMPARM(6)=$$FMTE^XLFDT($GET(^LAH(LWL,1,LA7ISQN,.1,"OBR","ORCDT")),"MZ")
+17 SET XMPARM(7)=$PIECE(LA7I(0),"^",8)_" ["_$PIECE(LA7I(0),"^",7)_"]"
+18 SET X=$GET(^LAH(LWL,1,LA7ISQN,LA76304))
SET X(5)=$PIECE(X,"^",5)
+19 SET XMPARM(8)=$$GET1^DIQ(4,$PIECE(X,"^",9)_",",.01)
+20 SET XMPARM(9)=$GET(^LAH(LWL,1,LA7ISQN,.1,"OBR","FID"))
+21 SET XMPARM(10)=$PIECE(X,"^")
+22 SET XMPARM(11)=$PIECE(X(5),"!",7)
+23 SET XMPARM(12)=$PIECE(X(5),"!",2)_$SELECT($PIECE(X(5),"!",3)'="":"-"_$PIECE(X(5),"!",3),1:"")
+24 SET LA7X=$PIECE(LA7I(0),"^",9)
SET X=" L^ H^LL^HH^ <^ >^ N^ A^AA^ U^ D^ B^ W^ S^ R^ I^MS^VS"
+25 SET I=$FIND(X,LA7X)\3
IF I
SET LA7X=$PIECE($TEXT(ABFLAGS+I^LA7VHLU1),";;",2)
+26 SET XMPARM(13)=LA7X
+27 SET X="UNKNOWN"
+28 IF $PIECE(LA7I(0),"^",6)="C"
SET X="Record coming over is a correction and thus replaces a final result"
+29 IF $PIECE(LA7I(0),"^",6)="D"
SET X="Deletes the OBX record"
+30 IF $PIECE(LA7I(0),"^",6)="W"
SET X="Post original as wrong, e.g., transmitted for wrong patient"
+31 SET XMPARM(14)=X
+32 SET LA7BODY(1)=" "
SET LA7BODY(2)="Comments:"
+33 SET I=0
+34 FOR
SET I=$ORDER(^LAH(LWL,1,LA7ISQN,1,I))
IF 'I
QUIT
SET LA7BODY(I+2)=$PIECE(^(I),"^")
+35 DO SMB
+36 SET XQAMSG="Lab Messaging - Amended results received from "_XMPARM(1)
SET XQAID="LA7-AMENDED-"_XMPARM(1)
+37 DO SA
End DoDot:1
+38 ;
+39 KILL ^TMP("LA7 AMENDED RESULTS",$JOB)
+40 ;
+41 QUIT
+42 ;
+43 ;
SENDOSB ; Send order status bulletin when status not OK.
+1 ;
+2 NEW I,J,K,LA76248,LA7BODY,LA7I,LA7IQSN,LA7ONLT,LA7TSK,LA7X,LWL
+3 NEW X,XMDUZ,XMBNAME,XMINSTR,XMPARM,XMBODY,XMTO
+4 IF '$GET(DUZ)
DO DUZ^XUP(.5)
+5 ;
+6 SET XMBNAME="LA7 ORDER STATUS CHANGED"
+7 SET LA7I=0
+8 FOR
SET LA7I=$ORDER(^TMP("LA7 ORDER STATUS",$JOB,LA7I))
IF 'LA7I
QUIT
Begin DoDot:1
+9 SET LA7I(0)=^TMP("LA7 ORDER STATUS",$JOB,LA7I)
+10 SET LWL=$PIECE(LA7I(0),"^",1)
SET LA7ISQN=$PIECE(LA7I(0),"^",2)
SET LA7ONLT=$PIECE(LA7I(0),"^",3)
SET LA76248=$PIECE(LA7I(0),"^",5)
+11 SET X="UNKNOWN"
+12 IF $PIECE(LA7I(0),"^",7)="UA"
SET X="Unable to accept order/service"
+13 IF $PIECE(LA7I(0),"^",7)="OC"
SET X="Order/service cancel"
+14 IF $PIECE(LA7I(0),"^",7)="CR"
SET X="Canceled as requested"
+15 IF $PIECE(LA7I(0),"^",8)="A"
SET X="Add ordered tests to the existing specimen"
+16 IF $PIECE(LA7I(0),"^",8)="G"
SET X="Generated order; reflex order"
+17 IF $PIECE(LA7I(0),"^",8)?1(1"A",1"G")
IF '$$CHKOK(LA7I)
QUIT
+18 SET XMPARM(1)=X
+19 SET XMPARM(2)=$$GET1^DIQ(62.48,LA76248_",",.01)
+20 SET XMPARM(3)=$PIECE(LA7I(0),"^",6)
+21 SET XMPARM(4)=$GET(^LAH(LWL,1,LA7ISQN,.1,"PID","PNM"))
+22 SET XMPARM(5)=$GET(^LAH(LWL,1,LA7ISQN,.1,"PID","SSN"))
+23 SET XMPARM(6)=$GET(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID"))
+24 SET XMPARM(7)=$$FMTE^XLFDT($GET(^LAH(LWL,1,LA7ISQN,.1,"OBR","ORCDT")),"MZ")
+25 SET XMPARM(8)=$PIECE(LA7I(0),"^",4)_" ["_$PIECE(LA7I(0),"^",3)_"]"
+26 SET XMPARM(9)=$GET(^LAH(LWL,1,LA7ISQN,.1,"OBR","FID"))
+27 SET XMPARM(10)=$PIECE(LA7I(0),"^",9)
+28 SET J=2
SET LA7BODY(1)=" "
SET LA7BODY(2)="Comments:"
+29 FOR K="MSA","OCR"
Begin DoDot:2
+30 SET X=$GET(^TMP("LA7 ORDER STATUS",$JOB,LA7I,K))
+31 IF X'=""
SET J=J+1
SET LA7BODY(J)=X
End DoDot:2
+32 SET I=0
+33 FOR
SET I=$ORDER(^LAH(LWL,1,LA7ISQN,1,I))
IF 'I
QUIT
SET J=J+1
SET LA7BODY(J)=$PIECE(^(I),"^")
+34 DO SMB
+35 SET XQAMSG="Lab Messaging - Order status change received from "_XMPARM(2)
SET XQAID="LA7-ORDER STATUS-"_XMPARM(2)
+36 DO SA
End DoDot:1
+37 ;
+38 KILL ^TMP("LA7 ORDER STATUS",$JOB)
+39 ;
+40 QUIT
+41 ;
+42 ;
SENDUNCB ; Send units/normals changed bulletin
+1 ;
+2 NEW LA76248,LA76304,LA7BODY,LA7I,LA7IQSN,LA7TSK,LA7X,LWL
+3 NEW XMBODY,XMDUZ,XMBNAME,XMINSTR,XMPARM,XMTO,X,Y
+4 NEW XQA,XQAID,XQADATA,XQAFLAG,XQAMSG,XQAOPT,XQAROU
+5 ;
+6 IF '$GET(DUZ)
DO DUZ^XUP(.5)
+7 SET XMBNAME="LA7 UNITS/NORMALS CHANGED"
+8 SET LA7I=0
+9 FOR
SET LA7I=$ORDER(^TMP("LA7 UNITS/NORMALS CHANGED",$JOB,LA7I))
IF 'LA7I
QUIT
Begin DoDot:1
+10 SET LA7I(0)=^TMP("LA7 UNITS/NORMALS CHANGED",$JOB,LA7I)
+11 SET LWL=$PIECE(LA7I(0),"^",1)
SET LA7ISQN=$PIECE(LA7I(0),"^",2)
SET LA76304=$PIECE(LA7I(0),"^",3)
SET LA76248=$PIECE(LA7I(0),"^",4)
+12 SET XMPARM(1)=$$GET1^DIQ(62.48,LA76248_",",.01)
+13 SET XMPARM(2)=$PIECE(LA7I(0),"^",5)
+14 SET XMPARM(3)=$GET(^LAH(LWL,1,LA7ISQN,.1,"PID","PNM"))
+15 SET XMPARM(4)=$GET(^LAH(LWL,1,LA7ISQN,.1,"PID","SSN"))
+16 SET XMPARM(5)=$GET(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID"))
+17 SET XMPARM(6)=$$FMTE^XLFDT($GET(^LAH(LWL,1,LA7ISQN,.1,"OBR","ORCDT")),"MZ")
+18 SET XMPARM(7)=$PIECE(LA7I(0),"^",8)_" ["_$PIECE(LA7I(0),"^",7)_"]"
+19 SET X=$GET(^LAH(LWL,1,LA7ISQN,LA76304))
SET X(5)=$PIECE(X,"^",5)
+20 SET XMPARM(8)=$$GET1^DIQ(4,$PIECE(X,"^",9)_",",.01)
+21 SET XMPARM(9)=$GET(^LAH(LWL,1,LA7ISQN,.1,"OBR","FID"))
+22 SET XMPARM(10)=$$GET1^DIQ(60,$PIECE(LA7I(0),"^",10)_",",.01)
+23 SET XMPARM(11)=$PIECE(X(5),"!",7)
+24 SET XMPARM(12)=$PIECE(X(5),"!",2)_$SELECT($PIECE(X(5),"!",3)'="":"-"_$PIECE(X(5),"!",3),1:"")
+25 SET XMTO("G."_$$FAMG^LA7VHLU1(LA76248,2))=""
+26 DO SMB
+27 SET XQAMSG="Lab Messaging - Reference Lab Units/Normals Change received from "_XMPARM(1)
SET XQAID="LA7-UNITS/NORMALS-CHANGED-"_XMPARM(1)
+28 DO SA
End DoDot:1
+29 ;
+30 KILL ^TMP("LA7 UNITS/NORMALS CHANGED",$JOB)
+31 ;
+32 QUIT
+33 ;
+34 ;
SENDACB ; Send abnormal/critical bulletin
+1 ;
+2 NEW LA76248,LA76304,LA7BODY,LA7I,LA7IQSN,LA7TSK,LA7X,LWL
+3 NEW XMBODY,XMDUZ,XMBNAME,XMINSTR,XMPARM,XMTO,X,Y
+4 NEW XQA,XQAID,XQADATA,XQAFLAG,XQAMSG,XQAOPT,XQAROU
+5 ;
+6 IF '$GET(DUZ)
DO DUZ^XUP(.5)
+7 SET XMBNAME="LA7 ABNORMAL RESULTS RECEIVED"
+8 SET LA7I=0
+9 FOR
SET LA7I=$ORDER(^TMP("LA7 ABNORMAL RESULTS",$JOB,LA7I))
IF 'LA7I
QUIT
Begin DoDot:1
+10 SET LA7I(0)=^TMP("LA7 ABNORMAL RESULTS",$JOB,LA7I)
+11 SET LWL=$PIECE(LA7I(0),"^",1)
SET LA7ISQN=$PIECE(LA7I(0),"^",2)
SET LA76304=$PIECE(LA7I(0),"^",3)
SET LA76248=$PIECE(LA7I(0),"^",4)
+12 SET XMPARM(1)=$$GET1^DIQ(62.48,LA76248_",",.01)
+13 SET XMPARM(2)=$PIECE(LA7I(0),"^",5)
+14 SET XMPARM(3)=$GET(^LAH(LWL,1,LA7ISQN,.1,"PID","PNM"))
+15 SET XMPARM(4)=$GET(^LAH(LWL,1,LA7ISQN,.1,"PID","SSN"))
+16 SET XMPARM(5)=$GET(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID"))
+17 SET XMPARM(6)=$$FMTE^XLFDT($GET(^LAH(LWL,1,LA7ISQN,.1,"OBR","ORCDT")),"MZ")
+18 SET XMPARM(7)=$PIECE(LA7I(0),"^",8)_" ["_$PIECE(LA7I(0),"^",7)_"]"
+19 SET X=$GET(^LAH(LWL,1,LA7ISQN,LA76304))
SET X(5)=$PIECE(X,"^",5)
+20 SET XMPARM(8)=$$GET1^DIQ(4,$PIECE(X,"^",9)_",",.01)
+21 SET XMPARM(9)=$GET(^LAH(LWL,1,LA7ISQN,.1,"OBR","FID"))
+22 SET XMPARM(10)=$PIECE(X,"^")
+23 SET XMPARM(11)=$PIECE(X(5),"!",7)
+24 SET XMPARM(12)=$PIECE(X(5),"!",2)_$SELECT($PIECE(X(5),"!",3)'="":"-"_$PIECE(X(5),"!",3),1:"")
+25 SET LA7X=$PIECE(LA7I(0),"^",9)
SET X=" L^ H^LL^HH^ <^ >^ N^ A^AA^ U^ D^ B^ W^ S^ R^ I^MS^VS"
+26 SET I=$FIND(X,LA7X)\3
IF I
SET LA7X=$PIECE($TEXT(ABFLAGS+I^LA7VHLU1),";;",2)
+27 SET XMPARM(13)=LA7X
+28 DO SMB
+29 SET XQAMSG="Lab Messaging - Reference Lab Abnormal Results received from "_XMPARM(1)
SET XQAID="LA7-ABNORMAL-RESULTS-"_XMPARM(1)
+30 DO SA
+31 ;D:$P($G(^BLRSITE(BLRQSITE,0)),U,10) ENTRYAUD^BLRUTIL("SENDACB^LA7VCN1A 9.0","XMPARM","LA7I") ; <<<< DEBUG
End DoDot:1
+32 ;
+33 KILL ^TMP("LA7 ABNORMAL RESULTS",$JOB)
+34 ;
+35 QUIT
+36 ;
+37 ;
SMB ; Send mail bulletin
+1 ; Ignore any restrictions (domain closed or protected by security key)
+2 ;
+3 SET XMINSTR("ADDR FLAGS")="R"
+4 SET XMINSTR("FROM")="LAB PACKAGE"
+5 SET XMTO("G."_$$FAMG^LA7VHLU1(LA76248,1))=""
+6 DO SENDBULL^XMXAPI(DUZ,XMBNAME,.XMPARM,$SELECT($DATA(LA7BODY):"LA7BODY",1:""),.XMTO,.XMINSTR,.LA7TSK,"")
+7 ;
+8 QUIT
+9 ;
+10 ;
SA ; Send alert
+1 ;
+2 ; ---- BEGIN IHS/OIT/MKK -- LR*5.2*1027 -- Send information via alert as well
+3 KILL XQADATA,XQAROU
+4 SET XQADATA=$GET(^LAH(LWL,1,LA7ISQN,.1,"PID","PNM"))
+5 SET XQADATA=XQADATA_"^"_$GET(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID"))
+6 SET XQADATA=XQADATA_"^"_$PIECE(LA7I(0),"^",8)_" ["_$PIECE(LA7I(0),"^",7)_"]"
+7 SET XQAROU="ALERT^BLRUTIL3"
+8 ; ---- END IHS/OIT/MKK -- LR*5.2*1027
+9 ;
+10 MERGE XQA=XMTO
+11 DO DEL^LA7UXQA(XQAID)
+12 DO SETUP^XQALERT
+13 ;
+14 QUIT
+15 ;
+16 ;
CHKOK(LA7INDX) ; Check if ok to send bulletin on added/reflexed tests order change
+1 ; Returns OK = 1 if results associated with added/reflex test are not
+2 ; on the accession.
+3 ; OK = 0 if accession already has tests on accession.
+4 ;
+5 NEW LA760,LA7AA,LA7AD,LA7AN,LA7I,LA7TREEN,LRUID,OK,X
+6 SET OK=1
SET LRUID=$PIECE($GET(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID")),"^")
+7 ;
+8 ; Store all tests accessioned in ^TMP
+9 SET X=$QUERY(^LRO(68,"C",LRUID))
+10 IF X'=""
IF $QSUBSCRIPT(X,3)=LRUID
Begin DoDot:1
+11 KILL ^TMP("LA7TREE",$JOB)
+12 SET LA7AA=$QSUBSCRIPT(X,4)
SET LA7AD=$QSUBSCRIPT(X,5)
SET LA7AN=$QSUBSCRIPT(X,6)
SET LA7I=0
+13 FOR
SET LA7I=$ORDER(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA7I))
IF 'LA7I
QUIT
DO UNWIND^LA7UTIL(LA7I)
+14 SET (LA7I,OK)=0
+15 FOR
SET LA7I=$ORDER(^TMP("LA7 ORDER STATUS",$JOB,LA7INDX,LA7I))
IF 'LA7I
QUIT
Begin DoDot:2
+16 ;wasn't ordered
IF '$DATA(^TMP("LA7TREE",$JOB,LA7I))
SET OK=1
End DoDot:2
IF OK
QUIT
+17 KILL ^TMP("LA7TREE",$JOB)
End DoDot:1
+18 QUIT OK
