DGPFHLU1 ;ALB/RPM - PRF HL7 BUILD OBR SEGMENT ; 2/18/03
;;5.3;Registration;**425,951**;Aug 13, 1993;Build 135
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
OBR(DGSET,DGPFA,DGPFAH,DGFLD,DGHL) ;OBR Segment API
;This function wraps the data retrieval and segment creation APIs and
;returns a formatted OBR segment.
;
; Input:
; DGSET - (required) OBR segment Set ID
; DGPFA - (required) Assignment data array
; DGPFAH - (required) Assignment history data array
; DGFLD - (optional) List of comma-separated fields (sequence #'s)
; to include. Defaults to all required fields (4).
; DGHL - HL7 environment array
;
; Output:
; Function Value - OBR segment on success, "" on failure
;
N DGOBR
N DGVAL
;
S HLECH=DGHL("ECH"),HLFS=DGHL("FS")
S DGOBR=""
I $G(DGSET)>0,$D(DGPFA),$D(DGPFAH) D
. S DGFLD=$$CKSTR^DGPFHLUT("4",DGFLD) ;validate the field string
. S DGFLD=","_DGFLD_","
. I $$OBRVAL(DGFLD,DGSET,.DGPFA,.DGPFAH,.DGVAL) D
. . S DGOBR=$$BLDSEG^DGPFHLUT("OBR",.DGVAL,.DGHL)
Q DGOBR
;
OBRVAL(DGFLD,DGSET,DGPFA,DGPFAH,DGVAL) ;build OBR value array
;
; Input:
; DGFLD - (required) Fields string
; DGSET - (required) OBR segment Set ID
; DGPFA - (required) Assignment data array
; DGPFAH - (required) Assignment history data array
;
; Output:
; Function Value - 1 on success, 0 on failure
; DGVAL - OBR field array [SUB1:field, SUB2:repetition,
; SUB3:component, SUB4:sub-component]
;
N DGRSLT ;function value
N DGADT ;assignment date
N DGORIG ;originating site
N DGOWN ;assignment owner
;
S DGRSLT=0
I $G(DGFLD)]"",+$G(DGSET)>0,+$G(DGPFA("FLAG"))>0,+$G(DGPFAH("ASSIGN"))>0 D
.; seq 1 Set ID
.I DGFLD[",1," S DGVAL(1)=DGSET
.; seq 4 Universal Service ID
.I DGFLD[",4," D ;required field
..S DGVAL(4,1,1)=+DGPFA("FLAG") ;flag ien
..S DGVAL(4,1,2)=$$ENCHL7^DGPFHLUT($P(DGPFA("FLAG"),U,2)) ;flag name
..S DGVAL(4,1,3)="VA085" ;table name
..Q
.; seq 7 Observation Date/Time
.I DGFLD[",7," D
..S DGADT=$$FMTHL7^XLFDT(+$$GETADT^DGPFAAH(+DGPFAH("ASSIGN")))
..S DGVAL(7)=$S(DGADT>0:DGADT,1:"")
..Q
.; seq 20 Filler field 1
.I DGFLD[",20," D
..S DGOWN=+$G(DGPFA("OWNER"))
..S DGVAL(20)=$S(DGOWN>0:$$STA^XUAF4(DGOWN),1:"")
..Q
.; seq 21 Filler Field 2
.I DGFLD[",21," D
..S DGORIG=+$G(DGPFA("ORIGSITE"))
..S DGVAL(21)=$S(DGORIG>0:$$STA^XUAF4(DGORIG),1:"")
..Q
.S DGRSLT=1
.Q
I 'DGRSLT K DGVAL
Q DGRSLT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFHLU1 2633 printed Sep 23, 2025@20:23:46 Page 2
DGPFHLU1 ;ALB/RPM - PRF HL7 BUILD OBR SEGMENT ; 2/18/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 ;
OBR(DGSET,DGPFA,DGPFAH,DGFLD,DGHL) ;OBR Segment API
+1 ;This function wraps the data retrieval and segment creation APIs and
+2 ;returns a formatted OBR segment.
+3 ;
+4 ; Input:
+5 ; DGSET - (required) OBR segment Set ID
+6 ; DGPFA - (required) Assignment data array
+7 ; DGPFAH - (required) Assignment history data array
+8 ; DGFLD - (optional) List of comma-separated fields (sequence #'s)
+9 ; to include. Defaults to all required fields (4).
+10 ; DGHL - HL7 environment array
+11 ;
+12 ; Output:
+13 ; Function Value - OBR segment on success, "" on failure
+14 ;
+15 NEW DGOBR
+16 NEW DGVAL
+17 ;
+18 SET HLECH=DGHL("ECH")
SET HLFS=DGHL("FS")
+19 SET DGOBR=""
+20 IF $GET(DGSET)>0
IF $DATA(DGPFA)
IF $DATA(DGPFAH)
Begin DoDot:1
+21 ;validate the field string
SET DGFLD=$$CKSTR^DGPFHLUT("4",DGFLD)
+22 SET DGFLD=","_DGFLD_","
+23 IF $$OBRVAL(DGFLD,DGSET,.DGPFA,.DGPFAH,.DGVAL)
Begin DoDot:2
+24 SET DGOBR=$$BLDSEG^DGPFHLUT("OBR",.DGVAL,.DGHL)
End DoDot:2
End DoDot:1
+25 QUIT DGOBR
+26 ;
OBRVAL(DGFLD,DGSET,DGPFA,DGPFAH,DGVAL) ;build OBR value array
+1 ;
+2 ; Input:
+3 ; DGFLD - (required) Fields string
+4 ; DGSET - (required) OBR segment Set ID
+5 ; DGPFA - (required) Assignment data array
+6 ; DGPFAH - (required) Assignment history data array
+7 ;
+8 ; Output:
+9 ; Function Value - 1 on success, 0 on failure
+10 ; DGVAL - OBR field array [SUB1:field, SUB2:repetition,
+11 ; SUB3:component, SUB4:sub-component]
+12 ;
+13 ;function value
NEW DGRSLT
+14 ;assignment date
NEW DGADT
+15 ;originating site
NEW DGORIG
+16 ;assignment owner
NEW DGOWN
+17 ;
+18 SET DGRSLT=0
+19 IF $GET(DGFLD)]""
IF +$GET(DGSET)>0
IF +$GET(DGPFA("FLAG"))>0
IF +$GET(DGPFAH("ASSIGN"))>0
Begin DoDot:1
+20 ; seq 1 Set ID
+21 IF DGFLD[",1,"
SET DGVAL(1)=DGSET
+22 ; seq 4 Universal Service ID
+23 ;required field
IF DGFLD[",4,"
Begin DoDot:2
+24 ;flag ien
SET DGVAL(4,1,1)=+DGPFA("FLAG")
+25 ;flag name
SET DGVAL(4,1,2)=$$ENCHL7^DGPFHLUT($PIECE(DGPFA("FLAG"),U,2))
+26 ;table name
SET DGVAL(4,1,3)="VA085"
+27 QUIT
End DoDot:2
+28 ; seq 7 Observation Date/Time
+29 IF DGFLD[",7,"
Begin DoDot:2
+30 SET DGADT=$$FMTHL7^XLFDT(+$$GETADT^DGPFAAH(+DGPFAH("ASSIGN")))
+31 SET DGVAL(7)=$SELECT(DGADT>0:DGADT,1:"")
+32 QUIT
End DoDot:2
+33 ; seq 20 Filler field 1
+34 IF DGFLD[",20,"
Begin DoDot:2
+35 SET DGOWN=+$GET(DGPFA("OWNER"))
+36 SET DGVAL(20)=$SELECT(DGOWN>0:$$STA^XUAF4(DGOWN),1:"")
+37 QUIT
End DoDot:2
+38 ; seq 21 Filler Field 2
+39 IF DGFLD[",21,"
Begin DoDot:2
+40 SET DGORIG=+$GET(DGPFA("ORIGSITE"))
+41 SET DGVAL(21)=$SELECT(DGORIG>0:$$STA^XUAF4(DGORIG),1:"")
+42 QUIT
End DoDot:2
+43 SET DGRSLT=1
+44 QUIT
End DoDot:1
+45 IF 'DGRSLT
KILL DGVAL
+46 QUIT DGRSLT
