source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OF2.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1LR7OF2 ;slc/dcm - Process messages from OE/RR ;8/11/97
2 ;;5.2;LAB SERVICE;**121,187**;Sep 27, 1994
3 ;
4NEW ;Process New orders from OE/RR
5 ;LRXMSG=Message with linking identifiers
6 ;LRXORC=Current ORC message value - for communicating back to OE/RR
7 D GET(.LRXMSG,LRXORC) Q:LREND
8 I '$L(STARTDT) D ACK^LR7OF0("DE",LRXORC,"Start date not passed in message") S LREND=1 Q
9 I '$L(LRDUZ) D ACK^LR7OF0("DE",LRXORC,"Entered By person not passed in message") S LREND=1 Q
10 I '$L(PROV) D ACK^LR7OF0("DE",LRXORC,"Provider not passed in message") S LREND=1 Q
11 Q
12CANC ;Process Canceled orders from OE/RR
13 N TST,X,LRODT,LRSN,LRORD,LRORIFN,STARTDT,LRDUZ,PROV,REASON,QUANT
14 D GET(.LRXORC,LRXORC) Q:LREND
15 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
16 . 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
17 I LRVERZ,$D(^LRO(69,LRODT,1,LRSN,0)) 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
18 D ACK^LR7OF0("CR",LRXORC)
19 Q
20XO ;Process order changes from OE/RR
21 D GET(.LRXMSG,LRXORC) Q:LREND
22 D ACK^LR7OF0("XR",LRXORC)
23 Q
24DOIT(LRODT,LRSN,TST,LRXORC,LRDUZ,REASON) ;Clean it out
25 N LRAA,LRAD,LRAN,X,LRTSN,LRUSNM
26 ;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
27 S X=+^LRO(69,LRODT,1,LRSN,2,TST,0),LRTSN=+X,LRAD=+$P(X,"^",3),LRAA=+$P(X,"^",4),LRAN=+$P(X,"^",5)
28 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
29 S $P(^LRO(69,LRODT,1,LRSN,2,TST,0),"^",3,6)="^^^",$P(^(0),"^",9,11)="CA^W^"_LRDUZ
30 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)
31 Q
32NUM ;Process Return of OE/RR Order number
33 N LRODT,LRSN,LRORD,ORIFN,STARTDT,LRDUZ,PROV,REASON,QUANT
34 D GET(.LRXMSG,LRXORC) Q:LREND
35 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
36 I LRVERZ,$D(^LRO(69,LRODT,1,LRSN,0)) S $P(^(0),"^",11)=ORIFN
37 Q
38NA ;Set ORIFN at test level
39 N I,X,LRODT,LRSN,LRORD,ORIFN,STARTDT,LRDUZ,PROV,REASON,QUANT
40 D GET(.LRXORC,LRXORC) Q:LREND
41 S I=0
42 S X=$P($P(LRXMSG,"|",5),"^",4) I X S I=$O(^LRO(69,LRODT,1,LRSN,2,"B",X,0)) I I S $P(^LRO(69,LRODT,1,LRSN,2,I,0),"^",7)=ORIFN
43 Q
44GET(XMSG,XORC) ;Get identification data from message
45 ;ORIFN= OE/RR order number
46 ;STARTDT= Start D/T of order
47 ;LRDUZ= Entered by Person (ptr to file 200)
48 ;PROV= Ordering Provider
49 ;REASON= Order control reason (e.g. inadequate specimen)
50 ;QUANT= Quantity ordered
51 ;LRORD=Lab Order #
52 ;LRODT=Order date
53 ;LRSN=Specimen Number
54 ;LRVERZ=0 if only LRORD, 1 if LRODT,LRSN exists. Used to maintain backward compatibility at Tuscaloosa when only LRORD was used.
55 N X,X1,I,J,CTR
56 S X=$P(XMSG,"|",4),LRORD=+X,LRODT=+$P(X,";",2),LRSN=+$P(X,";",3),LRVERZ=$S(LRODT&LRSN:1,1:0)
57 S LRPLACR=$P(XMSG,"|",3),ORIFN=+LRPLACR
58 I 'ORIFN D ACK^LR7OF0("DE",XORC,"OE/RR order number not passed") S LREND=1 Q
59 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
60 F CTR=1:1:$L(XMSG,"|") S X1(CTR)=$P(XMSG,"|",CTR)
61 S J=0 F S J=$O(XMSG(J)) Q:J<1 D
62 . S I=1 I $E(XMSG(J))'="|" S X1(CTR)=X1(CTR)_$P(XMSG(J),"|"),I=I+1
63 . F I=I:1:$L(XMSG(J),"|") S CTR=CTR+1,X1(CTR)=$P(XMSG(J),"|",I)
64 S STARTDT=$$FMDATE^LR7OU0($P(X1(8),"^",4))
65 S QUANT=$P(X1(8),"^")
66 S LRDUZ=X1(11),PROV=X1(13),REASON=X1(17)
67 Q
68NTE ;Process Order comments from OE/RR
69 ;MSG(i)="NTE|1|P|comment..."
70 ;MSG(i,c)="...more comments..."
71 N X,I,LINES
72 S X=$D(STARTDT)&($D(TYPE))&($D(SAMP))&($D(SPEC))&($D(LRSX))
73 I 'X Q ;Trying to add comments to undefined test array in ^TMP
74 I '$D(^TMP("OR",$J,"LROT",STARTDT,TYPE,SAMP,SPEC,LRSX)) Q ;Trying to add comments to undefined test array in ^TMP
75 S:'$D(^TMP("OR",$J,"COM",STARTDT,TYPE,SAMP,SPEC,LRSX)) ^(LRSX)=0 S LINES=^(LRSX)
76 I $L($P(LRXMSG,"|",4)) D N1($P(LRXMSG,"|",4))
77 S I=0 F S I=$O(MSG(LINE,I)) Q:I<1 I $L(MSG(LINE,I)) D N1(MSG(LINE,I))
78 Q
79N1(X) ;
80 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
81 Q
Note: See TracBrowser for help on using the repository browser.