Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPFHLU1

DGPFHLU1.m

Go to the documentation of this file.
  1. DGPFHLU1 ;ALB/RPM - PRF HL7 BUILD OBR SEGMENT ; 2/18/03
  1. ;;5.3;Registration;**425,951**;Aug 13, 1993;Build 135
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. OBR(DGSET,DGPFA,DGPFAH,DGFLD,DGHL) ;OBR Segment API
  1. ;This function wraps the data retrieval and segment creation APIs and
  1. ;returns a formatted OBR segment.
  1. ;
  1. ; Input:
  1. ; DGSET - (required) OBR segment Set ID
  1. ; DGPFA - (required) Assignment data array
  1. ; DGPFAH - (required) Assignment history data array
  1. ; DGFLD - (optional) List of comma-separated fields (sequence #'s)
  1. ; to include. Defaults to all required fields (4).
  1. ; DGHL - HL7 environment array
  1. ;
  1. ; Output:
  1. ; Function Value - OBR segment on success, "" on failure
  1. ;
  1. N DGOBR
  1. N DGVAL
  1. ;
  1. S HLECH=DGHL("ECH"),HLFS=DGHL("FS")
  1. S DGOBR=""
  1. I $G(DGSET)>0,$D(DGPFA),$D(DGPFAH) D
  1. . S DGFLD=$$CKSTR^DGPFHLUT("4",DGFLD) ;validate the field string
  1. . S DGFLD=","_DGFLD_","
  1. . I $$OBRVAL(DGFLD,DGSET,.DGPFA,.DGPFAH,.DGVAL) D
  1. . . S DGOBR=$$BLDSEG^DGPFHLUT("OBR",.DGVAL,.DGHL)
  1. Q DGOBR
  1. ;
  1. OBRVAL(DGFLD,DGSET,DGPFA,DGPFAH,DGVAL) ;build OBR value array
  1. ;
  1. ; Input:
  1. ; DGFLD - (required) Fields string
  1. ; DGSET - (required) OBR segment Set ID
  1. ; DGPFA - (required) Assignment data array
  1. ; DGPFAH - (required) Assignment history data array
  1. ;
  1. ; Output:
  1. ; Function Value - 1 on success, 0 on failure
  1. ; DGVAL - OBR field array [SUB1:field, SUB2:repetition,
  1. ; SUB3:component, SUB4:sub-component]
  1. ;
  1. N DGRSLT ;function value
  1. N DGADT ;assignment date
  1. N DGORIG ;originating site
  1. N DGOWN ;assignment owner
  1. ;
  1. S DGRSLT=0
  1. I $G(DGFLD)]"",+$G(DGSET)>0,+$G(DGPFA("FLAG"))>0,+$G(DGPFAH("ASSIGN"))>0 D
  1. .; seq 1 Set ID
  1. .I DGFLD[",1," S DGVAL(1)=DGSET
  1. .; seq 4 Universal Service ID
  1. .I DGFLD[",4," D ;required field
  1. ..S DGVAL(4,1,1)=+DGPFA("FLAG") ;flag ien
  1. ..S DGVAL(4,1,2)=$$ENCHL7^DGPFHLUT($P(DGPFA("FLAG"),U,2)) ;flag name
  1. ..S DGVAL(4,1,3)="VA085" ;table name
  1. ..Q
  1. .; seq 7 Observation Date/Time
  1. .I DGFLD[",7," D
  1. ..S DGADT=$$FMTHL7^XLFDT(+$$GETADT^DGPFAAH(+DGPFAH("ASSIGN")))
  1. ..S DGVAL(7)=$S(DGADT>0:DGADT,1:"")
  1. ..Q
  1. .; seq 20 Filler field 1
  1. .I DGFLD[",20," D
  1. ..S DGOWN=+$G(DGPFA("OWNER"))
  1. ..S DGVAL(20)=$S(DGOWN>0:$$STA^XUAF4(DGOWN),1:"")
  1. ..Q
  1. .; seq 21 Filler Field 2
  1. .I DGFLD[",21," D
  1. ..S DGORIG=+$G(DGPFA("ORIGSITE"))
  1. ..S DGVAL(21)=$S(DGORIG>0:$$STA^XUAF4(DGORIG),1:"")
  1. ..Q
  1. .S DGRSLT=1
  1. .Q
  1. I 'DGRSLT K DGVAL
  1. Q DGRSLT