BLRRLCOM ; cmi/anch/maw - BLR Get Order Comments for HL7 Order Message ;01 MAY 2013 1300;SAT
;;5.2;LR;**1021,1030,1031**;Nov 1, 1997
;;1.0;BLR REFERENCE LAB;;MAR 14, 2005
;
;this routine will look up the test ien, ref lab and ask
;the appropriate order comments, it will then return an array
;with the appropriate result code and value to be stuffed into
;the order's OBX segment
;
COM(TIEN,LEDI) ; EP -- check to see if there are any comments
I $G(BLRPHASE)'="A",'$G(LEDI) Q "" ;added check of LEDI for backward compatibility
S BLRCRL=$P($G(^BLRSITE(DUZ(2),"RL")),U)
I '$G(BLRCRL) Q "No Reference Lab Defined"
S BLRRIEN=$O(^BLRRL("ALP",TIEN,BLRCRL,0))
I '$G(BLRRIEN) Q "No Matching Reference Lab Test"
I '$D(^BLRRL(BLRCRL,1,BLRRIEN,1,0)) Q "No comments for test"
N TN S TN=$P($G(^LAB(60,TIEN,0)),U,1)
S BLRCN=0
NEW NOWTIME
S NOWTIME=$H
S ^XTMP("BLRRLCOM",NOWTIME,"001 TIEN:")=$G(TIEN)
S ^XTMP("BLRRLCOM",NOWTIME,"002 LEDI:")=$G(LEDI)
S ^XTMP("BLRRLCOM",NOWTIME,"003 BLRCRL:")=$G(BLRCRL)
S ^XTMP("BLRRLCOM",NOWTIME,"004 BLRRIEN:")=$G(BLRRIEN)
;
S BLRRC=0 F S BLRRC=$O(^BLRRL(BLRCRL,1,BLRRIEN,1,BLRRC)) Q:'BLRRC D
. S BLRCN=BLRCN+1
. S BLRTPC=$G(^BLRRL(BLRCRL,1,BLRRIEN,1,BLRRC,0))
. S BLRTP=$O(^BLRRL("BRES",BLRTPC,BLRCRL,0))
. S ^XTMP("BLRRLCOM",NOWTIME,"004 BLRRC:")=$G(BLRRC)
. S ^XTMP("BLRRLCOM",NOWTIME,"004 BLRCN:")=$G(BLRCN)
. S ^XTMP("BLRRLCOM",NOWTIME,"005 BLRTP:")=$G(BLRTP)
. Q:'BLRTP
. S BLRRTI=$P($G(^BLRRL(BLRCRL,1,BLRTP,0)),U,7)
. S BLRRSC=$P($G(^BLRRL(BLRCRL,1,BLRTP,0)),U,4)
. S ^XTMP("BLRRLCOM",NOWTIME,"006 BLRCN:",BLRCN,"01 BLRRTI:")=$G(BLRRTI)
. S ^XTMP("BLRRLCOM",NOWTIME,"006 BLRCN:",BLRCN,"02 BLRRSC:")=$G(BLRRSC)
. ; S BLRRES=$$ASK(BLRRTI,BLRTP,BLRRSC)
. ; S BLRRES=$S(+$G(ORWCLVER):BLRRSC_U_BLRRTI_U,1:$$ASK(BLRRTI,BLRTP,BLRRSC)) ; LR*5.2*1031 -- IHS/MSC/MKK - if LAB ACCESSIONING GUI, then DO NOT ask Ref Lab AOE questions: only store the AOE questions
. S:+$G(BLRAGUI) BLRRES=$$GUI(BLRAOE,TIEN,BLRRTI,BLRRSC,TN) ; LR*5.2*1031 -- IHS/MSC/SAT - if LAB ACCESSIONING GUI, then DO NOT ask Ref Lab AOE questions: only store the AOE questions and passed in answers
. S:'+$G(BLRAGUI) BLRRES=$$ASK(BLRRTI,BLRTP,BLRRSC) ; LR*5.2*1031 -- IHS/MSC/SAT
. S ^XTMP("BLRRLCOM",NOWTIME,"006 BLRCN:",BLRCN,"03 BLRRES:")=$G(BLRRES)
. I $G(BLRRES)]"" S BLRRLC(TIEN,BLRCN)=$G(BLRRES)
Q $G(BLRRLC)
;
ASK(RTI,RTP,RSC) ; EP -- ask the comment question and get the result
; RTI = Prompt
; RTP =
; RSC = Result code
N DIR
S DIR(0)="FO",DIR("A")=RTI
D ^DIR
S BLRANS=Y
Q RSC_U_RTI_U_BLRANS
;
GUI(BLRAOE,TIEN,RTI,RSC,TN) ;
N BLRANS,BLRCNT
Q:$G(TIEN)=""
S BLRANS=""
S BLRRET=""
;BLRAOE = <question prompt> ^ <result code> ^ <free-text answer> ^ <test name>
F BLRCNT=1:1:$L(BLRAOE,"|") D Q:BLRANS'=""
.I $P($P(BLRAOE,"|",BLRCNT),U,4)=TN D
..I $P($P(BLRAOE,"|",BLRCNT),U,1)=RTI D
...S BLRANS=$P($P(BLRAOE,"|",BLRCNT),U,3)
Q RSC_U_RTI_U_BLRANS
BLRRLCOM ; cmi/anch/maw - BLR Get Order Comments for HL7 Order Message ;01 MAY 2013 1300;SAT
+1 ;;5.2;LR;**1021,1030,1031**;Nov 1, 1997
+2 ;;1.0;BLR REFERENCE LAB;;MAR 14, 2005
+3 ;
+4 ;this routine will look up the test ien, ref lab and ask
+5 ;the appropriate order comments, it will then return an array
+6 ;with the appropriate result code and value to be stuffed into
+7 ;the order's OBX segment
+8 ;
COM(TIEN,LEDI) ; EP -- check to see if there are any comments
+1 ;added check of LEDI for backward compatibility
IF $GET(BLRPHASE)'="A"
IF '$GET(LEDI)
QUIT ""
+2 SET BLRCRL=$PIECE($GET(^BLRSITE(DUZ(2),"RL")),U)
+3 IF '$GET(BLRCRL)
QUIT "No Reference Lab Defined"
+4 SET BLRRIEN=$ORDER(^BLRRL("ALP",TIEN,BLRCRL,0))
+5 IF '$GET(BLRRIEN)
QUIT "No Matching Reference Lab Test"
+6 IF '$DATA(^BLRRL(BLRCRL,1,BLRRIEN,1,0))
QUIT "No comments for test"
+7 NEW TN
SET TN=$PIECE($GET(^LAB(60,TIEN,0)),U,1)
+8 SET BLRCN=0
+9 NEW NOWTIME
+10 SET NOWTIME=$HOROLOG
+11 SET ^XTMP("BLRRLCOM",NOWTIME,"001 TIEN:")=$GET(TIEN)
+12 SET ^XTMP("BLRRLCOM",NOWTIME,"002 LEDI:")=$GET(LEDI)
+13 SET ^XTMP("BLRRLCOM",NOWTIME,"003 BLRCRL:")=$GET(BLRCRL)
+14 SET ^XTMP("BLRRLCOM",NOWTIME,"004 BLRRIEN:")=$GET(BLRRIEN)
+15 ;
+16 SET BLRRC=0
FOR
SET BLRRC=$ORDER(^BLRRL(BLRCRL,1,BLRRIEN,1,BLRRC))
IF 'BLRRC
QUIT
Begin DoDot:1
+17 SET BLRCN=BLRCN+1
+18 SET BLRTPC=$GET(^BLRRL(BLRCRL,1,BLRRIEN,1,BLRRC,0))
+19 SET BLRTP=$ORDER(^BLRRL("BRES",BLRTPC,BLRCRL,0))
+20 SET ^XTMP("BLRRLCOM",NOWTIME,"004 BLRRC:")=$GET(BLRRC)
+21 SET ^XTMP("BLRRLCOM",NOWTIME,"004 BLRCN:")=$GET(BLRCN)
+22 SET ^XTMP("BLRRLCOM",NOWTIME,"005 BLRTP:")=$GET(BLRTP)
+23 IF 'BLRTP
QUIT
+24 SET BLRRTI=$PIECE($GET(^BLRRL(BLRCRL,1,BLRTP,0)),U,7)
+25 SET BLRRSC=$PIECE($GET(^BLRRL(BLRCRL,1,BLRTP,0)),U,4)
+26 SET ^XTMP("BLRRLCOM",NOWTIME,"006 BLRCN:",BLRCN,"01 BLRRTI:")=$GET(BLRRTI)
+27 SET ^XTMP("BLRRLCOM",NOWTIME,"006 BLRCN:",BLRCN,"02 BLRRSC:")=$GET(BLRRSC)
+28 ; S BLRRES=$$ASK(BLRRTI,BLRTP,BLRRSC)
+29 ; S BLRRES=$S(+$G(ORWCLVER):BLRRSC_U_BLRRTI_U,1:$$ASK(BLRRTI,BLRTP,BLRRSC)) ; LR*5.2*1031 -- IHS/MSC/MKK - if LAB ACCESSIONING GUI, then DO NOT ask Ref Lab AOE questions: only store the AOE questions
+30 ; LR*5.2*1031 -- IHS/MSC/SAT - if LAB ACCESSIONING GUI, then DO NOT ask Ref Lab AOE questions: only store the AOE questions and passed in answers
IF +$GET(BLRAGUI)
SET BLRRES=$$GUI(BLRAOE,TIEN,BLRRTI,BLRRSC,TN)
+31 ; LR*5.2*1031 -- IHS/MSC/SAT
IF '+$GET(BLRAGUI)
SET BLRRES=$$ASK(BLRRTI,BLRTP,BLRRSC)
+32 SET ^XTMP("BLRRLCOM",NOWTIME,"006 BLRCN:",BLRCN,"03 BLRRES:")=$GET(BLRRES)
+33 IF $GET(BLRRES)]""
SET BLRRLC(TIEN,BLRCN)=$GET(BLRRES)
End DoDot:1
+34 QUIT $GET(BLRRLC)
+35 ;
ASK(RTI,RTP,RSC) ; EP -- ask the comment question and get the result
+1 ; RTI = Prompt
+2 ; RTP =
+3 ; RSC = Result code
+4 NEW DIR
+5 SET DIR(0)="FO"
SET DIR("A")=RTI
+6 DO ^DIR
+7 SET BLRANS=Y
+8 QUIT RSC_U_RTI_U_BLRANS
+9 ;
GUI(BLRAOE,TIEN,RTI,RSC,TN) ;
+1 NEW BLRANS,BLRCNT
+2 IF $GET(TIEN)=""
QUIT
+3 SET BLRANS=""
+4 SET BLRRET=""
+5 ;BLRAOE = <question prompt> ^ <result code> ^ <free-text answer> ^ <test name>
+6 FOR BLRCNT=1:1:$LENGTH(BLRAOE,"|")
Begin DoDot:1
+7 IF $PIECE($PIECE(BLRAOE,"|",BLRCNT),U,4)=TN
Begin DoDot:2
+8 IF $PIECE($PIECE(BLRAOE,"|",BLRCNT),U,1)=RTI
Begin DoDot:3
+9 SET BLRANS=$PIECE($PIECE(BLRAOE,"|",BLRCNT),U,3)
End DoDot:3
End DoDot:2
End DoDot:1
IF BLRANS'=""
QUIT
+10 QUIT RSC_U_RTI_U_BLRANS
