- LA7VORUA ;DALOI/JMC - Builder of HL7 Lab Results ;10/12/11 14:28
- ;;5.2;AUTOMATED LAB INSTRUMENTS;**61,64,68,74**;Sep 27, 1994;Build 229
- ;
- Q
- ;
- ;
- OBX ;Observation/Result segment for Lab Results
- ;
- ;ZEXCEPT: GBL,LA,LA76249,LA7NOMSG,LA7NTESN,LA7NVAF
- ;
- N LA7953,LA7DATA,LA7VT,LA7VTIEN,LA7X
- ;
- S LA7VTIEN=0
- F S LA7VTIEN=$O(^LAHM(62.49,LA(62.49),1,LA7VTIEN)) Q:'LA7VTIEN D
- . S LA7VT=$P(^LAHM(62.49,LA(62.49),1,LA7VTIEN,0),"^",1,2)
- . ;
- . ; Send back an OBX if individual test from a panel was NP'ed - ccr_6164n
- . N LA7VNP ; LA7VNP is a flag used by CH^LA7VOBX1 to determine if test was NP'ed.
- . S LA7VNP=0
- . S LA7VNP=$$CHECKNP(LA("HUID"),+$P(LA7VT,"^",1))
- . ;
- . ; Build OBX segment
- . K LA7DATA
- . D OBX^LA7VOBX(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^",1,2),.LA7DATA,.LA7OBXSN,LA7FS,LA7ECH,$G(LA7NVAF))
- . ; If OBX failed to build then don't store
- . I '$D(LA7DATA) Q
- . ;
- . D FILESEG^LA7VHLU(GBL,.LA7DATA)
- . I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
- . ;
- . ; Send performing lab comment and interpretation from file #60
- . S LA7NTESN=0
- . I LA7NVAF=1 D PLC^LA7VORUA
- . I LA7VNP Q ; ccr_6164n
- . D INTRP^LA7VORUA
- . ;
- . ; Mark result as sent - set to 1, if corrected results set to 2
- . I LA("SUB")="CH" D
- . . I $P(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^")),"^",10)>1 Q
- . . S $P(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^")),"^",10)=$S($P(LA7VT,"^",2)="C":2,1:1)
- ;
- Q
- ;
- ;
- NTE ; Build NTE segment
- ;
- ;ZEXCEPT: LA,LA7INTYP,LA7NVAF
- ;
- N LA7CMTYP,LA7FMT,LA7J,LA7NTE,LA7SOC,LA7TXT,LA7TYP,LA7X,LA7Y,X
- ;
- ; 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="VA-LRMI001",LA7J=1
- . I LA7X="" Q
- . I LA7FMT S LA7Y(LA7CMTYP,LA7J)=LA7X
- . E S LA7TXT=LA7X D NTE^LA7VORU1
- ;
- ; 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="VA-LR002"
- . . I $E(LA7X,1)="~" S LA7CMTYP="VA-LR001"
- . . I LA7X="" S LA7X=" "
- . . I LA7FMT S LA7Y(LA7CMTYP,LA7J)=LA7X
- . . E S LA7TXT=LA7X D NTE^LA7VORU1
- ;
- ; 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^LA7VORU1
- ;
- Q
- ;
- ;
- PLC ; Reporting lab comment
- ;
- ;ZEXCEPT: LA,LA7VT
- ;
- N LA74,LA7DIV,LA7NTE,LA7RNLT,LA7SOC,LA7TSTN,LA7X,X
- S (LA74,LA7DIV,LA7RNLT,LA7TSTN)=""
- ;
- ; 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)
- . ; If verifying institution not stored with result, use releasing inst. or inst. of user - ccr_6164n
- . I LA74="" S LA74=$P($G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),"RF")),"^")
- . I LA74="",$$DIV4^XUSER(.LA74,$P(LA7X,"^",4)) S LA74=$O(LA74(0))
- . ;
- . ; if NLT code of reported test is not stored with result, use default code - ccr_6164n
- . I $P($P(LA7X,"^",3),"!",2)="" D
- . . S $P(LA7X,"^",3)=$$DEFCODE^LA7VHLU5(LA("SUB"),$P(LA7VT,"^"),$P(LA7X,"^",3),$P($G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0)),"^",5))
- . ;
- . S LA7RNLT=$P($P(LA7X,"^",3),"!",2)
- ;
- I LA("SUB")="MI" D
- . S LA74=$P($G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),"RF")),"^") Q:LA74
- . S LA7X=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0))
- . S LA74=$P(LA7X,"^",15)
- ;
- I "SPCYEM"[LA("SUB") S LA74=$P($G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),"RF")),"^")
- ;
- D BPLC
- Q
- ;
- ;
- BPLC ; Build NTE segment with performing lab disclosure statement
- ;
- ;ZEXCEPT: LA,LA74,LA7DIV,LA7NLT,LA7NVAF,LA7RNLT,LA7SOC,LA7TSTN,LA7TXT
- ;
- N LA7CMTYP,LA7FMT,LA7TXT,LA7X,X
- ;
- S LA7CMTYP="",LA7FMT=0
- ;
- ; Source of comment - handle other system's special codes, i.e. DOD-CHCS
- S LA7SOC=$S($G(LA7NVAF)=1:"DS",1:"L")
- ;
- I LA74="" S LA74=+$$KSP^XUPARAM("INST")
- 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^LA7VORU1
- S X=$$PADD^XUAF4(LA74)
- S LA7TXT=$P(X,U)_" "_$P(X,U,2)_", "_$P(X,U,3)_" "_$P(X,U,4)
- S X=$$ID^XUAF4("CLIA",LA74)
- I X'="" S LA7TXT=LA7TXT_" (CLIA# "_X_")"
- D NTE^LA7VORU1
- Q
- ;
- ;
- INTRP ; Send test interpretation
- ; Send "CH" subscript file #60 site/specimen's interpretation field (#5.5)
- ;
- ;ZEXCEPT: LA,LA763,LA7INTYP,LA7NVAF,LA7V,LA7VT
- ;
- 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="VA-LR003"
- ;
- ; 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^LA7VORU1
- ;
- I LA7FMT,$D(LA7TXT) D NTE^LA7VORU1
- ;
- Q
- ;
- ;
- CHECKNP(HUID,LRSB) ; Check if test was NP'ed - added with ccr_6164n
- ;
- ; Call with HUID = Host UID
- ; LRSB = "CH" subscript node (Data Name)
- ;
- ; Returns LA7VNP = 0 - Test was not NP'ed
- ; 1 - This test was NP'ed
- ;
- ;
- N LA760,LA7AA,LA7AD,LA7AN,LA7VNP,LA7Y
- ;
- S LA7VNP=0
- ;
- S LA7Y=$$CHECKUID^LRWU4(HUID)
- S LA760=+$O(^LAB(60,"C","CH;"_+LRSB_";1",0))
- I 'LA7Y!('LA760) Q LA7VNP
- ;
- S LA7AA=+$P(LA7Y,U,2)
- S LA7AD=+$P(LA7Y,U,3)
- S LA7AN=+$P(LA7Y,U,4)
- ;
- I $P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA760,0)),U,6)="*Not Performed" S LA7VNP=1 Q LA7VNP
- ;
- I '$D(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA760,0)),'LA7VNP D
- . N LA7TST
- . S LA7TST=0
- . F S LA7TST=$O(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA7TST)) Q:'LA7TST!(LA7VNP) D
- . . N LA7TREE
- . . I $P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA7TST,0)),U,6)'="*Not Performed" Q
- . . D UNWIND^LA7ADL1(LA7TST,9,LA7TST)
- . . I $D(LA7TREE(LA760)) S LA7VNP=1
- ;
- Q LA7VNP
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7VORUA 7001 printed Jan 18, 2025@02:42:18 Page 2
- LA7VORUA ;DALOI/JMC - Builder of HL7 Lab Results ;10/12/11 14:28
- +1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**61,64,68,74**;Sep 27, 1994;Build 229
- +2 ;
- +3 QUIT
- +4 ;
- +5 ;
- OBX ;Observation/Result segment for Lab Results
- +1 ;
- +2 ;ZEXCEPT: GBL,LA,LA76249,LA7NOMSG,LA7NTESN,LA7NVAF
- +3 ;
- +4 NEW LA7953,LA7DATA,LA7VT,LA7VTIEN,LA7X
- +5 ;
- +6 SET LA7VTIEN=0
- +7 FOR
- SET LA7VTIEN=$ORDER(^LAHM(62.49,LA(62.49),1,LA7VTIEN))
- if 'LA7VTIEN
- QUIT
- Begin DoDot:1
- +8 SET LA7VT=$PIECE(^LAHM(62.49,LA(62.49),1,LA7VTIEN,0),"^",1,2)
- +9 ;
- +10 ; Send back an OBX if individual test from a panel was NP'ed - ccr_6164n
- +11 ; LA7VNP is a flag used by CH^LA7VOBX1 to determine if test was NP'ed.
- NEW LA7VNP
- +12 SET LA7VNP=0
- +13 SET LA7VNP=$$CHECKNP(LA("HUID"),+$PIECE(LA7VT,"^",1))
- +14 ;
- +15 ; Build OBX segment
- +16 KILL LA7DATA
- +17 DO OBX^LA7VOBX(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$PIECE(LA7VT,"^",1,2),.LA7DATA,.LA7OBXSN,LA7FS,LA7ECH,$GET(LA7NVAF))
- +18 ; If OBX failed to build then don't store
- +19 IF '$DATA(LA7DATA)
- QUIT
- +20 ;
- +21 DO FILESEG^LA7VHLU(GBL,.LA7DATA)
- +22 IF '$GET(LA7NOMSG)
- DO FILE6249^LA7VHLU(LA76249,.LA7DATA)
- +23 ;
- +24 ; Send performing lab comment and interpretation from file #60
- +25 SET LA7NTESN=0
- +26 IF LA7NVAF=1
- DO PLC^LA7VORUA
- +27 ; ccr_6164n
- IF LA7VNP
- QUIT
- +28 DO INTRP^LA7VORUA
- +29 ;
- +30 ; Mark result as sent - set to 1, if corrected results set to 2
- +31 IF LA("SUB")="CH"
- Begin DoDot:2
- +32 IF $PIECE(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$PIECE(LA7VT,"^")),"^",10)>1
- QUIT
- +33 SET $PIECE(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$PIECE(LA7VT,"^")),"^",10)=$SELECT($PIECE(LA7VT,"^",2)="C":2,1:1)
- End DoDot:2
- End DoDot:1
- +34 ;
- +35 QUIT
- +36 ;
- +37 ;
- NTE ; Build NTE segment
- +1 ;
- +2 ;ZEXCEPT: LA,LA7INTYP,LA7NVAF
- +3 ;
- +4 NEW LA7CMTYP,LA7FMT,LA7J,LA7NTE,LA7SOC,LA7TXT,LA7TYP,LA7X,LA7Y,X
- +5 ;
- +6 ; Source of comment - handle other system's special codes, i.e. DOD-CHCS
- +7 SET LA7SOC=$SELECT($GET(LA7NVAF)=1:"AC",1:"L")
- +8 ;
- +9 SET LA7FMT=0
- +10 ; If HDR interface then send as repetition text.
- +11 IF $GET(LA7INTYP)=30
- SET LA7FMT=2
- +12 ;
- +13 ; Send "MI" specimen's comments
- +14 IF LA("SUB")="MI"
- Begin DoDot:1
- +15 KILL LA7NTE
- +16 SET LA7X=$GET(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),99))
- SET LA7CMTYP="VA-LRMI001"
- SET LA7J=1
- +17 IF LA7X=""
- QUIT
- +18 IF LA7FMT
- SET LA7Y(LA7CMTYP,LA7J)=LA7X
- +19 IF '$TEST
- SET LA7TXT=LA7X
- DO NTE^LA7VORU1
- End DoDot:1
- +20 ;
- +21 ; Send "CH" specimen's comments
- +22 IF LA("SUB")="CH"
- Begin DoDot:1
- +23 SET LA7J=0
- +24 FOR
- SET LA7J=$ORDER(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),1,LA7J))
- if 'LA7J
- QUIT
- Begin DoDot:2
- +25 KILL LA7NTE
- +26 SET LA7X=$GET(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),1,LA7J,0))
- SET LA7CMTYP="VA-LR002"
- +27 IF $EXTRACT(LA7X,1)="~"
- SET LA7CMTYP="VA-LR001"
- +28 IF LA7X=""
- SET LA7X=" "
- +29 IF LA7FMT
- SET LA7Y(LA7CMTYP,LA7J)=LA7X
- +30 IF '$TEST
- SET LA7TXT=LA7X
- DO NTE^LA7VORU1
- End DoDot:2
- End DoDot:1
- +31 ;
- +32 ; If formatted or repetition format then build each type of comments to an NTE segment.
- +33 IF LA7FMT
- Begin DoDot:1
- +34 SET LA7CMTYP=""
- +35 FOR
- SET LA7CMTYP=$ORDER(LA7Y(LA7CMTYP))
- if LA7CMTYP=""
- QUIT
- Begin DoDot:2
- +36 KILL LA7TXT
- +37 MERGE LA7TXT=LA7Y(LA7CMTYP)
- +38 DO NTE^LA7VORU1
- End DoDot:2
- End DoDot:1
- +39 ;
- +40 QUIT
- +41 ;
- +42 ;
- PLC ; Reporting lab comment
- +1 ;
- +2 ;ZEXCEPT: LA,LA7VT
- +3 ;
- +4 NEW LA74,LA7DIV,LA7NTE,LA7RNLT,LA7SOC,LA7TSTN,LA7X,X
- +5 SET (LA74,LA7DIV,LA7RNLT,LA7TSTN)=""
- +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 ; If verifying institution not stored with result, use releasing inst. or inst. of user - ccr_6164n
- +12 IF LA74=""
- SET LA74=$PIECE($GET(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),"RF")),"^")
- +13 IF LA74=""
- IF $$DIV4^XUSER(.LA74,$PIECE(LA7X,"^",4))
- SET LA74=$ORDER(LA74(0))
- +14 ;
- +15 ; if NLT code of reported test is not stored with result, use default code - ccr_6164n
- +16 IF $PIECE($PIECE(LA7X,"^",3),"!",2)=""
- Begin DoDot:2
- +17 SET $PIECE(LA7X,"^",3)=$$DEFCODE^LA7VHLU5(LA("SUB"),$PIECE(LA7VT,"^"),$PIECE(LA7X,"^",3),$PIECE($GET(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0)),"^",5))
- End DoDot:2
- +18 ;
- +19 SET LA7RNLT=$PIECE($PIECE(LA7X,"^",3),"!",2)
- End DoDot:1
- +20 ;
- +21 IF LA("SUB")="MI"
- Begin DoDot:1
- +22 SET LA74=$PIECE($GET(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),"RF")),"^")
- if LA74
- QUIT
- +23 SET LA7X=$GET(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0))
- +24 SET LA74=$PIECE(LA7X,"^",15)
- End DoDot:1
- +25 ;
- +26 IF "SPCYEM"[LA("SUB")
- SET LA74=$PIECE($GET(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),"RF")),"^")
- +27 ;
- +28 DO BPLC
- +29 QUIT
- +30 ;
- +31 ;
- BPLC ; Build NTE segment with performing lab disclosure statement
- +1 ;
- +2 ;ZEXCEPT: LA,LA74,LA7DIV,LA7NLT,LA7NVAF,LA7RNLT,LA7SOC,LA7TSTN,LA7TXT
- +3 ;
- +4 NEW LA7CMTYP,LA7FMT,LA7TXT,LA7X,X
- +5 ;
- +6 SET LA7CMTYP=""
- SET LA7FMT=0
- +7 ;
- +8 ; Source of comment - handle other system's special codes, i.e. DOD-CHCS
- +9 SET LA7SOC=$SELECT($GET(LA7NVAF)=1:"DS",1:"L")
- +10 ;
- +11 IF LA74=""
- SET LA74=+$$KSP^XUPARAM("INST")
- +12 IF LA74
- SET LA7DIV=$$NAME^XUAF4(LA74)
- +13 ;
- +14 ; Build result test name
- +15 IF LA7RNLT=""
- Begin DoDot:1
- +16 IF $GET(LA("NLT"))'=""
- SET LA7RNLT=LA("NLT")
- QUIT
- +17 SET LA7RNLT=$GET(LA7NLT)
- End DoDot:1
- +18 IF LA7RNLT
- Begin DoDot:1
- +19 SET LA7X=$ORDER(^LAM("E",LA7RNLT,0))
- +20 IF LA7X
- SET LA7TSTN=$$GET1^DIQ(64,LA7X_",",.01,"I")
- End DoDot:1
- +21 ;
- +22 SET LA7TXT=LA7TSTN_" results from "_LA7DIV_"."
- +23 DO NTE^LA7VORU1
- +24 SET X=$$PADD^XUAF4(LA74)
- +25 SET LA7TXT=$PIECE(X,U)_" "_$PIECE(X,U,2)_", "_$PIECE(X,U,3)_" "_$PIECE(X,U,4)
- +26 SET X=$$ID^XUAF4("CLIA",LA74)
- +27 IF X'=""
- SET LA7TXT=LA7TXT_" (CLIA# "_X_")"
- +28 DO NTE^LA7VORU1
- +29 QUIT
- +30 ;
- +31 ;
- INTRP ; Send test interpretation
- +1 ; Send "CH" subscript file #60 site/specimen's interpretation field (#5.5)
- +2 ;
- +3 ;ZEXCEPT: LA,LA763,LA7INTYP,LA7NVAF,LA7V,LA7VT
- +4 ;
- +5 NEW LA760,LA761,LA7CMTYP,LA7FMT,LA7J,LA7NTE,LA7SOC,LA7TXT,LA7X,LA7Y,LRSB
- +6 ;
- +7 SET LRSB=$PIECE(LA7VT,"^")
- SET (LA7FMT,LA7Y)=0
- +8 SET LA761=+$PIECE(LA763(0),"^",5)
- +9 SET LA7X=^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),LRSB)
- +10 SET LA760=+$PIECE($PIECE(LA7X,"^",3),"!",7)
- +11 IF LA760
- IF $DATA(^LAB(60,LA760,1,LA761,1))
- SET LA7Y=1
- +12 IF 'LA760
- Begin DoDot:1
- +13 SET LA760=0
- +14 FOR
- SET LA760=$ORDER(^LAB(60,"C","CH;"_LRSB_";1",LA760))
- if 'LA760
- QUIT
- Begin DoDot:2
- +15 IF $DATA(^LAB(60,LA760,1,LA761,1))
- SET LA7Y=1
- End DoDot:2
- if LA7Y
- QUIT
- End DoDot:1
- +16 ;
- +17 IF 'LA7Y
- QUIT
- +18 ;
- +19 ; Source of comment - handle other system's special codes, i.e. DOD-CHCS
- +20 SET LA7SOC=$SELECT($GET(LA7NVAF)=1:"RI",1:"L")
- SET LA7CMTYP="VA-LR003"
- +21 ;
- +22 ; If HDR interface then send as repetition text.
- +23 IF $GET(LA7INTYP)=30
- SET LA7FMT=2
- +24 ;
- +25 ; Build each line of interpretation as a NTE segment unless formatting flag (LA7FMT) indicates
- +26 ; either formatted text or repetition.
- +27 SET LA7J=0
- +28 FOR
- SET LA7J=$ORDER(^LAB(60,LA760,1,LA761,1,LA7J))
- if 'LA7J
- QUIT
- Begin DoDot:1
- +29 SET LA7X=$GET(^LAB(60,LA760,1,LA761,1,LA7J,0))
- +30 IF LA7X=""
- SET LA7X=" "
- +31 IF LA7FMT
- SET LA7TXT(LA7J)=LA7X
- +32 IF '$TEST
- SET LA7TXT=LA7X
- DO NTE^LA7VORU1
- End DoDot:1
- +33 ;
- +34 IF LA7FMT
- IF $DATA(LA7TXT)
- DO NTE^LA7VORU1
- +35 ;
- +36 QUIT
- +37 ;
- +38 ;
- CHECKNP(HUID,LRSB) ; Check if test was NP'ed - added with ccr_6164n
- +1 ;
- +2 ; Call with HUID = Host UID
- +3 ; LRSB = "CH" subscript node (Data Name)
- +4 ;
- +5 ; Returns LA7VNP = 0 - Test was not NP'ed
- +6 ; 1 - This test was NP'ed
- +7 ;
- +8 ;
- +9 NEW LA760,LA7AA,LA7AD,LA7AN,LA7VNP,LA7Y
- +10 ;
- +11 SET LA7VNP=0
- +12 ;
- +13 SET LA7Y=$$CHECKUID^LRWU4(HUID)
- +14 SET LA760=+$ORDER(^LAB(60,"C","CH;"_+LRSB_";1",0))
- +15 IF 'LA7Y!('LA760)
- QUIT LA7VNP
- +16 ;
- +17 SET LA7AA=+$PIECE(LA7Y,U,2)
- +18 SET LA7AD=+$PIECE(LA7Y,U,3)
- +19 SET LA7AN=+$PIECE(LA7Y,U,4)
- +20 ;
- +21 IF $PIECE($GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA760,0)),U,6)="*Not Performed"
- SET LA7VNP=1
- QUIT LA7VNP
- +22 ;
- +23 IF '$DATA(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA760,0))
- IF 'LA7VNP
- Begin DoDot:1
- +24 NEW LA7TST
- +25 SET LA7TST=0
- +26 FOR
- SET LA7TST=$ORDER(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA7TST))
- if 'LA7TST!(LA7VNP)
- QUIT
- Begin DoDot:2
- +27 NEW LA7TREE
- +28 IF $PIECE($GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA7TST,0)),U,6)'="*Not Performed"
- QUIT
- +29 DO UNWIND^LA7ADL1(LA7TST,9,LA7TST)
- +30 IF $DATA(LA7TREE(LA760))
- SET LA7VNP=1
- End DoDot:2
- End DoDot:1
- +31 ;
- +32 QUIT LA7VNP