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

LA7COBX3.m

Go to the documentation of this file. 
  1. LA7COBX3 ;VA/DALOI/JMC - LAB OBX Segment message builder (MI subscripts) cont'd ; 22-Oct-2013 09:22 ; MAW
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,1018,64,1027,68,1033**;NOV 01, 1997
  1.  ;
  1.  ; Reference to ^DD supported by DBIA #999
  1.  ;
  1. MI ; Build OBX segments for results that are microbiology subscript.
  1.  ; Called by LA7VOBX
  1.  ;
  1.  N I,LA761,LA76305,LA7ALT,LA7ALTCS,LA7CODE,LA7DIV,LA7IENS,LA7LOINC,LA7NLT,LA7OBX,LA7ORS,LA7PARNT,LA7SAVID,LA7SUBFL,LA7VAL,LA7VERP
  1.  ;
  1.  I $P(LRIDT,",",2) S LRIDT(2)=$P(LRIDT,",",2),LRIDT(3)=$P(LRIDT,",",3),LRIDT=$P(LRIDT,",")
  1.  ;
  1.  I '$D(^LR(LRDFN,LRSS,LRIDT)) Q
  1.  ;
  1.  F I=0,1,5,8,11,16 S LA76305(I)=$G(^LR(LRDFN,LRSS,LRIDT,I))
  1.  ;
  1.  S (LA7ALT,LA7ALTCS,LA7CODE,LA7ID,LA7LOINC,LA7NLT,LA7ORS,LA7SAVID,LA7SUBFL,LA7VAL,LA7VERP)=""
  1.  ;
  1.  ; Specimen topography
  1.  S LA761=$P(LA76305(0),"^",5)
  1.  ; Default codes
  1.  S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,LA7CODE,LA761)
  1.  ;
  1.  D SEC,GEN
  1.  ;S LRSPEC=$P($G(LA76305(0)),U,11)   ;MU2 get the microsusept specimen for SPM from collection sample field
  1.  Q
  1.  ;
  1. SEC ; Build section specific fields
  1.  N LA7X,LA7Y
  1.  ;
  1.  ; Urine screen
  1.  I LRSB=11.57 D  Q
  1.  . N LA7ERR
  1.  . S LA7VERP=$P(LA76305(1),"^",3),LA7ORS=$P(LA76305(1),"^",2)
  1.  . S LA7OBX(2)=$$OBX2^LA7COBX(63.05,11.57)
  1.  . S LA7IENS=LRIDT_","_LRDFN_","
  1.  . S LA7VAL=$$GET1^DIQ(63.05,LA7IENS,11.57,"","LA7ERR")
  1.  . S LA7Y="MI-"_LRSB_"^"_$$GET1^DID(63.05,11.57,"","LABEL")_"^99VA63"
  1.  . S LA7ALT=LA7Y_"^"_LA7Y
  1.  ;
  1.  ; Sputum Screen
  1.  I LRSB=11.58 D  Q
  1.  . N LA7ERR
  1.  . S LA7VERP=$P(LA76305(1),"^",3)
  1.  . S LA7ORS=$P(LA76305(1),"^",2)
  1.  . S LA7OBX(2)=$$OBX2^LA7COBX(63.05,11.58)
  1.  . S LA7VAL=$P(^LR(LRDFN,LRSS,LRIDT,1),"^",5)
  1.  . S LA7Y="MI-"_LRSB_"^"_$$GET1^DID(63.05,11.58,"","LABEL")_"^99VA63"
  1.  . S LA7ALT=LA7Y_"^"_LA7Y
  1.  ;
  1.  ; Gram stain
  1.  I LRSB=11.6 D  Q
  1.  . N LA7ERR
  1.  . S LA7VERP=$P(LA76305(1),"^",3)
  1.  . S LA7ORS=$P(LA76305(1),"^",2)
  1.  . S LA7OBX(2)=$$OBX2^LA7COBX(63.05,11.6)
  1.  . S LA7IENS=LRIDT(2)_","_LRIDT_","_LRDFN_","
  1.  . S LA7VAL=$$GET1^DIQ(63.29,LA7IENS,.01,"","LA7ERR")
  1.  . S LA7Y="MI-"_LRSB_"^"_$$GET1^DID(63.29,.01,"","LABEL")_"^99VA63"
  1.  . S LA7ALT=LA7Y_"^"_LA7Y
  1.  . ; Setup DoD special coding system
  1.  . I LA7NVAF=1,$P(LA7CODE,"!",2) S LA7ALTCS="99VA64MG"
  1.  ;
  1.  ; Micro organism
  1.  I $P(LRSB,",")=12 D  Q
  1.  . S LA7VERP=$P(LA76305(1),"^",3)
  1.  . S LA7ORS=$P(LA76305(1),"^",2)
  1.  . S LA7SUBFL=63.3
  1.  . ; Working on colony count
  1.  . I $P(LRSB,",",2)=1 D CC Q
  1.  . ; Working on organism
  1.  . I $G(LRIDT(3))="" D ORG Q
  1.  . ; Working on susceptibilities
  1.  . I $P(LA76305(1),"^",4) S LA7VERP=$P(LA76305(1),"^",4)
  1.  . I $P(LRSB,",",2)<3 D MIC Q
  1.  . I $P(LRSB,",",2)=3 D MICA Q
  1.  ; 
  1.  ; Parasite organism
  1.  I $P(LRSB,",")=16 D  Q
  1.  . S LA7ORS=$P(LA76305(5),"^",2)
  1.  . S LA7VERP=$P(LA76305(5),"^",3)
  1.  . ; Working on organism
  1.  . S LA7SUBFL=63.34 D ORG
  1.  ;
  1.  ; Mycology organism
  1.  I $P(LRSB,",")=20 D  Q
  1.  . S LA7ORS=$P(LA76305(8),"^",2)
  1.  . S LA7VERP=$P(LA76305(8),"^",3)
  1.  . S LA7SUBFL=63.37
  1.  . ; Working on colony count
  1.  . I $P(LRSB,",",2)=1 D CC Q
  1.  . ; Working on organism
  1.  . D ORG
  1.  ;
  1.  ; Acid Fast stain
  1.  I LRSB=24 D  Q
  1.  . N LA7ERR
  1.  . S LA7VERP=$P(LA76305(11),"^",3)
  1.  . S LA7ORS=$P(LA76305(11),"^",2)
  1.  . S LA7OBX(2)=$$OBX2^LA7COBX(63.05,24)
  1.  . S LA7IENS=LRIDT_","_LRDFN_","
  1.  . S LA7VAL=$$GET1^DIQ(63.05,LA7IENS,24,"","LA7ERR")
  1.  . S LA7Y="MI-"_LRSB_"^"_$$GET1^DID(63.05,24,"","LABEL")_"^99VA63"
  1.  . S LA7ALT=LA7Y_"^"_LA7Y
  1.  ;
  1.  ; Acid Fast stain quantity
  1.  I LRSB=25 D  Q
  1.  . N LA7ERR
  1.  . S LA7VERP=$P(LA76305(11),"^",3)
  1.  . S LA7ORS=$P(LA76305(11),"^",2)
  1.  . S LA7OBX(2)=$$OBX2^LA7COBX(63.05,25)
  1.  . S LA7IENS=LRIDT_","_LRDFN_","
  1.  . S LA7VAL=$$GET1^DIQ(63.05,LA7IENS,25,"","LA7ERR")
  1.  . S LA7Y="MI-"_LRSB_"^"_$$GET1^DID(63.05,25,"","LABEL")_"^99VA63"
  1.  . S LA7ALT=LA7Y_"^"_LA7Y
  1.  ;
  1.  ; TB organism
  1.  I $P(LRSB,",")=26 D  Q
  1.  . S LA7ORS=$P(LA76305(11),"^",2)
  1.  . S LA7VERP=$P(LA76305(11),"^",5)
  1.  . S LA7SUBFL=63.39
  1.  . ; Working on colony count
  1.  . I $P(LRSB,",",2)=1 D CC Q
  1.  . ; Working on organism
  1.  . I $G(LRIDT(3))="" D ORG Q
  1.  . ; Working on susceptibilities
  1.  . D MIC
  1.  ;
  1.  ; Virology virus
  1.  I $P(LRSB,",")=36 D  Q
  1.  . S LA7ORS=$P(LA76305(16),"^",2)
  1.  . S LA7VERP=$P(LA76305(16),"^",3)
  1.  . ; Working on virus
  1.  . S LA7SUBFL=63.43
  1.  . D ORG
  1.  ;
  1.  ; Antibiotic levels
  1.  I $P(LRSB,",")=28 D  Q
  1.  . S LA7VERP=$P(LA76305(1),"^",3)
  1.  . S LA7ORS=$P(LA76305(1),"^",2)
  1.  . S LA7SUBFL=63.42
  1.  . S LA7OBX(2)="SN"
  1.  . S LA7X=$G(^LR(LRDFN,LRSS,LRIDT,14,LRIDT(2),0))
  1.  . S $P(LA7CODE,"!",2)="93978.0000"
  1.  . S $P(LA7CODE,"!",3)=$S($P(LA7X,"^",2)="P":44433,$P(LA7X,"^",2)="T":44434,1:23816)
  1.  . S LA7VAL=$P(LA7X,"^",3)
  1.  . S LA7Y="MI-"_$P(LRSB,",")_"-"_$P(LRSB,",",2)_"^"_$P(LA7X,"^")_"^99VA63"
  1.  . S LA7ALT=LA7Y_"^"_LA7Y
  1.  ;
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. CC ; Organism's Colony count
  1.  ; If "CFU/ml" found then move units to OBX-6 (Units).
  1.  N LA7X
  1.  ;
  1.  S LA7ID=$P(LRSB,",")_"-"_LRIDT(2)
  1.  S LA7IENS=LRIDT(2)_","_LRIDT_","_LRDFN_","
  1.  S LA7OBX(2)=$$OBX2^LA7COBX(LA7SUBFL,1)
  1.  S LA7VAL=$$GET1^DIQ(LA7SUBFL,LA7IENS,1)
  1.  S LA7X=$$UP^XLFSTR(LA7VAL)
  1.  I LA7X["CFU/ML" D
  1.  . S LA7OBX(6)=$$OBX6^LA7COBX("CFU/ml","",LA7FS,LA7ECH,$G(LA7INTYP))
  1.  . S LA7X("CFU/ml")="",LA7X("CFU/ML")=""
  1.  . S LA7VAL=$$REPLACE^XLFSTR(LA7VAL,.LA7X)
  1.  ;
  1.  S LA7Y="MI-"_$P(LRSB,",")_"-1^"_$$GET1^DID(LA7SUBFL,1,"","LABEL")_"^99VA63"
  1.  S LA7ALT=LA7Y_"^"_LA7Y
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. ORG ; Organism
  1.  ;
  1.  N LA7X,LA7Y,X
  1.  ;
  1.  S LA7ID=LRSB_"-"_LRIDT(2)
  1.  S LA7OBX(2)=$$OBX2^LA7COBX(LA7SUBFL,.01)
  1.  S LA7IENS=LRIDT(2)_","_LRIDT_","_LRDFN_","
  1.  S LA7VAL=""
  1.  S LA7X=$$GET1^DIQ(LA7SUBFL,LA7IENS,.01,"I"),LA7X(.01)=$$GET1^DIQ(LA7SUBFL,LA7IENS,.01)
  1.  ;
  1.  S LA7NORG=$$FNDORG(LRDFN,LRIDT,LA7ND,LA7ORG)  ;MU2
  1.  ; Check for SNOMED coding/local coding as alternate
  1.  S X=$$GET1^DIQ(LA7SUBFL,LA7IENS,".01:2")
  1.  ;I X'="" D
  1.  ;. S LA7VAL="E-"_X_"^"_LA7X(.01)_"^SNM",$P(LA7VAL,"^",4,6)=LA7X_"^"_LA7X(.01)_"^99VA61.2"
  1.  ;. I $G(LA7NVAF)'=1 S LA7OBX(2)="CWE",$P(LA7VAL,"^",7,8)="1974^5.2",$P(LA7VAL,"^",9)=LA7X(.01)
  1.  I X'="" D  ;mu2
  1.  . S LA7VAL=X_"^"_LA7X(.01)_"^SCT",$P(LA7VAL,"^",4,6)=$E(LA7X(.01),1,3)_"^"_LA7X(.01)_"^L"
  1.  . I $G(LA7NVAF)'=1 S LA7OBX(2)="CWE",$P(LA7VAL,"^",7,8)="1974^5.2",$P(LA7VAL,"^",9)=LA7X(.01)
  1.  ;
  1.  ; If no SNOMED then use local coding as primary
  1.  I LA7VAL="" D
  1.  . S LA7VAL=LA7X_"^"_LA7X(.01)_"^L"
  1.  . I $G(LA7NVAF)'=1 S LA7OBX(2)="CWE",$P(LA7VAL,"^",7)="5.2",$P(LA7VAL,"^",9)=LA7X(.01)
  1.  ;
  1.  S LA7Y="MI-"_$P(LRSB,",")_"-.01^"_$$GET1^DID(LA7SUBFL,.01,"","LABEL")_"^L"
  1.  S LA7ALT=LA7Y_"^"_LA7Y
  1.  ;
  1.  ;TODO mu2 may need this back in a different way
  1.  ;S LA7OBX(8)=$$OBX8^LA7COBX("A")
  1.  ;
  1.  ; Set flag to save sub-id for parent-child relationship
  1.  S LA7SAVID=1
  1.  Q
  1.  ;
  1.  ;
  1. MIC ; Organism's susceptibilities
  1.  ;
  1.  N LA7IENS,LA7SUB
  1.  ;
  1.  ; Bact or TB organism
  1.  S LA7SUB=$S($P(LRSB,",")=12:3,1:12)
  1.  ;
  1.  S LA7OBX(2)=$$OBX2^LA7COBX(62.06,.01)
  1.  ;
  1.  ; Determine local code for antibiotic if not mapped to NLT or in file #62.06
  1.  ;  - Use file #62.06 entry if available otherwise generate from drug node field in file #63
  1.  ;    also used to convey local display name in 9th component
  1.  S LA7X=""
  1.  I $P(LRSB,",")=12 D
  1.  . S LA7X=$O(^LAB(62.06,"AD",$P(LRSB,",",2),0))
  1.  . I LA7X S LA7ALT=LA7X_"^"_$$GET1^DIQ(62.06,LA7X_",",.01)_"^L",LA7ALT=LA7ALT_"^"_LA7ALT
  1.  I LA7ALT="" D
  1.  . S LA7X=$P(LRSB,",",2),LA7Y=$O(^DD(LA7SUBFL,"GL",LA7X,1,0))
  1.  . I LA7Y<1 Q
  1.  . S LA7ALT="MIAB"_$P(LRSB,",")_"-"_$P(LRSB,",",2)_"^"_$$GET1^DID(LA7SUBFL,LA7Y,"","LABEL")_"^L"
  1.  . S LA7ALT=LA7ALT_"^"_LA7ALT
  1.  ;
  1.  S LA7X=$G(^LR(LRDFN,"MI",LRIDT,LA7SUB,LRIDT(2),LRIDT(3)))
  1.  S LA7VAL=$P(LA7X,"^")
  1.  I LA7VAL'="" D
  1.  . I "SIR"[$E(LA7VAL) S LA7OBX(8)=$$OBX8^LA7COBX($E(LA7VAL)) Q
  1.  . I "SIR"[$E($P(LA7X,"^",2)) D  Q
  1.  .. S LA7OBX(8)=$$LOOKTAB^LA7CQRY1("HL7","0078",$E($P(LA7X,"^",2)),$E(LA7ECH))
  1.  .. S $P(LA7OBX(8),$E(LA7ECH),7)="2.7"
  1.  .. ;S LA7OBX(8)=$$OBX8^LA7COBX($E($P(LA7X,"^",2)))
  1.  ;
  1.  ; Determine access screen for this susceptibility
  1.  I $P(LA7X,"^",3)="" S $P(LA7X,"^",3)="A"
  1.  I $G(LA7INPT),$G(LRSS)="MI",$G(LA7OBRSN)>1 S LA7VAL="S"  ;mu2 inpatient mu2 micro
  1.  S LA7OBX(13)=$$OBX13^LA7COBX($P(LA7X,"^",3),$S($G(LA7INTYP)=30:"MIS-HDR",1:"MIS"),LA7FS,LA7ECH)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. MICA ;  Bacteria organism's susceptibilities - free text
  1.  ;
  1.  N LA7SUB,LA7X
  1.  S LA7OBX(2)="NM"
  1.  ;
  1.  ; Bact organism
  1.  S LA7SUB=3
  1.  ;
  1.  ; Determine local code for free text antibiotic also used to convey local display name in 9th component
  1.  S LA7X=$G(^LR(LRDFN,"MI",LRIDT,LA7SUB,LRIDT(2),3,LRIDT(3),0))
  1.  S LA7ALT="MIAB"_$P(LRSB,",")_"-"_$P(LRSB,",",2)_"-"_$P(LRSB,",",3)_"^"_$P(LA7X,"^")_$S($P(LRSB,",",3)=1:" MIC",1:" MBC")_"^L"
  1.  S LA7ALT=LA7ALT_"^"_LA7ALT
  1.  S $P(LA7CODE,"!",2)="87565.0000"
  1.  S $P(LA7CODE,"!",3)=$S($P(LRSB,",",3)=1:21070,1:23658)
  1.  ;
  1.  S LA7VAL=$P(LA7X,"^",$S($P(LRSB,",",3)=1:2,1:3))
  1.  ;
  1.  S LA7OBX(6)="UG/ML"
  1.  S LA7OBX(8)=""
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. GEN ; Fields common to all MI OBX segments.
  1.  ;
  1.  ; Initialize OBX segment
  1.  S LA7OBX(0)="OBX"
  1.  S LA7OBX(1)=$$OBX1^LA7COBX(.LA7OBXSN)
  1.  ;
  1.  N LA7WKI
  1.  ;I $P(LA7CODE,"!",2)]"",$G(LA7953)="" S LA7WKI=$O(^LAM("E",$P(LA7CODE,"!",2),0))  ;will this break script #3 & #4 MU2
  1.  ;need to figure out these codes here for micro
  1.  I $P(LA7CODE,"!",2)]"" S LA7WKI=$O(^LAM("E",$P(LA7CODE,"!",2),0))  ;will this break script #9 MU2
  1.  ;the following 2 lines will look up the org if there
  1.  ;I $G(LA7NORG) S LA7WKI=$O(^LAB(61.2,LA7NORG,9,"B",0))
  1.  I $G(LA7WKI) S LA7953=$P($G(^LAM(LA7WKI,9)),U)
  1.  ;MU2 added 3 below lines for NIST 9 testing, this seems to work for both NIST 4 and NIST 9, will leave this in for now, until retesting
  1.  I $G(LA7NORG),$G(LA7OBRSN)=1 D
  1.  . S LA7WKI=$O(^LAB(61.2,LA7NORG,9,"B",0))
  1.  . S LA7953=$P($G(^LAM(LA7WKI,9)),U)
  1.  S LA7OBX(3)=$$OBX3^LA7COBX($P(LA7CODE,"!",2),$S($G(LA7953):LA7953,1:$P(LA7CODE,"!",3)),LA7ALT,LA7FS,LA7ECH,$G(LA7INTYP))
  1.  I $G(LA7INPT) S $P(LA7OBX(3),$E(LA7ECH),9)=$E($P(LA7OBX(3),$E(LA7ECH),2),1,30)  ;mu2 inpatient
  1.  K LA7NORG
  1.  ;S LA7OBX(3)=$$OBX3^LA7COBX($P(LA7CODE,"!",2),$P(LA7CODE,"!",3),LA7ALT,LA7FS,LA7ECH,$G(LA7INTYP))
  1.  ;
  1.  ; Change normal coding system for DoD special
  1.  I LA7NVAF=1,LA7ALTCS'="" D
  1.  . F I=3,6 I $P(LA7OBX(3),$E(LA7ECH,1),I)="99VA64" S $P(LA7OBX(3),$E(LA7ECH,1),I)=LA7ALTCS Q
  1.  ;
  1.  I $G(LA7INPT) S LA7OBX(4)=$P($G(LA7OBXSN),"-",2)  ;mu2 inpatient micro
  1.  I $G(LA7INPT),$G(LA7OBX(4))="" S LA7OBX(4)=1
  1.  ; Test value
  1.  K LA75UNIT
  1.  S LA7OBX(5)=$$OBX5^LA7COBX(LA7VAL,LA7OBX(2),LA7FS,LA7ECH)
  1.  I $G(LA7OBX(5))["-" S LA7OBX(5)=$P(LA7OBX(5),"-",2)
  1.  I $G(LA7OBX(2))="SN",$P(LA7OBX(5)," ",2)]"" D
  1.  . S LA75UNIT=$P(LA7OBX(5)," ",2)
  1.  . S LA7OBX(5)=$P(LA7OBX(5)," ")
  1.  ;
  1.  ;  units
  1.  I $G(LA7INPT),$G(LA75UNIT)="" S LA75UNIT="ug/mL"  ;mu2 inpatient micro
  1.  I $G(LA75UNIT)]"" D
  1.  . S $P(LA7OBX(6),$E(LA7ECH))=LA75UNIT
  1.  . S $P(LA7OBX(6),$E(LA7ECH),2)=$P($$LOOKTAB^LA7CQRY1("","UCUM",LA75UNIT,$E(LA7ECH)),$E(LA7ECH),2)
  1.  . S $P(LA7OBX(6),$E(LA7ECH),3)="UCUM"
  1.  . S $P(LA7OBX(6),$E(LA7ECH),4)=LA75UNIT
  1.  . S $P(LA7OBX(6),$E(LA7ECH),6)="L"
  1.  . S $P(LA7OBX(6),$E(LA7ECH),7)="1.8.2"
  1.  ; Set sub-id and save for constructing parents
  1.  I LA7ID'="" D
  1.  . S LA7OBX(4)=$$OBX4^LA7COBX(LA7ID,LA7FS,LA7ECH)
  1.  . I $G(LA7INPT),$G(LA7OBX(4))["-" S LA7OBX(4)=$P(LA7OBX(4),"-",2)
  1.  . I $G(LA7INPT),$G(LA7OBX(4))="" S LA7OBX(4)=1
  1.  . I LA7SAVID D
  1.  . . F I=1,2 S LA7ID(LA7ID,I)=LA7OBX(I+2)
  1.  . . I $G(HL("VER"))="2.2" S LA7ID(LA7ID,3)=LA7OBX(5) Q
  1.  . . F I=2,4 I $P(LA7OBX(5),$E(LA7ECH,1),I)'="" S LA7ID(LA7ID,3)=$P(LA7OBX(5),$E(LA7ECH,1),I) Q
  1.  ;
  1.  ; Order result status - "P"artial, "F"inal , "A"mended results
  1.  ; If no status from individual components then use status from zeroth node.
  1.  ; If no release date then pending else final
  1.  ; If amended, overrides all other status
  1.  I $G(LA7INPT) S LA7OBX(8)="A"  ;mu2 inpatient
  1.  I LA7ORS="" S LA7ORS=$S('$P(LA76305(0),"^",3):"P",1:"F")
  1.  I $P(LA76305(0),"^",9) S LA7ORS="A"
  1.  S LA7OBX(11)=$$OBX11^LA7COBX(LA7ORS)
  1.  ;
  1.  S LA7DIV=$P($G(^LR(LRDFN,LRSS,LRIDT,"RF")),"^")
  1.  I LA7DIV="",$$DIV4^XUSER(.LA7DIV,$P(LA76305(0),"^",4)) S LA7DIV=$O(LA7DIV(0))
  1.  ;
  1.  ; Observation date/time - collection date/time per HL7 standard
  1.  I $P(LA76305(0),"^") S LA7OBX(14)=$$OBX14^LA7COBX($P(LA76305(0),"^"))
  1.  ;
  1.  ; Facility that performed the testing
  1.  S LA7OBX(15)=$$OBX15^LA7COBX(LA7DIV,LA7FS,LA7ECH)
  1.  ;
  1.  ; Person that verified the test
  1.  I $P(LA76305(0),"^",4) S LA7VERP=$P(LA76305(0),"^",4)
  1.  I LA7VERP S LA7OBX(16)=$$OBX16^LA7COBX(LA7VERP,LA7DIV,LA7FS,LA7ECH)
  1.  ;
  1.  ; Date/time of the analysis
  1.  I $P(LA76305(0),"^",10)'="" S LA7OBX(19)=$$OBX19^LA7COBX($P(LA76305(0),"^",10))
  1.  I $G(LA7OBX(19))="" S LA7OBX(19)=$G(LA7OBX(14))
  1.  ;
  1.  ; Performing organization name/address
  1.  I LA7DIV="" S LA7DIV=DUZ(2)  ;MU2
  1.  I LA7DIV'="" D
  1.  . N LA7DT
  1.  . S LA7OBX(23)=$$OBX23^LA7COBX(4,LA7DIV,LA7FS,LA7ECH)
  1.  . S $P(LA7OBX(23),$E(LA7ECH,1),6)="CLIA"_$E(LA7ECH,4)_"2.16.840.1.113883.4.7"_$E(LA7ECH,4)_"ISO"
  1.  . S $P(LA7OBX(23),$E(LA7ECH,1),7)="XX"
  1.  . S $P(LA7OBX(23),$E(LA7ECH,1),10)=$P($G(^DIC(4,LA7DIV,99)),U)
  1.  . S LA7DT=$S($P(LA76305(0),"^",3):$P(LA76305(0),"^",3),1:$$NOW^XLFDT)
  1.  . S LA7OBX(24)=$$OBX24^LA7COBX(4,LA7DIV,LA7DT,LA7FS,LA7ECH)
  1.  . S $P(LA7OBX(24),$E(LA7ECH),6)="USA"
  1.  . S $P(LA7OBX(24),$E(LA7ECH),7)="L"
  1.  . S $P(LA7OBX(24),$E(LA7ECH),9)=$P(LA7OBX(24),$E(LA7ECH),5)  ;MU2 county code same as zip for now
  1.  ;
  1.  S LA7OBX(25)=$$OBX25^LA7COBX($$GET1^DIQ(9009029,DUZ(2),3027,"I"),DUZ(2),LA7FS,LA7ECH)
  1.  S $P(LA7OBX(25),$E(LA7ECH),9)="NPI"_$E(LA7ECH,4)_"2.16.840.1.113883.4.6"_$E(LA7ECH,4)_"ISO"
  1.  S $P(LA7OBX(25),$E(LA7ECH),10)="L"
  1.  S $P(LA7OBX(25),$E(LA7ECH),13)="NPI"
  1.  S $P(LA7OBX(25),$E(LA7ECH),14)="NPI_Facility"_$E(LA7ECH,4)_"2.16.840.1.113883.3.72.5.26"_$E(LA7ECH,4)_"ISO"
  1.  S $P(LA7OBX(25),$E(LA7ECH),21)=$P(LA7OBX(25),$E(LA7ECH),6)
  1.  I $G(LA7INPT) S $P(LA7OBX(25),$E(LA7ECH),7)=""  ;mu2 inpatient
  1.  ;
  1.  D BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)
  1.  ;
  1.  Q
  1.  ;
  1. FNDORG(DF,IDT,ND,ORG) ;-- return the org IEN for file 61.2
  1.  N ORGI
  1.  S ORGI=$P($G(^LR(DF,LRSS,IDT,ND,ORG,0)),U)
  1.  Q ORGI
  1.  ;