CIAZPLAB ;CIA/PLS - Laboratory Protocol Event API ;23-Apr-2004 11:21;PLS
;;1.1;VUECENTRIC RPMS SUPPORT;;Sep 14, 2004
;;Copyright 2000-2004, Clinical Informatics Associates, Inc.
;=================================================================
; This routine implements the existing BLRTN logic via Protocols
HOOK ;
N ZMSG
M ZMSG=@XQORMSG
; Assumes that BLRLOG is already defined
Q:'$G(BLRLOG,1) ;PCC logging is turned off
N SEG,LP,DL1,DL2,ACTION,ORDSTS,TYP,CD,XLRACC,XLRSS,OBR
S LP=0
S SEG=$$SEG(XQORMSG,"MSH",.LP)
Q:'LP
S DL1=$E(SEG,4),DL2=$E(SEG,5)
Q:$P(SEG,DL1,3)'="LABORATORY"
S SEG=$$SEG(XQORMSG,"ORC",.LP)
Q:'LP
S ORDSTS=$P(SEG,DL1,6) ; Order Status
S ACTION=$P(SEG,DL1,2) ; Order Control
S XLRSS=$P($P(SEG,DL1,4),";",4)
S OBR=$$SEG(XQORMSG,"OBR",.LP)
Q:'LP
S XLRACC=$P(OBR,DL1,21) ;Accession Number - Text Format
I ACTION?2U,$L($T(@ACTION)) D
.S TYP=$$GETTYP()
.S CD=","
.D:$L(TYP) @ACTION
Q
; Return specified segment, starting at line LP
SEG(MSG,TYP,LP) ;
F S LP=$O(@MSG@(LP)) Q:'LP Q:$E(@MSG@(LP),1,$L(TYP))=TYP
Q $S(LP:@MSG@(LP),1:"")
;
GETTYP() ; Returns message type
Q $S($G(XQORMSG)["LRCH":"CH",$G(XQORMSG)["LRBB":"BB",$G(XQORMSG)["LRAP":"AP",1:"")
;
SET(N) ;
S $ZE="LRZHOOK LOG_"_N D ^ZTER ;Temporary
Q
FIXAA(XAA) ; Perform lookup on LRUID if LRAA is not defined
Q:+$G(XAA) XAA
I $L($G(LRUID)) Q +$O(^LRO(68,"C",LRUID,0))
Q 0
SN ; New Order
I ORDSTS="IP" D
.D ^BLREVTQ("C","O","MULTI",,$G(LRODT,"")_CD_$G(LRSN,""))
I ORDSTS="SC" D
.D ^BLREVTQ("C","A","ADDACC",,$G(LRODT)_CD_$G(LRSN)_CD_$$FIXAA($G(LRAA))_CD_$G(LRAD)_CD_$G(LRAN))
Q
SC ;
; Make order
I ORDSTS="IP" D
.D ^BLREVTQ("M","O","",,$G(LRODT,"")_CD_$G(LRSN,""))
; Make accession
I ORDSTS="SC" D
.N LRTS
.S LRTS=$P($P(OBR,DL1,5),DL2,4) ; Obtain Test IEN for File 60
.D ^BLREVTQ("C","A","ADDACC",,+$G(LRODT)_CD_+$G(LRSN)_CD_$$FIXAA($G(LRAA))_CD_+$G(LRAD)_CD_+$G(LRAN)_CD_$G(LRACC))
Q
OH ; Hold Order
Q
OD ; Order Delete
;D ^BLREVTQ("M","D","DELORD","ORDER") ;"TESTS",+$G(LRAA)_CD_+$G(LRAD)_CD_+$G(LRAN))
Q
OC ; Order Cancelled
D ^BLREVTQ("M","D","DELACC","TESTS",$G(LRAA)_CD_$G(LRAD)_CD_$G(LRAN))
Q
DC ; Discontinue Order
Q
RE ; Results
I TYP="CH" D Q
.I XLRSS="CH" D ; Chemistry
..D ^BLREVTQ("M","R","",,$S($L($G(LRACC)):LRACC,1:XLRACC))
.I XLRSS="MI" D ; Microbiology
..D ^BLREVTQ("M","R","MICRO",,+$G(LRAA)_CD_+$G(LRAD)_CD_+$G(LRAN))
I TYP="BB" D Q
.D ^BLREVTQ("M","R","BBANK",,+$G(LRODT)_CD_+$G(LRSN)_CD_+$G(LRAA)_CD_+$G(LRAD)_CD_+$G(LRAN))
I TYP="AP" Q ; Lab Package messaging is not enabled for AP
Q
CIAZPLAB ;CIA/PLS - Laboratory Protocol Event API ;23-Apr-2004 11:21;PLS
+1 ;;1.1;VUECENTRIC RPMS SUPPORT;;Sep 14, 2004
+2 ;;Copyright 2000-2004, Clinical Informatics Associates, Inc.
+3 ;=================================================================
+4 ; This routine implements the existing BLRTN logic via Protocols
HOOK ;
+1 NEW ZMSG
+2 MERGE ZMSG=@XQORMSG
+3 ; Assumes that BLRLOG is already defined
+4 ;PCC logging is turned off
IF '$GET(BLRLOG,1)
QUIT
+5 NEW SEG,LP,DL1,DL2,ACTION,ORDSTS,TYP,CD,XLRACC,XLRSS,OBR
+6 SET LP=0
+7 SET SEG=$$SEG(XQORMSG,"MSH",.LP)
+8 IF 'LP
QUIT
+9 SET DL1=$EXTRACT(SEG,4)
SET DL2=$EXTRACT(SEG,5)
+10 IF $PIECE(SEG,DL1,3)'="LABORATORY"
QUIT
+11 SET SEG=$$SEG(XQORMSG,"ORC",.LP)
+12 IF 'LP
QUIT
+13 ; Order Status
SET ORDSTS=$PIECE(SEG,DL1,6)
+14 ; Order Control
SET ACTION=$PIECE(SEG,DL1,2)
+15 SET XLRSS=$PIECE($PIECE(SEG,DL1,4),";",4)
+16 SET OBR=$$SEG(XQORMSG,"OBR",.LP)
+17 IF 'LP
QUIT
+18 ;Accession Number - Text Format
SET XLRACC=$PIECE(OBR,DL1,21)
+19 IF ACTION?2U
IF $LENGTH($TEXT(@ACTION))
Begin DoDot:1
+20 SET TYP=$$GETTYP()
+21 SET CD=","
+22 IF $LENGTH(TYP)
DO @ACTION
End DoDot:1
+23 QUIT
+24 ; Return specified segment, starting at line LP
SEG(MSG,TYP,LP) ;
+1 FOR
SET LP=$ORDER(@MSG@(LP))
IF 'LP
QUIT
IF $EXTRACT(@MSG@(LP),1,$LENGTH(TYP))=TYP
QUIT
+2 QUIT $SELECT(LP:@MSG@(LP),1:"")
+3 ;
GETTYP() ; Returns message type
+1 QUIT $SELECT($GET(XQORMSG)["LRCH":"CH",$GET(XQORMSG)["LRBB":"BB",$GET(XQORMSG)["LRAP":"AP",1:"")
+2 ;
SET(N) ;
+1 ;Temporary
SET $ZE="LRZHOOK LOG_"_N
DO ^ZTER
+2 QUIT
FIXAA(XAA) ; Perform lookup on LRUID if LRAA is not defined
+1 IF +$GET(XAA)
QUIT XAA
+2 IF $LENGTH($GET(LRUID))
QUIT +$ORDER(^LRO(68,"C",LRUID,0))
+3 QUIT 0
SN ; New Order
+1 IF ORDSTS="IP"
Begin DoDot:1
+2 DO ^BLREVTQ("C","O","MULTI",,$GET(LRODT,"")_CD_$GET(LRSN,""))
End DoDot:1
+3 IF ORDSTS="SC"
Begin DoDot:1
+4 DO ^BLREVTQ("C","A","ADDACC",,$GET(LRODT)_CD_$GET(LRSN)_CD_$$FIXAA($GET(LRAA))_CD_$GET(LRAD)_CD_$GET(LRAN))
End DoDot:1
+5 QUIT
SC ;
+1 ; Make order
+2 IF ORDSTS="IP"
Begin DoDot:1
+3 DO ^BLREVTQ("M","O","",,$GET(LRODT,"")_CD_$GET(LRSN,""))
End DoDot:1
+4 ; Make accession
+5 IF ORDSTS="SC"
Begin DoDot:1
+6 NEW LRTS
+7 ; Obtain Test IEN for File 60
SET LRTS=$PIECE($PIECE(OBR,DL1,5),DL2,4)
+8 DO ^BLREVTQ("C","A","ADDACC",,+$GET(LRODT)_CD_+$GET(LRSN)_CD_$$FIXAA($GET(LRAA))_CD_+$GET(LRAD)_CD_+$GET(LRAN)_CD_$GET(LRACC))
End DoDot:1
+9 QUIT
OH ; Hold Order
+1 QUIT
OD ; Order Delete
+1 ;D ^BLREVTQ("M","D","DELORD","ORDER") ;"TESTS",+$G(LRAA)_CD_+$G(LRAD)_CD_+$G(LRAN))
+2 QUIT
OC ; Order Cancelled
+1 DO ^BLREVTQ("M","D","DELACC","TESTS",$GET(LRAA)_CD_$GET(LRAD)_CD_$GET(LRAN))
+2 QUIT
DC ; Discontinue Order
+1 QUIT
RE ; Results
+1 IF TYP="CH"
Begin DoDot:1
+2 ; Chemistry
IF XLRSS="CH"
Begin DoDot:2
+3 DO ^BLREVTQ("M","R","",,$SELECT($LENGTH($GET(LRACC)):LRACC,1:XLRACC))
End DoDot:2
+4 ; Microbiology
IF XLRSS="MI"
Begin DoDot:2
+5 DO ^BLREVTQ("M","R","MICRO",,+$GET(LRAA)_CD_+$GET(LRAD)_CD_+$GET(LRAN))
End DoDot:2
End DoDot:1
QUIT
+6 IF TYP="BB"
Begin DoDot:1
+7 DO ^BLREVTQ("M","R","BBANK",,+$GET(LRODT)_CD_+$GET(LRSN)_CD_+$GET(LRAA)_CD_+$GET(LRAD)_CD_+$GET(LRAN))
End DoDot:1
QUIT
+8 ; Lab Package messaging is not enabled for AP
IF TYP="AP"
QUIT
+9 QUIT
