LA7VORU2 ;VA/DALOI/JMC - LAB ORU (Result) message builder cont'd ; 13-Aug-2013 09:09 ; MKK
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,1018,64,1027,68,1033**;NOV 01, 1997
;
AP ; Observation/Result segment for Lab AP Results
;
N LA7DATA,LA7IDT,LRSB,LRSS
;
S LRDFN=LA("LRDFN"),LRSS=LA("SUB"),(LA7IDT,LRIDT)=LA("LRIDT")
;
S (LA7NLT,LA("NLT"))=$P($$DEFCODE^LA7VHLU5(LRSS,.012,"",""),"!")
D OBR^LA7VORU
D NTE^LA7VORU
;
APORM ; Entry point when building OBX segments for ORM message
; Process AP subscripts
;
N LA7ORG,LA7P,LA7SR,LA7SS
S LA7OBXSN=0
;
; Process main report
I LA7NVAF'=1 F LRSB=.012,.013,.014,.015,.016,1,1.1,1.3,1.4 D OBX^LA7VORU1
I LA7NVAF=1 D SPDOD
;
; Process supplementary reports
S 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
;
; 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
. ; Procedures
. ;S LA7P=0,LRSB="10,1.5"
. ;F S LA7P=$O(^LR(LRDFN,LRSS,LRIDT,2,LA7ORG,4,LA7P)) Q:'LA7P D
. ;. S LA7IDT=LRIDT_","_LA7ORG_","_LA7P 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
;
;
SPDOD ; Build OBX segment's to special DoD specifications.
; Send word-processing fields as series of OBX's for DoD.
; DoD cannot handle formatted text (FT) data type.
N LA7DA
;
S LRSB=.012 D OBX^LA7VORU1
;
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
LA7VORU2 ;VA/DALOI/JMC - LAB ORU (Result) message builder cont'd ; 13-Aug-2013 09:09 ; MKK
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,1018,64,1027,68,1033**;NOV 01, 1997
+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 SET (LA7NLT,LA("NLT"))=$PIECE($$DEFCODE^LA7VHLU5(LRSS,.012,"",""),"!")
+7 DO OBR^LA7VORU
+8 DO NTE^LA7VORU
+9 ;
APORM ; Entry point when building OBX segments for ORM message
+1 ; Process AP subscripts
+2 ;
+3 NEW LA7ORG,LA7P,LA7SR,LA7SS
+4 SET LA7OBXSN=0
+5 ;
+6 ; Process main report
+7 IF LA7NVAF'=1
FOR LRSB=.012,.013,.014,.015,.016,1,1.1,1.3,1.4
DO OBX^LA7VORU1
+8 IF LA7NVAF=1
DO SPDOD
+9 ;
+10 ; Process supplementary reports
+11 SET LRSB=1.2
SET LA7SR=0
+12 FOR
SET LA7SR=$ORDER(^LR(LRDFN,LRSS,LRIDT,1.2,LA7SR))
IF 'LA7SR
QUIT
Begin DoDot:1
+13 NEW LA7IDT
+14 ; If don't release this report then skip.
+15 IF $PIECE($GET(^LR(LRDFN,LRSS,LRIDT,1.2,LA7SR,0)),"^",2)'=1
QUIT
+16 SET LA7IDT=LRIDT_","_LA7SR
DO OBX^LA7VORU1
End DoDot:1
+17 ;
+18 ; Process organ/tissue subfile
+19 SET LA7ORG=0
+20 FOR
SET LA7ORG=$ORDER(^LR(LRDFN,LRSS,LRIDT,2,LA7ORG))
IF 'LA7ORG
QUIT
Begin DoDot:1
+21 NEW LA7IDT
+22 SET LRSB=10
SET LA7IDT=LRIDT_","_LA7ORG
DO OBX^LA7VORU1
+23 IF LRSS="SP"
SET LRSB="10,2"
SET LA7IDT=LRIDT_","_LA7ORG
DO OBX^LA7VORU1
+24 ; Procedures
+25 ;S LA7P=0,LRSB="10,1.5"
+26 ;F S LA7P=$O(^LR(LRDFN,LRSS,LRIDT,2,LA7ORG,4,LA7P)) Q:'LA7P D
+27 ;. S LA7IDT=LRIDT_","_LA7ORG_","_LA7P D OBX^LA7VORU1
+28 ; Special studies
+29 SET LA7SS=0
SET LRSB="10,5"
+30 FOR
SET LA7SS=$ORDER(^LR(LRDFN,LRSS,LRIDT,2,LA7ORG,5,LA7SS))
IF 'LA7SS
QUIT
Begin DoDot:2
+31 SET LA7IDT=LRIDT_","_LA7ORG_","_LA7SS
DO OBX^LA7VORU1
End DoDot:2
End DoDot:1
+32 ;
+33 QUIT
+34 ;
+35 ;
SPDOD ; Build OBX segment's to special DoD specifications.
+1 ; Send word-processing fields as series of OBX's for DoD.
+2 ; DoD cannot handle formatted text (FT) data type.
+3 NEW LA7DA
+4 ;
+5 SET LRSB=.012
DO OBX^LA7VORU1
+6 ;
+7 FOR LRSB=.013,.014,.015,.016,1,1.1,1.3,1.4
Begin DoDot:1
+8 NEW LA7IDT,LA7SB
+9 SET LA7DA=0
SET LA7SB=$SELECT(LRSB=.013:.2,LRSB=.014:.3,LRSB=.015:.4,LRSB=.016:.5,1:LRSB)
+10 FOR
SET LA7DA=$ORDER(^LR(LRDFN,LRSS,LRIDT,LA7SB,LA7DA))
IF 'LA7DA
QUIT
Begin DoDot:2
+11 SET LA7IDT=LRIDT_","_LA7DA
DO OBX^LA7VORU1
End DoDot:2
End DoDot:1
+12 ;
+13 QUIT
