Routine: LA7VORU2

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

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

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

LA7VORU2.m