LA7VORU2 ;DALOI/JMC - LAB ORU (Result) message builder cont'd ;06/03/13 20:11
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,68,74,80**;Sep 27, 1994;Build 19
;
AP ; Observation/Result segment for Lab AP Results
;
N LA7DATA,LA7IDT,LRSB,LRSS
;
S LRDFN=LA("LRDFN"),LRSS=LA("SUB"),(LA7IDT,LRIDT)=LA("LRIDT")
;
I $G(LA("NLT"))'="" S LA7NLT=LA("NLT")
E S (LA7NLT,LA("NLT"))=$P($$DEFCODE^LA7VHLU5(LRSS,.012,"",""),"!")
;
D OBR^LA7VORU
I LA7NVAF=1 D PLC^LA7VORUA
D NTE^LA7VORU
D PMR
;
I $D(^LR(LRDFN,LRSS,LRIDT,1.2)) D PSR
Q
;
;
APORM ; Entry point when building OBX segments for ORM message
;
D PMR
;
; Process supplementary reports
N LA7SR,LA7SS
S LA7OBXSN=0,LRSB=1.2,LA7SR=0
F S LA7SR=$O(^LR(LRDFN,LRSS,LRIDT,1.2,LA7SR)) Q:'LA7SR D
. N LA7IDT
. ; If don't release this report then skip.
. I $P($G(^LR(LRDFN,LRSS,LRIDT,1.2,LA7SR,0)),"^",2)'=1 Q
. S LA7IDT=LRIDT_","_LA7SR D OBX^LA7VORU1
;
Q
;
;
PMR ; Process main report
N LA7ORG,LA7SS
S LA7OBXSN=0
;
D SPEC
I LA7NVAF'=1 F LRSB=.013,.014,.015,.016,1,1.1,1.3,1.4 D OBX^LA7VORU1
I LA7NVAF=1 D DOD
;
; Process organ/tissue subfile
S LA7ORG=0
F S LA7ORG=$O(^LR(LRDFN,LRSS,LRIDT,2,LA7ORG)) Q:'LA7ORG D
. N LA7IDT
. S LRSB=10,LA7IDT=LRIDT_","_LA7ORG D OBX^LA7VORU1
. I LRSS="SP" S LRSB="10,2",LA7IDT=LRIDT_","_LA7ORG D OBX^LA7VORU1
. ; Special studies
. S LA7SS=0,LRSB="10,5"
. F S LA7SS=$O(^LR(LRDFN,LRSS,LRIDT,2,LA7ORG,5,LA7SS)) Q:'LA7SS D
. . S LA7IDT=LRIDT_","_LA7ORG_","_LA7SS D OBX^LA7VORU1
;
Q
;
;
PSR ; Process supplementary reports
N LA7SR,LA7SS
I $G(LA("NLT"))'="" S LA7NLT=LA("NLT")
E S (LA7NLT,LA("NLT"))=$P($$DEFCODE^LA7VHLU5(LRSS,1.2,"",""),"!")
S LA7OBXSN=0,LRSB=1.2,LA7SR=0
F S LA7SR=$O(^LR(LRDFN,LRSS,LRIDT,1.2,LA7SR)) Q:'LA7SR D
. N LA7IDT
. ; If don't release this report then skip.
. I $P($G(^LR(LRDFN,LRSS,LRIDT,1.2,LA7SR,0)),"^",2)'=1 Q
. D OBR^LA7VORU
. I LA7NVAF=1 D PLC^LA7VORUA,DODSR Q
. S LA7IDT=LRIDT_","_LA7SR D OBX^LA7VORU1
Q
;
;
SPEC ; Send specimen multiple as series of OBX segments. One OBX segment for each specimen
; If DoD then send two OBX for each specimen, 1st with free text specimen description, 2nd with SNOMED CT,
;
N LA7DA,LA7IDT,LRSB
;
S LA7DA=0,LRSB=.012
F S LA7DA=$O(^LR(LRDFN,LRSS,LRIDT,.1,LA7DA)) Q:'LA7DA D
. S LA7IDT=LRIDT_","_LA7DA S:LA7NVAF=1 LRSB=".012,.01" D OBX^LA7VORU1
. I LA7NVAF=1 S LRSB=".012,.06" D OBX^LA7VORU1
Q
;
;
DOD ; Build OBX segment's to special DoD specifications.
; Send word-processing fields as series of ST data type OBX's for DoD.
; DoD cannot handle formatted text (FT) data type.
N LA7DA
;
F LRSB=.013,.014,.015,.016,1,1.1,1.3,1.4 D
. N LA7IDT,LA7SB
. S LA7DA=0,LA7SB=$S(LRSB=.013:.2,LRSB=.014:.3,LRSB=.015:.4,LRSB=.016:.5,1:LRSB)
. F S LA7DA=$O(^LR(LRDFN,LRSS,LRIDT,LA7SB,LA7DA)) Q:'LA7DA D
. . S LA7IDT=LRIDT_","_LA7DA D OBX^LA7VORU1
;
Q
;
;
DODSR ; Build OBX segment's to special DoD specifications.
; Send Supplementary reports fields as series of ST data type OBX's for DoD.
; DoD cannot handle formatted text (FT) data type.
;
N LA7IDT,LA7DA
S LA7DA=0
F S LA7DA=$O(^LR(LRDFN,LRSS,LRIDT,1.2,LA7SR,1,LA7DA)) Q:'LA7DA D
. S LA7IDT=LRIDT_","_LA7SR_","_LA7DA D OBX^LA7VORU1
;
Q
;
;
RPTNTE ; Send report comments
; Called from LA7VORU1 to send MI NTE segments
;
N LA7CMTYP,LA7FMT,LA7J,LA7ND,LA7SOC,LA7TXT,LA7X
;
; Source of comment - handle special codes for other systems, ie DOD-CHCS
S LA7SOC=$S($G(LA7NVAF)=1:"RC",1:"L"),LA7ND=0
;
S LA7FMT=0,LA7CMTYP=""
; If HDR interface then send as repetition text.
I $G(LA7INTYP)=30 S LA7FMT=2
;
D
. ; Bacterial preliminary/report/tests remark
. I LRSB=11 S LA7ND=4,LA7CMTYP="VA-LRMI010" Q
. I LRSB=1 S LA7ND=19,LA7CMTYP="VA-LRMI011" Q
. I LRSB=1.5 S LA7ND=26,LA7CMTYP="VA-LRMI012" Q
. I LRSB=11.7 S LA7ND=25,LA7CMTYP="VA-LRMI013" Q
. ; Parasite preliminary/report/tests remark
. I LRSB=14 S LA7ND=7,LA7CMTYP="VA-LRMI020" Q
. I LRSB=16.5 S LA7ND=21,LA7CMTYP="VA-LRMI021" Q
. I LRSB=16.4 S LA7ND=27,LA7CMTYP="VA-LRMI022" Q
. I LRSB=15.51 S LA7ND=24,LA7CMTYP="VA-LRMI023" Q
. I LRSB="16,1" S LA7ND=6,LA7CMTYP="VA-LRMI53" Q
. ; Fungal preliminary/report/tests remark
. I LRSB=18 S LA7ND=10,LA7CMTYP="VA-LRMI030" Q
. I LRSB=20.5 S LA7ND=22,LA7CMTYP="VA-LRMI031" Q
. I LRSB=20.4 S LA7ND=28,LA7CMTYP="VA-LRMI032" Q
. I LRSB=19.6 S LA7ND=15,LA7CMTYP="VA-LRMI033" Q
. ; Mycobacteria preliminary/report/tests remark
. I LRSB=22 S LA7ND=13,LA7CMTYP="VA-LRMI040" Q
. I LRSB=26.5 S LA7ND=23,LA7CMTYP="VA-LRMI041" Q
. I LRSB=26.4 S LA7ND=29,LA7CMTYP="VA-LRMI042" Q
. ; Viral preliminary/report/tests remark
. I LRSB=33 S LA7ND=18,LA7CMTYP="VA-LRMI050" Q
. I LRSB=36.5 S LA7ND=20,LA7CMTYP="VA-LRMI051" Q
. I LRSB=36.4 S LA7ND=30,LA7CMTYP="VA-LRMI052" Q
;
I LA7ND'>0 Q
;
S LA7J=0
F S LA7J=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7J)) Q:'LA7J D
. S LA7X=$G(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7J,0))
. I LA7FMT S LA7TXT(LA7J)=LA7X
. E S LA7TXT=LA7X D NTE^LA7VORU1
;
; If formatted or repetition format then build comments to a NTE segment.
I LA7FMT,$D(LA7TXT) D NTE^LA7VORU1
;
Q
;
;
RPT ; Report specimen results as OBX segments to DoD - taken from various XXX RPT REMARK fields (13, 17, 21, 27, 37)
; Called from LA7VORU1.
N LA7DA,LA7IDT,LA7ND
;
S LA7ND=$S(LRSB=11:4,LRSB=14:7,LRSB=18:10,LRSB=22:13,LRSB=33:18,1:0)
I 'LA7ND Q
S LA7DA=0
F S LA7DA=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7DA)) Q:'LA7DA S LA7IDT=LRIDT_","_LA7DA D OBX^LA7VORU1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7VORU2 5619 printed Oct 16, 2024@17:41:55 Page 2
LA7VORU2 ;DALOI/JMC - LAB ORU (Result) message builder cont'd ;06/03/13 20:11
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,68,74,80**;Sep 27, 1994;Build 19
+2 ;
AP ; Observation/Result segment for Lab AP Results
+1 ;
+2 NEW LA7DATA,LA7IDT,LRSB,LRSS
+3 ;
+4 SET LRDFN=LA("LRDFN")
SET LRSS=LA("SUB")
SET (LA7IDT,LRIDT)=LA("LRIDT")
+5 ;
+6 IF $GET(LA("NLT"))'=""
SET LA7NLT=LA("NLT")
+7 IF '$TEST
SET (LA7NLT,LA("NLT"))=$PIECE($$DEFCODE^LA7VHLU5(LRSS,.012,"",""),"!")
+8 ;
+9 DO OBR^LA7VORU
+10 IF LA7NVAF=1
DO PLC^LA7VORUA
+11 DO NTE^LA7VORU
+12 DO PMR
+13 ;
+14 IF $DATA(^LR(LRDFN,LRSS,LRIDT,1.2))
DO PSR
+15 QUIT
+16 ;
+17 ;
APORM ; Entry point when building OBX segments for ORM message
+1 ;
+2 DO PMR
+3 ;
+4 ; Process supplementary reports
+5 NEW LA7SR,LA7SS
+6 SET LA7OBXSN=0
SET LRSB=1.2
SET LA7SR=0
+7 FOR
SET LA7SR=$ORDER(^LR(LRDFN,LRSS,LRIDT,1.2,LA7SR))
if 'LA7SR
QUIT
Begin DoDot:1
+8 NEW LA7IDT
+9 ; If don't release this report then skip.
+10 IF $PIECE($GET(^LR(LRDFN,LRSS,LRIDT,1.2,LA7SR,0)),"^",2)'=1
QUIT
+11 SET LA7IDT=LRIDT_","_LA7SR
DO OBX^LA7VORU1
End DoDot:1
+12 ;
+13 QUIT
+14 ;
+15 ;
PMR ; Process main report
+1 NEW LA7ORG,LA7SS
+2 SET LA7OBXSN=0
+3 ;
+4 DO SPEC
+5 IF LA7NVAF'=1
FOR LRSB=.013,.014,.015,.016,1,1.1,1.3,1.4
DO OBX^LA7VORU1
+6 IF LA7NVAF=1
DO DOD
+7 ;
+8 ; Process organ/tissue subfile
+9 SET LA7ORG=0
+10 FOR
SET LA7ORG=$ORDER(^LR(LRDFN,LRSS,LRIDT,2,LA7ORG))
if 'LA7ORG
QUIT
Begin DoDot:1
+11 NEW LA7IDT
+12 SET LRSB=10
SET LA7IDT=LRIDT_","_LA7ORG
DO OBX^LA7VORU1
+13 IF LRSS="SP"
SET LRSB="10,2"
SET LA7IDT=LRIDT_","_LA7ORG
DO OBX^LA7VORU1
+14 ; Special studies
+15 SET LA7SS=0
SET LRSB="10,5"
+16 FOR
SET LA7SS=$ORDER(^LR(LRDFN,LRSS,LRIDT,2,LA7ORG,5,LA7SS))
if 'LA7SS
QUIT
Begin DoDot:2
+17 SET LA7IDT=LRIDT_","_LA7ORG_","_LA7SS
DO OBX^LA7VORU1
End DoDot:2
End DoDot:1
+18 ;
+19 QUIT
+20 ;
+21 ;
PSR ; Process supplementary reports
+1 NEW LA7SR,LA7SS
+2 IF $GET(LA("NLT"))'=""
SET LA7NLT=LA("NLT")
+3 IF '$TEST
SET (LA7NLT,LA("NLT"))=$PIECE($$DEFCODE^LA7VHLU5(LRSS,1.2,"",""),"!")
+4 SET LA7OBXSN=0
SET LRSB=1.2
SET LA7SR=0
+5 FOR
SET LA7SR=$ORDER(^LR(LRDFN,LRSS,LRIDT,1.2,LA7SR))
if 'LA7SR
QUIT
Begin DoDot:1
+6 NEW LA7IDT
+7 ; If don't release this report then skip.
+8 IF $PIECE($GET(^LR(LRDFN,LRSS,LRIDT,1.2,LA7SR,0)),"^",2)'=1
QUIT
+9 DO OBR^LA7VORU
+10 IF LA7NVAF=1
DO PLC^LA7VORUA
DO DODSR
QUIT
+11 SET LA7IDT=LRIDT_","_LA7SR
DO OBX^LA7VORU1
End DoDot:1
+12 QUIT
+13 ;
+14 ;
SPEC ; Send specimen multiple as series of OBX segments. One OBX segment for each specimen
+1 ; If DoD then send two OBX for each specimen, 1st with free text specimen description, 2nd with SNOMED CT,
+2 ;
+3 NEW LA7DA,LA7IDT,LRSB
+4 ;
+5 SET LA7DA=0
SET LRSB=.012
+6 FOR
SET LA7DA=$ORDER(^LR(LRDFN,LRSS,LRIDT,.1,LA7DA))
if 'LA7DA
QUIT
Begin DoDot:1
+7 SET LA7IDT=LRIDT_","_LA7DA
if LA7NVAF=1
SET LRSB=".012,.01"
DO OBX^LA7VORU1
+8 IF LA7NVAF=1
SET LRSB=".012,.06"
DO OBX^LA7VORU1
End DoDot:1
+9 QUIT
+10 ;
+11 ;
DOD ; Build OBX segment's to special DoD specifications.
+1 ; Send word-processing fields as series of ST data type OBX's for DoD.
+2 ; DoD cannot handle formatted text (FT) data type.
+3 NEW LA7DA
+4 ;
+5 FOR LRSB=.013,.014,.015,.016,1,1.1,1.3,1.4
Begin DoDot:1
+6 NEW LA7IDT,LA7SB
+7 SET LA7DA=0
SET LA7SB=$SELECT(LRSB=.013:.2,LRSB=.014:.3,LRSB=.015:.4,LRSB=.016:.5,1:LRSB)
+8 FOR
SET LA7DA=$ORDER(^LR(LRDFN,LRSS,LRIDT,LA7SB,LA7DA))
if 'LA7DA
QUIT
Begin DoDot:2
+9 SET LA7IDT=LRIDT_","_LA7DA
DO OBX^LA7VORU1
End DoDot:2
End DoDot:1
+10 ;
+11 QUIT
+12 ;
+13 ;
DODSR ; Build OBX segment's to special DoD specifications.
+1 ; Send Supplementary reports fields as series of ST data type OBX's for DoD.
+2 ; DoD cannot handle formatted text (FT) data type.
+3 ;
+4 NEW LA7IDT,LA7DA
+5 SET LA7DA=0
+6 FOR
SET LA7DA=$ORDER(^LR(LRDFN,LRSS,LRIDT,1.2,LA7SR,1,LA7DA))
if 'LA7DA
QUIT
Begin DoDot:1
+7 SET LA7IDT=LRIDT_","_LA7SR_","_LA7DA
DO OBX^LA7VORU1
End DoDot:1
+8 ;
+9 QUIT
+10 ;
+11 ;
RPTNTE ; Send report comments
+1 ; Called from LA7VORU1 to send MI NTE segments
+2 ;
+3 NEW LA7CMTYP,LA7FMT,LA7J,LA7ND,LA7SOC,LA7TXT,LA7X
+4 ;
+5 ; Source of comment - handle special codes for other systems, ie DOD-CHCS
+6 SET LA7SOC=$SELECT($GET(LA7NVAF)=1:"RC",1:"L")
SET LA7ND=0
+7 ;
+8 SET LA7FMT=0
SET LA7CMTYP=""
+9 ; If HDR interface then send as repetition text.
+10 IF $GET(LA7INTYP)=30
SET LA7FMT=2
+11 ;
+12 Begin DoDot:1
+13 ; Bacterial preliminary/report/tests remark
+14 IF LRSB=11
SET LA7ND=4
SET LA7CMTYP="VA-LRMI010"
QUIT
+15 IF LRSB=1
SET LA7ND=19
SET LA7CMTYP="VA-LRMI011"
QUIT
+16 IF LRSB=1.5
SET LA7ND=26
SET LA7CMTYP="VA-LRMI012"
QUIT
+17 IF LRSB=11.7
SET LA7ND=25
SET LA7CMTYP="VA-LRMI013"
QUIT
+18 ; Parasite preliminary/report/tests remark
+19 IF LRSB=14
SET LA7ND=7
SET LA7CMTYP="VA-LRMI020"
QUIT
+20 IF LRSB=16.5
SET LA7ND=21
SET LA7CMTYP="VA-LRMI021"
QUIT
+21 IF LRSB=16.4
SET LA7ND=27
SET LA7CMTYP="VA-LRMI022"
QUIT
+22 IF LRSB=15.51
SET LA7ND=24
SET LA7CMTYP="VA-LRMI023"
QUIT
+23 IF LRSB="16,1"
SET LA7ND=6
SET LA7CMTYP="VA-LRMI53"
QUIT
+24 ; Fungal preliminary/report/tests remark
+25 IF LRSB=18
SET LA7ND=10
SET LA7CMTYP="VA-LRMI030"
QUIT
+26 IF LRSB=20.5
SET LA7ND=22
SET LA7CMTYP="VA-LRMI031"
QUIT
+27 IF LRSB=20.4
SET LA7ND=28
SET LA7CMTYP="VA-LRMI032"
QUIT
+28 IF LRSB=19.6
SET LA7ND=15
SET LA7CMTYP="VA-LRMI033"
QUIT
+29 ; Mycobacteria preliminary/report/tests remark
+30 IF LRSB=22
SET LA7ND=13
SET LA7CMTYP="VA-LRMI040"
QUIT
+31 IF LRSB=26.5
SET LA7ND=23
SET LA7CMTYP="VA-LRMI041"
QUIT
+32 IF LRSB=26.4
SET LA7ND=29
SET LA7CMTYP="VA-LRMI042"
QUIT
+33 ; Viral preliminary/report/tests remark
+34 IF LRSB=33
SET LA7ND=18
SET LA7CMTYP="VA-LRMI050"
QUIT
+35 IF LRSB=36.5
SET LA7ND=20
SET LA7CMTYP="VA-LRMI051"
QUIT
+36 IF LRSB=36.4
SET LA7ND=30
SET LA7CMTYP="VA-LRMI052"
QUIT
End DoDot:1
+37 ;
+38 IF LA7ND'>0
QUIT
+39 ;
+40 SET LA7J=0
+41 FOR
SET LA7J=$ORDER(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7J))
if 'LA7J
QUIT
Begin DoDot:1
+42 SET LA7X=$GET(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7J,0))
+43 IF LA7FMT
SET LA7TXT(LA7J)=LA7X
+44 IF '$TEST
SET LA7TXT=LA7X
DO NTE^LA7VORU1
End DoDot:1
+45 ;
+46 ; If formatted or repetition format then build comments to a NTE segment.
+47 IF LA7FMT
IF $DATA(LA7TXT)
DO NTE^LA7VORU1
+48 ;
+49 QUIT
+50 ;
+51 ;
RPT ; Report specimen results as OBX segments to DoD - taken from various XXX RPT REMARK fields (13, 17, 21, 27, 37)
+1 ; Called from LA7VORU1.
+2 NEW LA7DA,LA7IDT,LA7ND
+3 ;
+4 SET LA7ND=$SELECT(LRSB=11:4,LRSB=14:7,LRSB=18:10,LRSB=22:13,LRSB=33:18,1:0)
+5 IF 'LA7ND
QUIT
+6 SET LA7DA=0
+7 FOR
SET LA7DA=$ORDER(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7DA))
if 'LA7DA
QUIT
SET LA7IDT=LRIDT_","_LA7DA
DO OBX^LA7VORU1
+8 QUIT
