- 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 Jan 18, 2025@02:42:17 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