DGPFHLU2 ;ALB/RPM - PRF HL7 BUILD OBX SEGMENT ; 2/20/03
;;5.3;Registration;**425,951**;Aug 13, 1993;Build 135
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
OBX(DGSET,DGID,DGSUBID,DGVALUE,DGPFAH,DGFLD,DGHL) ;OBX Segment API
;This function wraps the data retrieval and segment creation APIs and
;returns a formatted OBX segment.
;
; Input:
; DGSET - (required) OBX segment Set ID
; DGID - (required) Observation identifier code
; DGSUBID - (optional) Observation Sub-ID
; DGVALUE - (required) Observation value
; DGPFAH - (required) Assignment history data array
; DGFLD - (optional) List of comma-separated fields (sequence #'s)
; to include. Defaults to all required fields (3,11).
; DGHL - HL7 environment array
;
; Output:
; Function Value - OBX segment on success, "" on failure
;
N DGOBX
N DGVAL
;
S HLECH=DGHL("ECH"),HLFS=DGHL("FS")
S DGOBX=""
I $G(DGSET)>0,$G(DGID)?1A,$G(DGVALUE)]"" D
. S DGFLD=$$CKSTR^DGPFHLUT("3,11",DGFLD) ;required fields
. S DGFLD=","_DGFLD_","
. I $$OBXVAL(DGFLD,DGSET,DGID,DGSUBID,DGVALUE,.DGPFAH,.DGVAL) D
. . S DGOBX=$$BLDSEG^DGPFHLUT("OBX",.DGVAL,.DGHL)
Q DGOBX
;
OBXVAL(DGFLD,DGSET,DGID,DGSUBID,DGVALUE,DGPFAH,DGVAL) ;build OBX value array
;
; Input:
; DGFLD - (required) Fields string
; DGSET - (required) OBX segment Set ID
; DGID - (required) Observation identifier code
; DGSUBID - (optional) Observation Sub-ID
; DGVALUE - (required) Observation value, or DBRS data string in case of DBRS OBX segment
; DGPFAH - (required) Assignment history data array
;
; Output:
; Function Value - 1 on success, 0 on failure
; DGVAL - OBX field array [SUB1:field, SUB2:repetition,
; SUB3:component, SUB4:sub-component]
;
N DGRSLT ;function value
N DGTYPE ;observation value type
N DGIDSTR ;observation identifier string
N DGDAT ;observation date
N ACTION,DBRSSTAT
;
S DGRSLT=0
S ACTION=+$G(DGPFAH("ACTION"))
I DGID="D" S DBRSSTAT=$P($P(DGVALUE,U,4),";")
;
I $G(DGFLD)]"",+$G(DGSET)>0,$G(DGID)?1A,$G(DGVALUE)]"" D
.; seq 1 Set ID
.I DGFLD[",1," S DGVAL(1)=DGSET
.; seq 2 Value Type
.I DGFLD[",2," D
..S DGTYPE=$S(DGID="S":"ST",DGID="N":"TX",DGID="C":"TX",DGID="D":"TX",1:"") Q:(DGTYPE']"")
..S DGVAL(2)=DGTYPE
..Q
.; seq 3 Observation Identifier
.I DGFLD[",3," D Q:'$D(DGVAL(3)) ;required field
..I DGID="D" S DGIDSTR="DBRS-"_$S(DBRSSTAT="D":"Delete",1:"Update")
..I DGID'="D" S DGIDSTR=$S(DGID="S":"Status",DGID="N":"Narrative",DGID="C":"Comment",1:"") Q:(DGIDSTR']"")
..S DGVAL(3,1,1)=DGID
..S DGVAL(3,1,2)=DGIDSTR
..S DGVAL(3,1,3)="L"
..Q
.; seq 4 Observation Sub-ID (optional)
.I DGFLD[",4," S DGVAL(4)=$S(+$G(DGSUBID)>0:DGSUBID,1:"")
.; seq 5 Observation Value
.I DGFLD[",5," D
..I DGID="D" S DGVAL(5,1)=$$ENCHL7^DGPFHLUT($P(DGVALUE,U)),DGVAL(5,2)=$$ENCHL7^DGPFHLUT($P(DGVALUE,U,2)) Q
..S DGVAL(5)=$$ENCHL7^DGPFHLUT(DGVALUE)
..Q
.; seq 6 Units
.I DGFLD[",6," S DGVAL(6)=""
.; seq 7 Reference Range
.I DGFLD[",7," S DGVAL(7)=""
.; seq 8 Abnormal Flags
.I DGFLD[",8," S DGVAL(8)=""
.; seq 9 Probability
.I DGFLD[",9," S DGVAL(9)=""
.; seq 10 Nature of Abnormal Test
.I DGFLD[",10," S DGVAL(10)=""
.; seq 11 Observation Result Status
.I DGFLD[",11," S DGVAL(11)="F"
.; seq 12 Date last Obs Normal Values
.I DGFLD[",12," S DGVAL(12)=""
.; seq 13 User Defined Access Checks
.I DGFLD[",13," S DGVAL(13)=""
.; seq 14 Date/Time of the Observation
.I DGFLD[",14," D
..S DGDAT=$$FMTHL7^XLFDT($S(DGID="D":$P($P(DGVALUE,U,3),";"),1:+$G(DGPFAH("ASSIGNDT"))))
..S DGVAL(14)=$S(DGDAT>0:DGDAT,1:"")
..Q
.; seq 15 Producer's ID
.I DGFLD[",15," S DGVAL(15)=""
.; seq 16 Responsible Observer
.I DGFLD[",16," S DGVAL(16)=""
.; seq 17 Observation Method
.I DGFLD[",17," S DGVAL(17)=""
.; seq 23 Performing Organization Name
.I DGFLD[",23," D
..I DGID="D" S DGVAL(23,1,3)=$$STA^XUAF4(+$P($P(DGVALUE,U,5),";")) Q
..S DGVAL(23,1,3)=$$STA^XUAF4(+$G(DGPFAH("ORIGFAC")))
..Q
.;
.S DGRSLT=1
.Q
I 'DGRSLT K DGVAL
Q DGRSLT
;
BLDOBXTX(DGROOT,DGTXTA,DGID,DGPFAH,DGHL,DGSEG,DGSET) ;build OBX text segments
;
; Input:
; DGROOT - (required) Closed root array or global name for segment
; storage
; DGTXTA - (required) Closed root array containing text
; DGID - (required) OBX segment Observation ID
; DGPFAH - (required) Assignment history data array
; DGHL - (required) VistA HL7 environment array
; DGSEG - (optional) Previous segment # in DGROOT
; DGSET - (optional) Previous OBX Set ID
;
; Output:
; Function Value - 1 on success, 0 on failure
;
N DGI ;generic counter
N DGOBX ;formatted OBX segment
N DGOBXTX ;array of pre-processed text lines
N DGRSLT ;function value
N DGSTR ;list of OBX segment fields to include
;
S DGRSLT=0
S DGSTR="1,2,3,5,11,14,23"
I $G(DGROOT)]"",$G(DGTXTA)]"",$G(DGID)?1A,$D(DGPFAH) D
. Q:'$$BLDTEXT^DGPFHLUT(DGTXTA,.DGHL,.DGOBXTX)
. S DGSEG=$G(DGSEG,0)
. S DGSET=$G(DGSET,0)
. S DGI=0
. F S DGI=$O(DGOBXTX(DGI)) Q:'DGI D Q:(DGOBX="")
. . S DGSET=DGSET+1
. . S DGOBX=$$OBX^DGPFHLU2(DGSET,DGID,"",DGOBXTX(DGI),.DGPFAH,DGSTR,.DGHL)
. . Q:(DGOBX="")
. . S DGSEG=DGSEG+1,@DGROOT@(DGSEG)=DGOBX
. Q:(DGOBX)=""
. ;
. ;success
. S DGRSLT=1
;
Q DGRSLT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFHLU2 5504 printed Dec 13, 2024@02:47:55 Page 2
DGPFHLU2 ;ALB/RPM - PRF HL7 BUILD OBX SEGMENT ; 2/20/03
+1 ;;5.3;Registration;**425,951**;Aug 13, 1993;Build 135
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
OBX(DGSET,DGID,DGSUBID,DGVALUE,DGPFAH,DGFLD,DGHL) ;OBX Segment API
+1 ;This function wraps the data retrieval and segment creation APIs and
+2 ;returns a formatted OBX segment.
+3 ;
+4 ; Input:
+5 ; DGSET - (required) OBX segment Set ID
+6 ; DGID - (required) Observation identifier code
+7 ; DGSUBID - (optional) Observation Sub-ID
+8 ; DGVALUE - (required) Observation value
+9 ; DGPFAH - (required) Assignment history data array
+10 ; DGFLD - (optional) List of comma-separated fields (sequence #'s)
+11 ; to include. Defaults to all required fields (3,11).
+12 ; DGHL - HL7 environment array
+13 ;
+14 ; Output:
+15 ; Function Value - OBX segment on success, "" on failure
+16 ;
+17 NEW DGOBX
+18 NEW DGVAL
+19 ;
+20 SET HLECH=DGHL("ECH")
SET HLFS=DGHL("FS")
+21 SET DGOBX=""
+22 IF $GET(DGSET)>0
IF $GET(DGID)?1A
IF $GET(DGVALUE)]""
Begin DoDot:1
+23 ;required fields
SET DGFLD=$$CKSTR^DGPFHLUT("3,11",DGFLD)
+24 SET DGFLD=","_DGFLD_","
+25 IF $$OBXVAL(DGFLD,DGSET,DGID,DGSUBID,DGVALUE,.DGPFAH,.DGVAL)
Begin DoDot:2
+26 SET DGOBX=$$BLDSEG^DGPFHLUT("OBX",.DGVAL,.DGHL)
End DoDot:2
End DoDot:1
+27 QUIT DGOBX
+28 ;
OBXVAL(DGFLD,DGSET,DGID,DGSUBID,DGVALUE,DGPFAH,DGVAL) ;build OBX value array
+1 ;
+2 ; Input:
+3 ; DGFLD - (required) Fields string
+4 ; DGSET - (required) OBX segment Set ID
+5 ; DGID - (required) Observation identifier code
+6 ; DGSUBID - (optional) Observation Sub-ID
+7 ; DGVALUE - (required) Observation value, or DBRS data string in case of DBRS OBX segment
+8 ; DGPFAH - (required) Assignment history data array
+9 ;
+10 ; Output:
+11 ; Function Value - 1 on success, 0 on failure
+12 ; DGVAL - OBX field array [SUB1:field, SUB2:repetition,
+13 ; SUB3:component, SUB4:sub-component]
+14 ;
+15 ;function value
NEW DGRSLT
+16 ;observation value type
NEW DGTYPE
+17 ;observation identifier string
NEW DGIDSTR
+18 ;observation date
NEW DGDAT
+19 NEW ACTION,DBRSSTAT
+20 ;
+21 SET DGRSLT=0
+22 SET ACTION=+$GET(DGPFAH("ACTION"))
+23 IF DGID="D"
SET DBRSSTAT=$PIECE($PIECE(DGVALUE,U,4),";")
+24 ;
+25 IF $GET(DGFLD)]""
IF +$GET(DGSET)>0
IF $GET(DGID)?1A
IF $GET(DGVALUE)]""
Begin DoDot:1
+26 ; seq 1 Set ID
+27 IF DGFLD[",1,"
SET DGVAL(1)=DGSET
+28 ; seq 2 Value Type
+29 IF DGFLD[",2,"
Begin DoDot:2
+30 SET DGTYPE=$SELECT(DGID="S":"ST",DGID="N":"TX",DGID="C":"TX",DGID="D":"TX",1:"")
if (DGTYPE']"")
QUIT
+31 SET DGVAL(2)=DGTYPE
+32 QUIT
End DoDot:2
+33 ; seq 3 Observation Identifier
+34 ;required field
IF DGFLD[",3,"
Begin DoDot:2
+35 IF DGID="D"
SET DGIDSTR="DBRS-"_$SELECT(DBRSSTAT="D":"Delete",1:"Update")
+36 IF DGID'="D"
SET DGIDSTR=$SELECT(DGID="S":"Status",DGID="N":"Narrative",DGID="C":"Comment",1:"")
if (DGIDSTR']"")
QUIT
+37 SET DGVAL(3,1,1)=DGID
+38 SET DGVAL(3,1,2)=DGIDSTR
+39 SET DGVAL(3,1,3)="L"
+40 QUIT
End DoDot:2
if '$DATA(DGVAL(3))
QUIT
+41 ; seq 4 Observation Sub-ID (optional)
+42 IF DGFLD[",4,"
SET DGVAL(4)=$SELECT(+$GET(DGSUBID)>0:DGSUBID,1:"")
+43 ; seq 5 Observation Value
+44 IF DGFLD[",5,"
Begin DoDot:2
+45 IF DGID="D"
SET DGVAL(5,1)=$$ENCHL7^DGPFHLUT($PIECE(DGVALUE,U))
SET DGVAL(5,2)=$$ENCHL7^DGPFHLUT($PIECE(DGVALUE,U,2))
QUIT
+46 SET DGVAL(5)=$$ENCHL7^DGPFHLUT(DGVALUE)
+47 QUIT
End DoDot:2
+48 ; seq 6 Units
+49 IF DGFLD[",6,"
SET DGVAL(6)=""
+50 ; seq 7 Reference Range
+51 IF DGFLD[",7,"
SET DGVAL(7)=""
+52 ; seq 8 Abnormal Flags
+53 IF DGFLD[",8,"
SET DGVAL(8)=""
+54 ; seq 9 Probability
+55 IF DGFLD[",9,"
SET DGVAL(9)=""
+56 ; seq 10 Nature of Abnormal Test
+57 IF DGFLD[",10,"
SET DGVAL(10)=""
+58 ; seq 11 Observation Result Status
+59 IF DGFLD[",11,"
SET DGVAL(11)="F"
+60 ; seq 12 Date last Obs Normal Values
+61 IF DGFLD[",12,"
SET DGVAL(12)=""
+62 ; seq 13 User Defined Access Checks
+63 IF DGFLD[",13,"
SET DGVAL(13)=""
+64 ; seq 14 Date/Time of the Observation
+65 IF DGFLD[",14,"
Begin DoDot:2
+66 SET DGDAT=$$FMTHL7^XLFDT($SELECT(DGID="D":$PIECE($PIECE(DGVALUE,U,3),";"),1:+$GET(DGPFAH("ASSIGNDT"))))
+67 SET DGVAL(14)=$SELECT(DGDAT>0:DGDAT,1:"")
+68 QUIT
End DoDot:2
+69 ; seq 15 Producer's ID
+70 IF DGFLD[",15,"
SET DGVAL(15)=""
+71 ; seq 16 Responsible Observer
+72 IF DGFLD[",16,"
SET DGVAL(16)=""
+73 ; seq 17 Observation Method
+74 IF DGFLD[",17,"
SET DGVAL(17)=""
+75 ; seq 23 Performing Organization Name
+76 IF DGFLD[",23,"
Begin DoDot:2
+77 IF DGID="D"
SET DGVAL(23,1,3)=$$STA^XUAF4(+$PIECE($PIECE(DGVALUE,U,5),";"))
QUIT
+78 SET DGVAL(23,1,3)=$$STA^XUAF4(+$GET(DGPFAH("ORIGFAC")))
+79 QUIT
End DoDot:2
+80 ;
+81 SET DGRSLT=1
+82 QUIT
End DoDot:1
+83 IF 'DGRSLT
KILL DGVAL
+84 QUIT DGRSLT
+85 ;
BLDOBXTX(DGROOT,DGTXTA,DGID,DGPFAH,DGHL,DGSEG,DGSET) ;build OBX text segments
+1 ;
+2 ; Input:
+3 ; DGROOT - (required) Closed root array or global name for segment
+4 ; storage
+5 ; DGTXTA - (required) Closed root array containing text
+6 ; DGID - (required) OBX segment Observation ID
+7 ; DGPFAH - (required) Assignment history data array
+8 ; DGHL - (required) VistA HL7 environment array
+9 ; DGSEG - (optional) Previous segment # in DGROOT
+10 ; DGSET - (optional) Previous OBX Set ID
+11 ;
+12 ; Output:
+13 ; Function Value - 1 on success, 0 on failure
+14 ;
+15 ;generic counter
NEW DGI
+16 ;formatted OBX segment
NEW DGOBX
+17 ;array of pre-processed text lines
NEW DGOBXTX
+18 ;function value
NEW DGRSLT
+19 ;list of OBX segment fields to include
NEW DGSTR
+20 ;
+21 SET DGRSLT=0
+22 SET DGSTR="1,2,3,5,11,14,23"
+23 IF $GET(DGROOT)]""
IF $GET(DGTXTA)]""
IF $GET(DGID)?1A
IF $DATA(DGPFAH)
Begin DoDot:1
+24 if '$$BLDTEXT^DGPFHLUT(DGTXTA,.DGHL,.DGOBXTX)
QUIT
+25 SET DGSEG=$GET(DGSEG,0)
+26 SET DGSET=$GET(DGSET,0)
+27 SET DGI=0
+28 FOR
SET DGI=$ORDER(DGOBXTX(DGI))
if 'DGI
QUIT
Begin DoDot:2
+29 SET DGSET=DGSET+1
+30 SET DGOBX=$$OBX^DGPFHLU2(DGSET,DGID,"",DGOBXTX(DGI),.DGPFAH,DGSTR,.DGHL)
+31 if (DGOBX="")
QUIT
+32 SET DGSEG=DGSEG+1
SET @DGROOT@(DGSEG)=DGOBX
End DoDot:2
if (DGOBX="")
QUIT
+33 if (DGOBX)=""
QUIT
+34 ;
+35 ;success
+36 SET DGRSLT=1
End DoDot:1
+37 ;
+38 QUIT DGRSLT
