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

LA7VLN1A.m

Go to the documentation of this file. 
  1. LA7VLN1A ;VA/DALOI/JMC - Process Incoming UI Msgs, continued ;JUL 06, 2010 3:14 PM
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**64,1027**;NOV 01, 1997
  1.  ; This routine is a continuation of LA7VIN1.
  1.  ; It performs generation of any mail bulletins needed.
  1.  ;
  1.  ; Reference to DUZ^XUP supported by DBIA #4129
  1.  Q
  1.  ;
  1.  ;
  1. SENDARB ; Send amended report bulletin
  1.  N LA76304,LA7BODY,LA7I,LA7IQSN,LA7TSK,LA7X,LWL
  1.  N XMBODY,XMDUZ,XMBNAME,XMINSTR,XMPARM,XMTO,X,Y
  1.  N XQA,XQAID,XQADATA,XQAFLAG,XQAMSG,XQAOPT,XQAROU
  1.  ;
  1.  I '$G(DUZ) D DUZ^XUP(.5)
  1.  S XMBNAME="LA7 AMENDED RESULTS RECEIVED"
  1.  S LA7I=0
  1.  F  S LA7I=$O(^TMP("LA7 AMENDED RESULTS",$J,LA7I)) Q:'LA7I  D
  1.  . S LA7I(0)=^TMP("LA7 AMENDED RESULTS",$J,LA7I)
  1.  . S LWL=$P(LA7I(0),"^",1),LA7ISQN=$P(LA7I(0),"^",2),LA76304=$P(LA7I(0),"^",3)
  1.  . S XMPARM(1)=$$GET1^DIQ(62.48,$P(LA7I(0),"^",4)_",",.01)
  1.  . S XMPARM(2)=$P(LA7I(0),"^",5)
  1.  . S XMPARM(3)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","PNM"))
  1.  . S XMPARM(4)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","SSN"))
  1.  . S XMPARM(5)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID"))
  1.  . S XMPARM(6)=$$FMTE^XLFDT($G(^LAH(LWL,1,LA7ISQN,.1,"OBR","ORCDT")),"MZ")
  1.   .S XMPARM(7)=$P(LA7I(0),"^",8)_" ["_$P(LA7I(0),"^",7)_"]"
  1.  . S X=$G(^LAH(LWL,1,LA7ISQN,LA76304)),X(5)=$P(X,"^",5)
  1.  . S XMPARM(8)=$$GET1^DIQ(4,$P(X,"^",9)_",",.01)
  1.  . S XMPARM(9)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","FID"))
  1.  . S XMPARM(10)=$P(X,"^")
  1.  . S XMPARM(11)=$P(X(5),"!",7)
  1.  . S XMPARM(12)=$P(X(5),"!",2)_$S($P(X(5),"!",3)'="":"-"_$P(X(5),"!",3),1:"")
  1.  . S LA7X=$P(LA7I(0),"^",9),X=" L^ H^LL^HH^ <^ >^ N^ A^AA^ U^ D^ B^ W^ S^ R^ I^MS^VS"
  1.  . S I=$F(X,LA7X)\3 S:I LA7X=$P($T(ABFLAGS+I^LA7VHLU1),";;",2)
  1.  . S XMPARM(13)=LA7X
  1.  . S X="UNKNOWN"
  1.  . I $P(LA7I(0),"^",6)="C" S X="Record coming over is a correction and thus replaces a final result"
  1.  . I $P(LA7I(0),"^",6)="D" S X="Deletes the OBX record"
  1.  . I $P(LA7I(0),"^",6)="W" S X="Post original as wrong, e.g., transmitted for wrong patient"
  1.  . S XMPARM(14)=X
  1.  . S LA7BODY(1)=" ",LA7BODY(2)="Comments:"
  1.  . S I=0
  1.  . F  S I=$O(^LAH(LWL,1,LA7ISQN,1,I)) Q:'I  S LA7BODY(I+2)=$P(^(I),"^")
  1.  . D SMB
  1.  . S XQAMSG="Lab Messaging - Amended results received from "_XMPARM(1),XQAID="LA7-AMENDED-"_XMPARM(1)
  1.  . D SA
  1.  ;
  1.  K ^TMP("LA7 AMENDED RESULTS",$J)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. SENDOSB ; Send order status bulletin when status not OK.
  1.  ;
  1.  N I,J,K,LA76248,LA7BODY,LA7I,LA7IQSN,LA7ONLT,LA7TSK,LA7X,LWL
  1.  N X,XMDUZ,XMBNAME,XMINSTR,XMPARM,XMBODY,XMTO
  1.  I '$G(DUZ) D DUZ^XUP(.5)
  1.  ;
  1.  S XMBNAME="LA7 ORDER STATUS CHANGED"
  1.  S LA7I=0
  1.  F  S LA7I=$O(^TMP("LA7 ORDER STATUS",$J,LA7I)) Q:'LA7I  D
  1.  . S LA7I(0)=^TMP("LA7 ORDER STATUS",$J,LA7I)
  1.  . S LWL=$P(LA7I(0),"^",1),LA7ISQN=$P(LA7I(0),"^",2),LA7ONLT=$P(LA7I(0),"^",3),LA76248=$P(LA7I(0),"^",5)
  1.  . S X="UNKNOWN"
  1.  . I $P(LA7I(0),"^",7)="UA" S X="Unable to accept order/service"
  1.  . I $P(LA7I(0),"^",7)="OC" S X="Order/service cancel"
  1.  . I $P(LA7I(0),"^",7)="CR" S X="Canceled as requested"
  1.  . I $P(LA7I(0),"^",8)="A" S X="Add ordered tests to the existing specimen"
  1.  . I $P(LA7I(0),"^",8)="G" S X="Generated order; reflex order"
  1.  . I $P(LA7I(0),"^",8)?1(1"A",1"G") Q:'$$CHKOK(LA7I)
  1.  . S XMPARM(1)=X
  1.  . S XMPARM(2)=$$GET1^DIQ(62.48,LA76248_",",.01)
  1.  . S XMPARM(3)=$P(LA7I(0),"^",6)
  1.  . S XMPARM(4)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","PNM"))
  1.  . S XMPARM(5)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","SSN"))
  1.  . S XMPARM(6)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID"))
  1.  . S XMPARM(7)=$$FMTE^XLFDT($G(^LAH(LWL,1,LA7ISQN,.1,"OBR","ORCDT")),"MZ")
  1.  . S XMPARM(8)=$P(LA7I(0),"^",4)_" ["_$P(LA7I(0),"^",3)_"]"
  1.  . S XMPARM(9)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","FID"))
  1.  . S XMPARM(10)=$P(LA7I(0),"^",9)
  1.  . S J=2,LA7BODY(1)=" ",LA7BODY(2)="Comments:"
  1.  . F K="MSA","OCR" D
  1.  . . S X=$G(^TMP("LA7 ORDER STATUS",$J,LA7I,K))
  1.  . . I X'="" S J=J+1,LA7BODY(J)=X
  1.  . S I=0
  1.  . F  S I=$O(^LAH(LWL,1,LA7ISQN,1,I)) Q:'I  S J=J+1,LA7BODY(J)=$P(^(I),"^")
  1.  . D SMB
  1.  . S XQAMSG="Lab Messaging - Order status change received from "_XMPARM(2),XQAID="LA7-ORDER STATUS-"_XMPARM(2)
  1.  . D SA
  1.  ;
  1.  K ^TMP("LA7 ORDER STATUS",$J)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. SENDUNCB ; Send units/normals changed bulletin
  1.  ;
  1.  N LA76248,LA76304,LA7BODY,LA7I,LA7IQSN,LA7TSK,LA7X,LWL
  1.  N XMBODY,XMDUZ,XMBNAME,XMINSTR,XMPARM,XMTO,X,Y
  1.  N XQA,XQAID,XQADATA,XQAFLAG,XQAMSG,XQAOPT,XQAROU
  1.  ;
  1.  I '$G(DUZ) D DUZ^XUP(.5)
  1.  S XMBNAME="LA7 UNITS/NORMALS CHANGED"
  1.  S LA7I=0
  1.  F  S LA7I=$O(^TMP("LA7 UNITS/NORMALS CHANGED",$J,LA7I)) Q:'LA7I  D
  1.  . S LA7I(0)=^TMP("LA7 UNITS/NORMALS CHANGED",$J,LA7I)
  1.  . S LWL=$P(LA7I(0),"^",1),LA7ISQN=$P(LA7I(0),"^",2),LA76304=$P(LA7I(0),"^",3),LA76248=$P(LA7I(0),"^",4)
  1.  . S XMPARM(1)=$$GET1^DIQ(62.48,LA76248_",",.01)
  1.  . S XMPARM(2)=$P(LA7I(0),"^",5)
  1.  . S XMPARM(3)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","PNM"))
  1.  . S XMPARM(4)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","SSN"))
  1.  . S XMPARM(5)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID"))
  1.  . S XMPARM(6)=$$FMTE^XLFDT($G(^LAH(LWL,1,LA7ISQN,.1,"OBR","ORCDT")),"MZ")
  1.   .S XMPARM(7)=$P(LA7I(0),"^",8)_" ["_$P(LA7I(0),"^",7)_"]"
  1.  . S X=$G(^LAH(LWL,1,LA7ISQN,LA76304)),X(5)=$P(X,"^",5)
  1.  . S XMPARM(8)=$$GET1^DIQ(4,$P(X,"^",9)_",",.01)
  1.  . S XMPARM(9)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","FID"))
  1.  . S XMPARM(10)=$$GET1^DIQ(60,$P(LA7I(0),"^",10)_",",.01)
  1.  . S XMPARM(11)=$P(X(5),"!",7)
  1.  . S XMPARM(12)=$P(X(5),"!",2)_$S($P(X(5),"!",3)'="":"-"_$P(X(5),"!",3),1:"")
  1.  . S XMTO("G."_$$FAMG^LA7VHLU1(LA76248,2))=""
  1.  . D SMB
  1.  . S XQAMSG="Lab Messaging - Reference Lab Units/Normals Change received from "_XMPARM(1),XQAID="LA7-UNITS/NORMALS-CHANGED-"_XMPARM(1)
  1.  . D SA
  1.  ;
  1.  K ^TMP("LA7 UNITS/NORMALS CHANGED",$J)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. SENDACB ; Send abnormal/critical bulletin
  1.  ;
  1.  N LA76248,LA76304,LA7BODY,LA7I,LA7IQSN,LA7TSK,LA7X,LWL
  1.  N XMBODY,XMDUZ,XMBNAME,XMINSTR,XMPARM,XMTO,X,Y
  1.  N XQA,XQAID,XQADATA,XQAFLAG,XQAMSG,XQAOPT,XQAROU
  1.  ;
  1.  I '$G(DUZ) D DUZ^XUP(.5)
  1.  S XMBNAME="LA7 ABNORMAL RESULTS RECEIVED"
  1.  S LA7I=0
  1.  F  S LA7I=$O(^TMP("LA7 ABNORMAL RESULTS",$J,LA7I)) Q:'LA7I  D
  1.  . S LA7I(0)=^TMP("LA7 ABNORMAL RESULTS",$J,LA7I)
  1.  . S LWL=$P(LA7I(0),"^",1),LA7ISQN=$P(LA7I(0),"^",2),LA76304=$P(LA7I(0),"^",3),LA76248=$P(LA7I(0),"^",4)
  1.  . S XMPARM(1)=$$GET1^DIQ(62.48,LA76248_",",.01)
  1.  . S XMPARM(2)=$P(LA7I(0),"^",5)
  1.  . S XMPARM(3)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","PNM"))
  1.  . S XMPARM(4)=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","SSN"))
  1.  . S XMPARM(5)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID"))
  1.  . S XMPARM(6)=$$FMTE^XLFDT($G(^LAH(LWL,1,LA7ISQN,.1,"OBR","ORCDT")),"MZ")
  1.   .S XMPARM(7)=$P(LA7I(0),"^",8)_" ["_$P(LA7I(0),"^",7)_"]"
  1.  . S X=$G(^LAH(LWL,1,LA7ISQN,LA76304)),X(5)=$P(X,"^",5)
  1.  . S XMPARM(8)=$$GET1^DIQ(4,$P(X,"^",9)_",",.01)
  1.  . S XMPARM(9)=$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","FID"))
  1.  . S XMPARM(10)=$P(X,"^")
  1.  . S XMPARM(11)=$P(X(5),"!",7)
  1.  . S XMPARM(12)=$P(X(5),"!",2)_$S($P(X(5),"!",3)'="":"-"_$P(X(5),"!",3),1:"")
  1.  . S LA7X=$P(LA7I(0),"^",9),X=" L^ H^LL^HH^ <^ >^ N^ A^AA^ U^ D^ B^ W^ S^ R^ I^MS^VS"
  1.  . S I=$F(X,LA7X)\3 S:I LA7X=$P($T(ABFLAGS+I^LA7VHLU1),";;",2)
  1.  . S XMPARM(13)=LA7X
  1.  . D SMB
  1.  . S XQAMSG="Lab Messaging - Reference Lab Abnormal Results received from "_XMPARM(1),XQAID="LA7-ABNORMAL-RESULTS-"_XMPARM(1)
  1.  . D SA
  1.  ;
  1.  K ^TMP("LA7 ABNORMAL RESULTS",$J)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. SMB ; Send mail bulletin
  1.  ; Ignore any restrictions (domain closed or protected by security key)
  1.  ;
  1.  S XMINSTR("ADDR FLAGS")="R"
  1.  S XMINSTR("FROM")="LAB PACKAGE"
  1.  S XMTO("G."_$$FAMG^LA7VHLU1(LA76248,1))=""
  1.  D SENDBULL^XMXAPI(DUZ,XMBNAME,.XMPARM,$S($D(LA7BODY):"LA7BODY",1:""),.XMTO,.XMINSTR,.LA7TSK,"")
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. SA ; Send alert
  1.  ;
  1.  ; ---- BEGIN IHS/OIT/MKK -- LR*5.2*1027 -- Send information via alert as well
  1.  K XQADATA,XQAROU
  1.  S XQADATA=$G(^LAH(LWL,1,LA7ISQN,.1,"PID","PNM"))
  1.  S XQADATA=XQADATA_"^"_$G(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID"))
  1.  S XQADATA=XQADATA_"^"_$P(LA7I(0),"^",8)_" ["_$P(LA7I(0),"^",7)_"]"
  1.  S XQAROU="ALERT^BLRUTIL3"
  1.  ; ---- END IHS/OIT/MKK -- LR*5.2*1027
  1.  ;
  1.  M XQA=XMTO
  1.  D DEL^LA7UXQA(XQAID)
  1.  D SETUP^XQALERT
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. 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
  1.  ;               on the accession.
  1.  ;         OK = 0 if accession already has tests on accession.
  1.  ;
  1.  N LA760,LA7AA,LA7AD,LA7AN,LA7I,LA7TREEN,LRUID,OK,X
  1.  S OK=1,LRUID=$P($G(^LAH(LWL,1,LA7ISQN,.1,"OBR","SID")),"^")
  1.  ;
  1.  ; Store all tests accessioned in ^TMP
  1.  S X=$Q(^LRO(68,"C",LRUID))
  1.  I X'="",$QS(X,3)=LRUID D
  1.  . K ^TMP("LA7TREE",$J)
  1.  . S LA7AA=$QS(X,4),LA7AD=$QS(X,5),LA7AN=$QS(X,6),LA7I=0
  1.  . F  S LA7I=$O(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA7I)) Q:'LA7I  D UNWIND^LA7UTIL(LA7I)
  1.  . S (LA7I,OK)=0
  1.  . F  S LA7I=$O(^TMP("LA7 ORDER STATUS",$J,LA7INDX,LA7I)) Q:'LA7I  D  Q:OK
  1.  . . I '$D(^TMP("LA7TREE",$J,LA7I)) S OK=1 ;wasn't ordered
  1.  . K ^TMP("LA7TREE",$J)
  1.  Q OK