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

LA7CORUA.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;
  1. NTE ; Build NTE segment
  1.  ;
  1.  N LA7CMTYP,LA7FMT,LA7J,LA7NTE,LA7SOC,LA7TXT,LA7TYP,LA7X,LA7Y,X
  1.  ;
  1.  ; Initialize segment set id
  1.  S LA7NTESN=0
  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="RE",LA7J=1
  1.  . I LA7X="" Q
  1.  . I LA7FMT S LA7Y(LA7CMTYP,LA7J)=LA7X
  1.  . E  S LA7TXT=LA7X D NTE^LA7CORU1
  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="RE"
  1.  . . I $E(LA7X,1)="~" S LA7CMTYP="RE"
  1.  . . I LA7X="" S LA7X=" "
  1.  . . I LA7FMT S LA7Y(LA7CMTYP,LA7J)=LA7X
  1.  . . E  S LA7TXT=LA7X D NTE^LA7CORU1
  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^LA7CORU1
  1.  Q
  1.  ;
  1.  ;
  1. PLC ; Performing lab comment
  1.  N LA74,LA7DIV,LA7CMTYP,LA7FMT,LA7NTE,LA7RNLT,LA7SOC,LA7TSTN,LA7TXT,LA7X,X
  1.  S (LA74,LA7CMTYP,LA7DIV,LA7RNLT,LA7TSTN)="",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.  ; 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.  . S LA7RNLT=$P($P(LA7X,"^",3),"!",2)
  1.  I LA74="" S LA74=+$P($G(^XMB(1,1,"XUS")),"^",17)
  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^LA7CORU1
  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.  D NTE^LA7CORU1
  1.  Q
  1.  ;
  1.  ;
  1. INTRP ; Send test interpretation
  1.  ; Send "CH" subscript file #60 site/specimen's interpretation field (#5.5)
  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="RE"
  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^LA7CORU1
  1.  ;
  1.  I LA7FMT>0,$D(LA7TXT) D NTE^LA7CORU1
  1.  ;
  1.  Q