Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LA7VORUA

LA7VORUA.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. Q
  1. ;
  1. ;
  1. OBX ;Observation/Result segment for Lab Results
  1. ;
  1. ;ZEXCEPT: GBL,LA,LA76249,LA7NOMSG,LA7NTESN,LA7NVAF
  1. ;
  1. N LA7953,LA7DATA,LA7VT,LA7VTIEN,LA7X
  1. ;
  1. S LA7VTIEN=0
  1. F S LA7VTIEN=$O(^LAHM(62.49,LA(62.49),1,LA7VTIEN)) Q:'LA7VTIEN D
  1. . S LA7VT=$P(^LAHM(62.49,LA(62.49),1,LA7VTIEN,0),"^",1,2)
  1. . ;
  1. . ; Send back an OBX if individual test from a panel was NP'ed - ccr_6164n
  1. . N LA7VNP ; LA7VNP is a flag used by CH^LA7VOBX1 to determine if test was NP'ed.
  1. . S LA7VNP=0
  1. . S LA7VNP=$$CHECKNP(LA("HUID"),+$P(LA7VT,"^",1))
  1. . ;
  1. . ; Build OBX segment
  1. . K LA7DATA
  1. . D OBX^LA7VOBX(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^",1,2),.LA7DATA,.LA7OBXSN,LA7FS,LA7ECH,$G(LA7NVAF))
  1. . ; If OBX failed to build then don't store
  1. . I '$D(LA7DATA) Q
  1. . ;
  1. . D FILESEG^LA7VHLU(GBL,.LA7DATA)
  1. . I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
  1. . ;
  1. . ; Send performing lab comment and interpretation from file #60
  1. . S LA7NTESN=0
  1. . I LA7NVAF=1 D PLC^LA7VORUA
  1. . I LA7VNP Q ; ccr_6164n
  1. . D INTRP^LA7VORUA
  1. . ;
  1. . ; Mark result as sent - set to 1, if corrected results set to 2
  1. . I LA("SUB")="CH" D
  1. . . I $P(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^")),"^",10)>1 Q
  1. . . S $P(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^")),"^",10)=$S($P(LA7VT,"^",2)="C":2,1:1)
  1. ;
  1. Q
  1. ;
  1. ;
  1. NTE ; Build NTE segment
  1. ;
  1. ;ZEXCEPT: LA,LA7INTYP,LA7NVAF
  1. ;
  1. N LA7CMTYP,LA7FMT,LA7J,LA7NTE,LA7SOC,LA7TXT,LA7TYP,LA7X,LA7Y,X
  1. ;
  1. ; Source of comment - handle other system's special codes, i.e. DOD-CHCS
  1. S LA7SOC=$S($G(LA7NVAF)=1:"AC",1:"L")
  1. ;
  1. S LA7FMT=0
  1. ; If HDR interface then send as repetition text.
  1. I $G(LA7INTYP)=30 S LA7FMT=2
  1. ;
  1. ; Send "MI" specimen's comments
  1. I LA("SUB")="MI" D
  1. . K LA7NTE
  1. . S LA7X=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),99)),LA7CMTYP="VA-LRMI001",LA7J=1
  1. . I LA7X="" Q
  1. . I LA7FMT S LA7Y(LA7CMTYP,LA7J)=LA7X
  1. . E S LA7TXT=LA7X D NTE^LA7VORU1
  1. ;
  1. ; Send "CH" specimen's comments
  1. I LA("SUB")="CH" D
  1. . S LA7J=0
  1. . F S LA7J=$O(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),1,LA7J)) Q:'LA7J D
  1. . . K LA7NTE
  1. . . S LA7X=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),1,LA7J,0)),LA7CMTYP="VA-LR002"
  1. . . I $E(LA7X,1)="~" S LA7CMTYP="VA-LR001"
  1. . . I LA7X="" S LA7X=" "
  1. . . I LA7FMT S LA7Y(LA7CMTYP,LA7J)=LA7X
  1. . . E S LA7TXT=LA7X D NTE^LA7VORU1
  1. ;
  1. ; If formatted or repetition format then build each type of comments to an NTE segment.
  1. I LA7FMT D
  1. . S LA7CMTYP=""
  1. . F S LA7CMTYP=$O(LA7Y(LA7CMTYP)) Q:LA7CMTYP="" D
  1. . . K LA7TXT
  1. . . M LA7TXT=LA7Y(LA7CMTYP)
  1. . . D NTE^LA7VORU1
  1. ;
  1. Q
  1. ;
  1. ;
  1. PLC ; Reporting lab comment
  1. ;
  1. ;ZEXCEPT: LA,LA7VT
  1. ;
  1. N LA74,LA7DIV,LA7NTE,LA7RNLT,LA7SOC,LA7TSTN,LA7X,X
  1. S (LA74,LA7DIV,LA7RNLT,LA7TSTN)=""
  1. ;
  1. ; Find reporting facility (division).
  1. I LA("SUB")="CH" D
  1. . S LA7X=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^")))
  1. . S LA74=$P(LA7X,"^",9)
  1. . ; If verifying institution not stored with result, use releasing inst. or inst. of user - ccr_6164n
  1. . I LA74="" S LA74=$P($G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),"RF")),"^")
  1. . I LA74="",$$DIV4^XUSER(.LA74,$P(LA7X,"^",4)) S LA74=$O(LA74(0))
  1. . ;
  1. . ; if NLT code of reported test is not stored with result, use default code - ccr_6164n
  1. . I $P($P(LA7X,"^",3),"!",2)="" D
  1. . . S $P(LA7X,"^",3)=$$DEFCODE^LA7VHLU5(LA("SUB"),$P(LA7VT,"^"),$P(LA7X,"^",3),$P($G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0)),"^",5))
  1. . ;
  1. . S LA7RNLT=$P($P(LA7X,"^",3),"!",2)
  1. ;
  1. I LA("SUB")="MI" D
  1. . S LA74=$P($G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),"RF")),"^") Q:LA74
  1. . S LA7X=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0))
  1. . S LA74=$P(LA7X,"^",15)
  1. ;
  1. I "SPCYEM"[LA("SUB") S LA74=$P($G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),"RF")),"^")
  1. ;
  1. D BPLC
  1. Q
  1. ;
  1. ;
  1. BPLC ; Build NTE segment with performing lab disclosure statement
  1. ;
  1. ;ZEXCEPT: LA,LA74,LA7DIV,LA7NLT,LA7NVAF,LA7RNLT,LA7SOC,LA7TSTN,LA7TXT
  1. ;
  1. N LA7CMTYP,LA7FMT,LA7TXT,LA7X,X
  1. ;
  1. S LA7CMTYP="",LA7FMT=0
  1. ;
  1. ; Source of comment - handle other system's special codes, i.e. DOD-CHCS
  1. S LA7SOC=$S($G(LA7NVAF)=1:"DS",1:"L")
  1. ;
  1. I LA74="" S LA74=+$$KSP^XUPARAM("INST")
  1. I LA74 S LA7DIV=$$NAME^XUAF4(LA74)
  1. ;
  1. ; Build result test name
  1. I LA7RNLT="" D
  1. . I $G(LA("NLT"))'="" S LA7RNLT=LA("NLT") Q
  1. . S LA7RNLT=$G(LA7NLT)
  1. I LA7RNLT D
  1. . S LA7X=$O(^LAM("E",LA7RNLT,0))
  1. . I LA7X S LA7TSTN=$$GET1^DIQ(64,LA7X_",",.01,"I")
  1. ;
  1. S LA7TXT=LA7TSTN_" results from "_LA7DIV_"."
  1. D NTE^LA7VORU1
  1. S X=$$PADD^XUAF4(LA74)
  1. S LA7TXT=$P(X,U)_" "_$P(X,U,2)_", "_$P(X,U,3)_" "_$P(X,U,4)
  1. S X=$$ID^XUAF4("CLIA",LA74)
  1. I X'="" S LA7TXT=LA7TXT_" (CLIA# "_X_")"
  1. D NTE^LA7VORU1
  1. Q
  1. ;
  1. ;
  1. INTRP ; Send test interpretation
  1. ; Send "CH" subscript file #60 site/specimen's interpretation field (#5.5)
  1. ;
  1. ;ZEXCEPT: LA,LA763,LA7INTYP,LA7NVAF,LA7V,LA7VT
  1. ;
  1. N LA760,LA761,LA7CMTYP,LA7FMT,LA7J,LA7NTE,LA7SOC,LA7TXT,LA7X,LA7Y,LRSB
  1. ;
  1. S LRSB=$P(LA7VT,"^"),(LA7FMT,LA7Y)=0
  1. S LA761=+$P(LA763(0),"^",5)
  1. S LA7X=^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),LRSB)
  1. S LA760=+$P($P(LA7X,"^",3),"!",7)
  1. I LA760,$D(^LAB(60,LA760,1,LA761,1)) S LA7Y=1
  1. I 'LA760 D
  1. . S LA760=0
  1. . F S LA760=$O(^LAB(60,"C","CH;"_LRSB_";1",LA760)) Q:'LA760 D Q:LA7Y
  1. . . I $D(^LAB(60,LA760,1,LA761,1)) S LA7Y=1
  1. ;
  1. I 'LA7Y Q
  1. ;
  1. ; Source of comment - handle other system's special codes, i.e. DOD-CHCS
  1. S LA7SOC=$S($G(LA7NVAF)=1:"RI",1:"L"),LA7CMTYP="VA-LR003"
  1. ;
  1. ; If HDR interface then send as repetition text.
  1. I $G(LA7INTYP)=30 S LA7FMT=2
  1. ;
  1. ; Build each line of interpretation as a NTE segment unless formatting flag (LA7FMT) indicates
  1. ; either formatted text or repetition.
  1. S LA7J=0
  1. F S LA7J=$O(^LAB(60,LA760,1,LA761,1,LA7J)) Q:'LA7J D
  1. . S LA7X=$G(^LAB(60,LA760,1,LA761,1,LA7J,0))
  1. . I LA7X="" S LA7X=" "
  1. . I LA7FMT S LA7TXT(LA7J)=LA7X
  1. . E S LA7TXT=LA7X D NTE^LA7VORU1
  1. ;
  1. I LA7FMT,$D(LA7TXT) D NTE^LA7VORU1
  1. ;
  1. Q
  1. ;
  1. ;
  1. CHECKNP(HUID,LRSB) ; Check if test was NP'ed - added with ccr_6164n
  1. ;
  1. ; Call with HUID = Host UID
  1. ; LRSB = "CH" subscript node (Data Name)
  1. ;
  1. ; Returns LA7VNP = 0 - Test was not NP'ed
  1. ; 1 - This test was NP'ed
  1. ;
  1. ;
  1. N LA760,LA7AA,LA7AD,LA7AN,LA7VNP,LA7Y
  1. ;
  1. S LA7VNP=0
  1. ;
  1. S LA7Y=$$CHECKUID^LRWU4(HUID)
  1. S LA760=+$O(^LAB(60,"C","CH;"_+LRSB_";1",0))
  1. I 'LA7Y!('LA760) Q LA7VNP
  1. ;
  1. S LA7AA=+$P(LA7Y,U,2)
  1. S LA7AD=+$P(LA7Y,U,3)
  1. S LA7AN=+$P(LA7Y,U,4)
  1. ;
  1. I $P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA760,0)),U,6)="*Not Performed" S LA7VNP=1 Q LA7VNP
  1. ;
  1. I '$D(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA760,0)),'LA7VNP D
  1. . N LA7TST
  1. . S LA7TST=0
  1. . F S LA7TST=$O(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA7TST)) Q:'LA7TST!(LA7VNP) D
  1. . . N LA7TREE
  1. . . I $P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA7TST,0)),U,6)'="*Not Performed" Q
  1. . . D UNWIND^LA7ADL1(LA7TST,9,LA7TST)
  1. . . I $D(LA7TREE(LA760)) S LA7VNP=1
  1. ;
  1. Q LA7VNP