DGPFHLU2 ;ALB/RPM - PRF HL7 BUILD OBX SEGMENT ; 2/20/03
;;5.3;Registration;**425,1015**;Aug 13, 1993;Build 21
;
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 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
; DGPFAH - (required) Assignment history data array
;
; Output:
; Function Value - 1 on sucess, 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
;
S DGRSLT=0
I $G(DGFLD)]"",+$G(DGSET)>0,$G(DGID)?1A,$G(DGVALUE)]"" D
. ;
. ; seq 1 Set ID
. I DGFLD[",1," D
. . S DGVAL(1)=DGSET
. ;
. ; seq 2 Value Type
. I DGFLD[",2," D
. . S DGTYPE=$S(DGID="S":"ST",DGID="N":"TX",DGID="C":"TX",1:"")
. . Q:(DGTYPE']"")
. . S DGVAL(2)=DGTYPE
. ;
. ; seq 3 Observation Identifier
. I DGFLD[",3," D Q:'$D(DGVAL(3)) ;required field
. . 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"
. ;
. ; seq 4 Observation Sub-ID (optional)
. I DGFLD[",4," D
. . S DGVAL(4)=$S(+$G(DGSUBID)>0:DGSUBID,1:"")
. ;
. ; seq 5 Observation Value
. I DGFLD[",5," D
. . S DGVAL(5)=DGVALUE
. ;
. ; seq 6 Units
. I DGFLD[",6," D
. . S DGVAL(6)=""
. ;
. ; seq 7 Reference Range
. I DGFLD[",7," D
. . S DGVAL(7)=""
. ;
. ; seq 8 Abnormal Flags
. I DGFLD[",8," D
. . S DGVAL(8)=""
. ;
. ; seq 9 Probability
. I DGFLD[",9," D
. . S DGVAL(9)=""
. ;
. ; seq 10 Nature of Abnormal Test
. I DGFLD[",10," D
. . S DGVAL(10)=""
. ;
. ; seq 11 Observ Result Status
. I DGFLD[",11," D
. . S DGVAL(11)="F"
. ;
. ; seq 12 Date last Obs Normal Values
. I DGFLD[",12," D
. . S DGVAL(12)=""
. ;
. ; seq 13 User Defined Access Checks
. I DGFLD[",13," D
. . S DGVAL(13)=""
. ;
. ; seq 14 Date/Time of the Observation
. I DGFLD[",14," D
. . S DGDAT=$$FMTHL7^XLFDT(+$G(DGPFAH("ASSIGNDT")))
. . S DGVAL(14)=$S(DGDAT>0:DGDAT,1:"")
. ;
. ; seq 15 Producer's ID
. I DGFLD[",15," D
. . S DGVAL(15)=""
. ;
. ; seq 16 Responsible Observer
. I DGFLD[",16," D
. . S DGVAL(16)=""
. ;
. ; seq 17 Observation Method
. I DGFLD[",17," D
. . S DGVAL(17)=""
. ;
. S DGRSLT=1
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"
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
DGPFHLU2 ;ALB/RPM - PRF HL7 BUILD OBX SEGMENT ; 2/20/03
+1 ;;5.3;Registration;**425,1015**;Aug 13, 1993;Build 21
+2 ;
+3 QUIT
+4 ;
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 DGOBX=""
+21 IF $GET(DGSET)>0
IF $GET(DGID)?1A
IF $GET(DGVALUE)]""
Begin DoDot:1
+22 ;required fields
SET DGFLD=$$CKSTR^DGPFHLUT("3,11",DGFLD)
+23 SET DGFLD=","_DGFLD_","
+24 IF $$OBXVAL(DGFLD,DGSET,DGID,DGSUBID,DGVALUE,.DGPFAH,.DGVAL)
Begin DoDot:2
+25 SET DGOBX=$$BLDSEG^DGPFHLUT("OBX",.DGVAL,.DGHL)
End DoDot:2
End DoDot:1
+26 QUIT DGOBX
+27 ;
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
+8 ; DGPFAH - (required) Assignment history data array
+9 ;
+10 ; Output:
+11 ; Function Value - 1 on sucess, 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 ;
+20 SET DGRSLT=0
+21 IF $GET(DGFLD)]""
IF +$GET(DGSET)>0
IF $GET(DGID)?1A
IF $GET(DGVALUE)]""
Begin DoDot:1
+22 ;
+23 ; seq 1 Set ID
+24 IF DGFLD[",1,"
Begin DoDot:2
+25 SET DGVAL(1)=DGSET
End DoDot:2
+26 ;
+27 ; seq 2 Value Type
+28 IF DGFLD[",2,"
Begin DoDot:2
+29 SET DGTYPE=$SELECT(DGID="S":"ST",DGID="N":"TX",DGID="C":"TX",1:"")
+30 IF (DGTYPE']"")
QUIT
+31 SET DGVAL(2)=DGTYPE
End DoDot:2
+32 ;
+33 ; seq 3 Observation Identifier
+34 ;required field
IF DGFLD[",3,"
Begin DoDot:2
+35 SET DGIDSTR=$SELECT(DGID="S":"Status",DGID="N":"Narrative",DGID="C":"Comment",1:"")
+36 IF (DGIDSTR']"")
QUIT
+37 SET DGVAL(3,1,1)=DGID
+38 SET DGVAL(3,1,2)=DGIDSTR
+39 SET DGVAL(3,1,3)="L"
End DoDot:2
IF '$DATA(DGVAL(3))
QUIT
+40 ;
+41 ; seq 4 Observation Sub-ID (optional)
+42 IF DGFLD[",4,"
Begin DoDot:2
+43 SET DGVAL(4)=$SELECT(+$GET(DGSUBID)>0:DGSUBID,1:"")
End DoDot:2
+44 ;
+45 ; seq 5 Observation Value
+46 IF DGFLD[",5,"
Begin DoDot:2
+47 SET DGVAL(5)=DGVALUE
End DoDot:2
+48 ;
+49 ; seq 6 Units
+50 IF DGFLD[",6,"
Begin DoDot:2
+51 SET DGVAL(6)=""
End DoDot:2
+52 ;
+53 ; seq 7 Reference Range
+54 IF DGFLD[",7,"
Begin DoDot:2
+55 SET DGVAL(7)=""
End DoDot:2
+56 ;
+57 ; seq 8 Abnormal Flags
+58 IF DGFLD[",8,"
Begin DoDot:2
+59 SET DGVAL(8)=""
End DoDot:2
+60 ;
+61 ; seq 9 Probability
+62 IF DGFLD[",9,"
Begin DoDot:2
+63 SET DGVAL(9)=""
End DoDot:2
+64 ;
+65 ; seq 10 Nature of Abnormal Test
+66 IF DGFLD[",10,"
Begin DoDot:2
+67 SET DGVAL(10)=""
End DoDot:2
+68 ;
+69 ; seq 11 Observ Result Status
+70 IF DGFLD[",11,"
Begin DoDot:2
+71 SET DGVAL(11)="F"
End DoDot:2
+72 ;
+73 ; seq 12 Date last Obs Normal Values
+74 IF DGFLD[",12,"
Begin DoDot:2
+75 SET DGVAL(12)=""
End DoDot:2
+76 ;
+77 ; seq 13 User Defined Access Checks
+78 IF DGFLD[",13,"
Begin DoDot:2
+79 SET DGVAL(13)=""
End DoDot:2
+80 ;
+81 ; seq 14 Date/Time of the Observation
+82 IF DGFLD[",14,"
Begin DoDot:2
+83 SET DGDAT=$$FMTHL7^XLFDT(+$GET(DGPFAH("ASSIGNDT")))
+84 SET DGVAL(14)=$SELECT(DGDAT>0:DGDAT,1:"")
End DoDot:2
+85 ;
+86 ; seq 15 Producer's ID
+87 IF DGFLD[",15,"
Begin DoDot:2
+88 SET DGVAL(15)=""
End DoDot:2
+89 ;
+90 ; seq 16 Responsible Observer
+91 IF DGFLD[",16,"
Begin DoDot:2
+92 SET DGVAL(16)=""
End DoDot:2
+93 ;
+94 ; seq 17 Observation Method
+95 IF DGFLD[",17,"
Begin DoDot:2
+96 SET DGVAL(17)=""
End DoDot:2
+97 ;
+98 SET DGRSLT=1
End DoDot:1
+99 IF 'DGRSLT
KILL DGVAL
+100 QUIT DGRSLT
+101 ;
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 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
