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

LR7OF2.m

Go to the documentation of this file.
  1. LR7OF2 ;SLC/DCM - Process messages from OE/RR ;Mar 18, 2022@16:55
  1. ;;5.2;LAB SERVICE;**121,187,440,538,557**;Sep 27, 1994;Build 2
  1. ;
  1. NEW ;Process New orders from OE/RR
  1. ;LRXMSG=Message with linking identifiers
  1. ;LRXORC=Current ORC message value - for communicating back to OE/RR
  1. D GET(.LRXMSG,LRXORC) Q:LREND
  1. I '$L(STARTDT) D ACK^LR7OF0("DE",LRXORC,"Start date not passed in message") S LREND=1 Q
  1. I '$L(LRDUZ) D ACK^LR7OF0("DE",LRXORC,"Entered By person not passed in message") S LREND=1 Q
  1. I '$L(PROV) D ACK^LR7OF0("DE",LRXORC,"Provider not passed in message") S LREND=1 Q
  1. Q
  1. CANC ;Process Canceled orders from OE/RR
  1. N TST,X,LRODT,LRSN,LRORD,LRORIFN,STARTDT,LRDUZ,PROV,REASON,QUANT
  1. D GET(.LRXORC,LRXORC) Q:LREND
  1. I 'LRVERZ S LRODT=0 F S LRODT=$O(^LRO(69,"C",LRORD,LRODT)) Q:LRODT<1 S LRSN=0 F S LRSN=$O(^LRO(69,"C",LRORD,LRODT,LRSN)) Q:LRSN<1 D Q
  1. . S X=$P($P(LRXMSG,"|",5),"^",4) I X S TST=$O(^LRO(69,LRODT,1,LRSN,2,"B",X,0)) I TST D DOIT(LRODT,LRSN,TST,LRXORC,LRDUZ,REASON) Q:LREND
  1. I LRVERZ,$D(^LRO(69,LRODT,1,LRSN,0)) D Q:LREND
  1. . S X=$P($P(LRXMSG,"|",5),"^",4),TST=""
  1. . I X S TST=$O(^LRO(69,LRODT,1,LRSN,2,"B",X,0))
  1. . I TST D DOIT(LRODT,LRSN,TST,LRXORC,LRDUZ,REASON) D
  1. . . ;LR*5.2*557: If line below is invoked for VBECS-originated
  1. . . ; cancellations, VistA status will not update correctly.
  1. . . I $G(ORNMSP)'="VBEC" D CHKCOMB(LRODT,LRSN,TST,LRXORC,LRDUZ,REASON)
  1. D ACK^LR7OF0("CR",LRXORC)
  1. Q
  1. XO ;Process order changes from OE/RR
  1. D GET(.LRXMSG,LRXORC) Q:LREND
  1. D ACK^LR7OF0("XR",LRXORC)
  1. Q
  1. DOIT(LRODT,LRSN,TST,LRXORC,LRDUZ,REASON) ;Clean it out
  1. N LRAA,LRAD,LRAN,X,LRTSN,LRUSNM
  1. ;I $D(^LRO(69,LRODT,1,LRSN,3)),$P(^(3),"^",2) S LREND=1 D ACK^LR7OF0("UC",LRXORC,"Tests already verified") Q ;Tests already verified
  1. S X=+^LRO(69,LRODT,1,LRSN,2,TST,0),LRTSN=+X,LRAD=+$P(X,"^",3),LRAA=+$P(X,"^",4),LRAN=+$P(X,"^",5)
  1. I LRAD,LRAA,LRAN,$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) S LREND=1 D ACK^LR7OF0("UC",LRXORC,"Tests already accessioned, contact lab to cancel") Q
  1. S $P(^LRO(69,LRODT,1,LRSN,2,TST,0),"^",3,6)="^^^",$P(^(0),"^",9,11)="CA^W^"_LRDUZ
  1. I $L($P(REASON,"^",5)) S:'$D(^LRO(69,LRODT,1,LRSN,2,TST,1.1,0)) ^(0)="^^^^"_DT S X=1+$O(^(9999),-1),$P(^LRO(69,LRODT,1,LRSN,2,TST,1.1,0),"^",3,4)=X_"^"_X,^(X,0)=$P(REASON,"^",5)
  1. Q
  1. CHKCOMB(LRODT,LRSN,LRIN,LRXORC,LRDUZ,REASON) ;
  1. ; check for other entries that have combined this test
  1. N LR60,LRI,LRORD,LRX,LRY
  1. ;
  1. ; retrieve list of merged orders
  1. S LRX=$P($G(^LRO(69,LRODT,1,LRSN,1)),"^",7) Q:LRX=""
  1. ;
  1. S LR60=$P(^LRO(69,LRODT,1,LRSN,2,LRIN,0),"^")
  1. S LRY=LRODT_";"_LRSN_";"_LRIN
  1. ;
  1. ; scan the merged order # (LRX) and check corresponding orders/seq (LRSN)
  1. ; for matching (#20) COMBINED FROM [14F] and update if match
  1. F LRI=1:1 S LRORD=$P(LRX,"/",LRI) Q:LRORD="" D
  1. . S LRODT=0
  1. . F S LRODT=$O(^LRO(69,"C",LRORD,LRODT)) Q:LRODT<1 D
  1. . . S LRSN=0
  1. . . F S LRSN=$O(^LRO(69,"C",LRORD,LRODT,LRSN)) Q:LRSN<1 D
  1. . . . S LRIN=$O(^LRO(69,LRODT,1,LRSN,2,"B",LR60,0))
  1. . . . I LRIN,$P(^LRO(69,LRODT,1,LRSN,2,LRIN,0),"^",14)=LRY D DOIT(LRODT,LRSN,LRIN,LRXORC,LRDUZ,REASON)
  1. ;
  1. Q
  1. NUM ;Process Return of OE/RR Order number
  1. N LRODT,LRSN,LRORD,ORIFN,STARTDT,LRDUZ,PROV,REASON,QUANT
  1. D GET(.LRXMSG,LRXORC) Q:LREND
  1. I 'LRVERZ,LRORD S LRODT=0 F S LRODT=$O(^LRO(69,"C",LRORD,LRODT)) Q:LRODT<1 S LRSN=0 F S LRSN=$O(^LRO(69,"C",LRORD,LRODT,LRSN)) Q:LRSN<1 I $D(^LRO(69,LRODT,1,LRSN,0)) S $P(^(0),"^",11)=ORIFN
  1. I LRVERZ,$D(^LRO(69,LRODT,1,LRSN,0)) S $P(^(0),"^",11)=ORIFN
  1. Q
  1. NA ;Set ORIFN at test level
  1. N I,X,LRODT,LRSN,LRORD,ORIFN,STARTDT,LRDUZ,PROV,REASON,QUANT,LRTXI
  1. D GET(.LRXORC,LRXORC) Q:LREND
  1. S I=0
  1. S X=$P($P(LRXMSG,"|",5),"^",4),LRTXI=0
  1. NA1 ;
  1. ;LR*5.2*538 - allow for the fact that a test might exist on more than
  1. ; one subscript
  1. I X S I=$O(^LRO(69,LRODT,1,LRSN,2,"B",X,LRTXI))
  1. I I,$P($G(^LRO(69,LRODT,1,LRSN,2,I,0)),"^",9)="CA" S LRTXI=I G NA1
  1. I I S $P(^LRO(69,LRODT,1,LRSN,2,I,0),"^",7)=ORIFN
  1. Q
  1. GET(XMSG,XORC) ;Get identification data from message
  1. ;ORIFN= OE/RR order number
  1. ;STARTDT= Start D/T of order
  1. ;LRDUZ= Entered by Person (ptr to file 200)
  1. ;PROV= Ordering Provider
  1. ;REASON= Order control reason (e.g. inadequate specimen)
  1. ;QUANT= Quantity ordered
  1. ;LRORD=Lab Order #
  1. ;LRODT=Order date
  1. ;LRSN=Specimen Number
  1. ;LRVERZ=0 if only LRORD, 1 if LRODT,LRSN exists. Used to maintain backward compatibility at Tuscaloosa when only LRORD was used.
  1. N X,X1,I,J,CTR
  1. S X=$P(XMSG,"|",4),LRORD=+X,LRODT=+$P(X,";",2),LRSN=+$P(X,";",3),LRVERZ=$S(LRODT&LRSN:1,1:0)
  1. S LRPLACR=$P(XMSG,"|",3),ORIFN=+LRPLACR
  1. I 'ORIFN D ACK^LR7OF0("DE",XORC,"OE/RR order number not passed") S LREND=1 Q
  1. I '$O(XMSG(0)) S STARTDT=$$FMDATE^LR7OU0($P($P(XMSG,"|",8),"^",4)),LRDUZ=$P(XMSG,"|",11),PROV=$P(XMSG,"|",13),REASON=$P(XMSG,"|",17),QUANT=$P($P(XMSG,"|",8),"^") Q
  1. F CTR=1:1:$L(XMSG,"|") S X1(CTR)=$P(XMSG,"|",CTR)
  1. S J=0 F S J=$O(XMSG(J)) Q:J<1 D
  1. . S I=1 I $E(XMSG(J))'="|" S X1(CTR)=X1(CTR)_$P(XMSG(J),"|"),I=I+1
  1. . F I=I:1:$L(XMSG(J),"|") S CTR=CTR+1,X1(CTR)=$P(XMSG(J),"|",I)
  1. S STARTDT=$$FMDATE^LR7OU0($P(X1(8),"^",4))
  1. S QUANT=$P(X1(8),"^")
  1. S LRDUZ=X1(11),PROV=X1(13),REASON=X1(17)
  1. Q
  1. NTE ;Process Order comments from OE/RR
  1. ;MSG(i)="NTE|1|P|comment..."
  1. ;MSG(i,c)="...more comments..."
  1. N X,I,LINES
  1. S X=$D(STARTDT)&($D(TYPE))&($D(SAMP))&($D(SPEC))&($D(LRSX))
  1. I 'X Q ;Trying to add comments to undefined test array in ^TMP
  1. I '$D(^TMP("OR",$J,"LROT",STARTDT,TYPE,SAMP,SPEC,LRSX)) Q ;Trying to add comments to undefined test array in ^TMP
  1. S:'$D(^TMP("OR",$J,"COM",STARTDT,TYPE,SAMP,SPEC,LRSX)) ^(LRSX)=0 S LINES=^(LRSX)
  1. I $L($P(LRXMSG,"|",4)) D N1($P(LRXMSG,"|",4))
  1. S I=0 F S I=$O(MSG(LINE,I)) Q:I<1 I $L(MSG(LINE,I)) D N1(MSG(LINE,I))
  1. Q
  1. N1(X) ;
  1. S LINES=LINES+1,^TMP("OR",$J,"COM",STARTDT,TYPE,SAMP,SPEC,LRSX,LINES)=X,^TMP("OR",$J,"COM",STARTDT,TYPE,SAMP,SPEC,LRSX)=LINES
  1. Q