LA7CORUA ;VA/DALOI/JMC - Builder of HL7 Lab Results NTE ; 22-Oct-2013 09:22 ; MAW
;;5.2;AUTOMATED LAB INSTRUMENTS;**61,1018,64,1027,68,1033**;NOV 01, 1997
;
;
NTE ; Build NTE segment
;
N LA7CMTYP,LA7FMT,LA7J,LA7NTE,LA7SOC,LA7TXT,LA7TYP,LA7X,LA7Y,X
;
; Initialize segment set id
S LA7NTESN=0
;
; Source of comment - handle other system's special codes, i.e. DOD-CHCS
S LA7SOC=$S($G(LA7NVAF)=1:"AC",1:"L")
;
S LA7FMT=0
; If HDR interface then send as repetition text.
I $G(LA7INTYP)=30 S LA7FMT=2
;
; Send "MI" specimen's comments
I LA("SUB")="MI" D
. K LA7NTE
. S LA7X=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),99)),LA7CMTYP="RE",LA7J=1
. I LA7X="" Q
. I LA7FMT S LA7Y(LA7CMTYP,LA7J)=LA7X
. E S LA7TXT=LA7X D NTE^LA7CORU1
;
; Send "CH" specimen's comments
I LA("SUB")="CH" D
. S LA7J=0
. F S LA7J=$O(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),1,LA7J)) Q:'LA7J D
. . K LA7NTE
. . S LA7X=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),1,LA7J,0)),LA7CMTYP="RE"
. . I $E(LA7X,1)="~" S LA7CMTYP="RE"
. . I LA7X="" S LA7X=" "
. . I LA7FMT S LA7Y(LA7CMTYP,LA7J)=LA7X
. . E S LA7TXT=LA7X D NTE^LA7CORU1
;
; If formatted or repetition format then build each type of comments to an NTE segment.
I LA7FMT D
. S LA7CMTYP=""
. F S LA7CMTYP=$O(LA7Y(LA7CMTYP)) Q:LA7CMTYP="" D
. . K LA7TXT
. . M LA7TXT=LA7Y(LA7CMTYP)
. . D NTE^LA7CORU1
Q
;
;
PLC ; Performing lab comment
N LA74,LA7DIV,LA7CMTYP,LA7FMT,LA7NTE,LA7RNLT,LA7SOC,LA7TSTN,LA7TXT,LA7X,X
S (LA74,LA7CMTYP,LA7DIV,LA7RNLT,LA7TSTN)="",LA7FMT=0
;
; Source of comment - handle other system's special codes, i.e. DOD-CHCS
S LA7SOC=$S($G(LA7NVAF)=1:"DS",1:"L")
;
; Find reporting facility (division).
I LA("SUB")="CH" D
. S LA7X=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^")))
. S LA74=$P(LA7X,"^",9)
. S LA7RNLT=$P($P(LA7X,"^",3),"!",2)
I LA74="" S LA74=+$P($G(^XMB(1,1,"XUS")),"^",17)
I LA74 S LA7DIV=$$NAME^XUAF4(LA74)
;
; Build result test name
I LA7RNLT="" D
. I $G(LA("NLT"))'="" S LA7RNLT=LA("NLT") Q
. S LA7RNLT=$G(LA7NLT)
I LA7RNLT D
. S LA7X=$O(^LAM("E",LA7RNLT,0))
. I LA7X S LA7TSTN=$$GET1^DIQ(64,LA7X_",",.01,"I")
;
S LA7TXT=LA7TSTN_" results from "_LA7DIV_"."
D NTE^LA7CORU1
S X=$$PADD^XUAF4(LA74)
S LA7TXT=$P(X,U)_" "_$P(X,U,2)_", "_$P(X,U,3)_" "_$P(X,U,4)
D NTE^LA7CORU1
Q
;
;
INTRP ; Send test interpretation
; Send "CH" subscript file #60 site/specimen's interpretation field (#5.5)
;
N LA760,LA761,LA7CMTYP,LA7FMT,LA7J,LA7NTE,LA7SOC,LA7TXT,LA7X,LA7Y,LRSB
;
S LRSB=$P(LA7VT,"^"),(LA7FMT,LA7Y)=0
S LA761=+$P(LA763(0),"^",5)
S LA7X=^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),LRSB)
S LA760=+$P($P(LA7X,"^",3),"!",7)
I LA760,$D(^LAB(60,LA760,1,LA761,1)) S LA7Y=1
I 'LA760 D
. S LA760=0
. F S LA760=$O(^LAB(60,"C","CH;"_LRSB_";1",LA760)) Q:'LA760 D Q:LA7Y
. . I $D(^LAB(60,LA760,1,LA761,1)) S LA7Y=1
;
I 'LA7Y Q
;
; Source of comment - handle other system's special codes, i.e. DOD-CHCS
S LA7SOC=$S($G(LA7NVAF)=1:"RI",1:"L"),LA7CMTYP="RE"
;
; If HDR interface then send as repetition text.
I $G(LA7INTYP)=30 S LA7FMT=2
;
; Build each line of interpretation as a NTE segment unless formatting flag (LA7FMT) indicates
; either formatted text or repetition.
S LA7J=0
F S LA7J=$O(^LAB(60,LA760,1,LA761,1,LA7J)) Q:'LA7J D
. S LA7X=$G(^LAB(60,LA760,1,LA761,1,LA7J,0))
. I LA7X="" S LA7X=" "
. I LA7FMT S LA7TXT(LA7J)=LA7X
. E S LA7TXT=LA7X D NTE^LA7CORU1
;
I LA7FMT>0,$D(LA7TXT) D NTE^LA7CORU1
;
Q
LA7CORUA ;VA/DALOI/JMC - Builder of HL7 Lab Results NTE ; 22-Oct-2013 09:22 ; MAW
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**61,1018,64,1027,68,1033**;NOV 01, 1997
+2 ;
+3 ;
NTE ; Build NTE segment
+1 ;
+2 NEW LA7CMTYP,LA7FMT,LA7J,LA7NTE,LA7SOC,LA7TXT,LA7TYP,LA7X,LA7Y,X
+3 ;
+4 ; Initialize segment set id
+5 SET LA7NTESN=0
+6 ;
+7 ; Source of comment - handle other system's special codes, i.e. DOD-CHCS
+8 SET LA7SOC=$SELECT($GET(LA7NVAF)=1:"AC",1:"L")
+9 ;
+10 SET LA7FMT=0
+11 ; If HDR interface then send as repetition text.
+12 IF $GET(LA7INTYP)=30
SET LA7FMT=2
+13 ;
+14 ; Send "MI" specimen's comments
+15 IF LA("SUB")="MI"
Begin DoDot:1
+16 KILL LA7NTE
+17 SET LA7X=$GET(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),99))
SET LA7CMTYP="RE"
SET LA7J=1
+18 IF LA7X=""
QUIT
+19 IF LA7FMT
SET LA7Y(LA7CMTYP,LA7J)=LA7X
+20 IF '$TEST
SET LA7TXT=LA7X
DO NTE^LA7CORU1
End DoDot:1
+21 ;
+22 ; Send "CH" specimen's comments
+23 IF LA("SUB")="CH"
Begin DoDot:1
+24 SET LA7J=0
+25 FOR
SET LA7J=$ORDER(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),1,LA7J))
IF 'LA7J
QUIT
Begin DoDot:2
+26 KILL LA7NTE
+27 SET LA7X=$GET(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),1,LA7J,0))
SET LA7CMTYP="RE"
+28 IF $EXTRACT(LA7X,1)="~"
SET LA7CMTYP="RE"
+29 IF LA7X=""
SET LA7X=" "
+30 IF LA7FMT
SET LA7Y(LA7CMTYP,LA7J)=LA7X
+31 IF '$TEST
SET LA7TXT=LA7X
DO NTE^LA7CORU1
End DoDot:2
End DoDot:1
+32 ;
+33 ; If formatted or repetition format then build each type of comments to an NTE segment.
+34 IF LA7FMT
Begin DoDot:1
+35 SET LA7CMTYP=""
+36 FOR
SET LA7CMTYP=$ORDER(LA7Y(LA7CMTYP))
IF LA7CMTYP=""
QUIT
Begin DoDot:2
+37 KILL LA7TXT
+38 MERGE LA7TXT=LA7Y(LA7CMTYP)
+39 DO NTE^LA7CORU1
End DoDot:2
End DoDot:1
+40 QUIT
+41 ;
+42 ;
PLC ; Performing lab comment
+1 NEW LA74,LA7DIV,LA7CMTYP,LA7FMT,LA7NTE,LA7RNLT,LA7SOC,LA7TSTN,LA7TXT,LA7X,X
+2 SET (LA74,LA7CMTYP,LA7DIV,LA7RNLT,LA7TSTN)=""
SET LA7FMT=0
+3 ;
+4 ; Source of comment - handle other system's special codes, i.e. DOD-CHCS
+5 SET LA7SOC=$SELECT($GET(LA7NVAF)=1:"DS",1:"L")
+6 ;
+7 ; Find reporting facility (division).
+8 IF LA("SUB")="CH"
Begin DoDot:1
+9 SET LA7X=$GET(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$PIECE(LA7VT,"^")))
+10 SET LA74=$PIECE(LA7X,"^",9)
+11 SET LA7RNLT=$PIECE($PIECE(LA7X,"^",3),"!",2)
End DoDot:1
+12 IF LA74=""
SET LA74=+$PIECE($GET(^XMB(1,1,"XUS")),"^",17)
+13 IF LA74
SET LA7DIV=$$NAME^XUAF4(LA74)
+14 ;
+15 ; Build result test name
+16 IF LA7RNLT=""
Begin DoDot:1
+17 IF $GET(LA("NLT"))'=""
SET LA7RNLT=LA("NLT")
QUIT
+18 SET LA7RNLT=$GET(LA7NLT)
End DoDot:1
+19 IF LA7RNLT
Begin DoDot:1
+20 SET LA7X=$ORDER(^LAM("E",LA7RNLT,0))
+21 IF LA7X
SET LA7TSTN=$$GET1^DIQ(64,LA7X_",",.01,"I")
End DoDot:1
+22 ;
+23 SET LA7TXT=LA7TSTN_" results from "_LA7DIV_"."
+24 DO NTE^LA7CORU1
+25 SET X=$$PADD^XUAF4(LA74)
+26 SET LA7TXT=$PIECE(X,U)_" "_$PIECE(X,U,2)_", "_$PIECE(X,U,3)_" "_$PIECE(X,U,4)
+27 DO NTE^LA7CORU1
+28 QUIT
+29 ;
+30 ;
INTRP ; Send test interpretation
+1 ; Send "CH" subscript file #60 site/specimen's interpretation field (#5.5)
+2 ;
+3 NEW LA760,LA761,LA7CMTYP,LA7FMT,LA7J,LA7NTE,LA7SOC,LA7TXT,LA7X,LA7Y,LRSB
+4 ;
+5 SET LRSB=$PIECE(LA7VT,"^")
SET (LA7FMT,LA7Y)=0
+6 SET LA761=+$PIECE(LA763(0),"^",5)
+7 SET LA7X=^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),LRSB)
+8 SET LA760=+$PIECE($PIECE(LA7X,"^",3),"!",7)
+9 IF LA760
IF $DATA(^LAB(60,LA760,1,LA761,1))
SET LA7Y=1
+10 IF 'LA760
Begin DoDot:1
+11 SET LA760=0
+12 FOR
SET LA760=$ORDER(^LAB(60,"C","CH;"_LRSB_";1",LA760))
IF 'LA760
QUIT
Begin DoDot:2
+13 IF $DATA(^LAB(60,LA760,1,LA761,1))
SET LA7Y=1
End DoDot:2
IF LA7Y
QUIT
End DoDot:1
+14 ;
+15 IF 'LA7Y
QUIT
+16 ;
+17 ; Source of comment - handle other system's special codes, i.e. DOD-CHCS
+18 SET LA7SOC=$SELECT($GET(LA7NVAF)=1:"RI",1:"L")
SET LA7CMTYP="RE"
+19 ;
+20 ; If HDR interface then send as repetition text.
+21 IF $GET(LA7INTYP)=30
SET LA7FMT=2
+22 ;
+23 ; Build each line of interpretation as a NTE segment unless formatting flag (LA7FMT) indicates
+24 ; either formatted text or repetition.
+25 SET LA7J=0
+26 FOR
SET LA7J=$ORDER(^LAB(60,LA760,1,LA761,1,LA7J))
IF 'LA7J
QUIT
Begin DoDot:1
+27 SET LA7X=$GET(^LAB(60,LA760,1,LA761,1,LA7J,0))
+28 IF LA7X=""
SET LA7X=" "
+29 IF LA7FMT
SET LA7TXT(LA7J)=LA7X
+30 IF '$TEST
SET LA7TXT=LA7X
DO NTE^LA7CORU1
End DoDot:1
+31 ;
+32 IF LA7FMT>0
IF $DATA(LA7TXT)
DO NTE^LA7CORU1
+33 ;
+34 QUIT
