- 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
