DGROHLU1 ;DJH/AMA - ROM HL7 BUILD FDA SEGMENT ; 24 Jun 2003 3:53 PM
;;5.3;Registration;**533,572**;Aug 13, 1993
;
Q
;
FDA(DGROFDA,DGSEGSTR) ; FDA SEGMENT API
;Called from BLDORF^DGROHLQ
;
; INPUT:
; DGROFDA - POINTER TO THE GLOBAL DATA ARRAY, ^TMP("DGROFDA",$J)
;
; OUTPUT:
; DGSEGSTR - ARRAY OF SEGMENTS
;
N DGVAL
;
Q:'$D(@DGROFDA)
I $$FDAVAL(.DGVAL) D
. D BLDFDA("FDA",.DGVAL,.DGSEGSTR,.DGHL)
Q
;
FDAVAL(DGVAL) ; FORMAT THE DATA ARRAY FOR THE FDA SEGMENT
; Input:
; DGVAL - array of data
;
N DGRSLT,DGX,DGF,DGIEN,DGFLD,DGEI,DGCHAR
;
S (DGRSLT,DGX)=0
S DGF=0 F S DGF=$O(@DGROFDA@(DGF)) Q:'DGF D
. S DGIEN="" F S DGIEN=$O(@DGROFDA@(DGF,DGIEN)) Q:DGIEN="" D
. . S DGFLD=0 F S DGFLD=$O(@DGROFDA@(DGF,DGIEN,DGFLD)) Q:'DGFLD D
. . . S DGX=DGX+1
. . . S DGVAL(DGX,1,1)=DGF
. . . S DGVAL(DGX,1,2)=DGIEN
. . . S DGVAL(DGX,1,3)=DGFLD
. . . ;*Get all External values (DG*5.3*572)
. . . S DGVAL(DGX,2,1)=$G(@DGROFDA@(DGF,DGIEN,DGFLD,"E"))
. S DGRSLT=1
;
Q DGRSLT
;
BLDFDA(DGTYP,DGVAL,DGSEGSTR,DGHL) ;FDA SEGMENT BUILDER
;BUILDS THE FDA SEGMENT IN THE FOLLOWING FORMAT:
; FDA ^ FILE | IEN | FIELD ~ EXTERNAL VALUE
; ADD ^ FILE | IEN | FIELD ~ EXTERNAL VALUE
; ADD ^ FILE | IEN | FIELD ~ EXTERNAL VALUE
; etc., etc.
;
; INPUT:
; DGTYP - SEGMENT TYPE
; DGVAL - FIELD DATA ARRAY [SUB1:field, SUB2:repetition
; SUB3:component, SUB4:sub-component]
; DGSEGSTR - ARRAY OF SEGMENTS, EACH NO GREATER THAN 245 CHARACTERS
; DGHL - HL7 ENVIRONMENT ARRAY
;
; OUTPUT:
; FUNCTION VALUE - FORMATTED ARRAY OF HL7 SEGMENTS ON SUCCESS, "" ON FAILURE
;
N DGCNT ;array counter
N DGFS ;field separator
N DGCS ;component separator
N DGRS ;repetition separator
N DGSS ;sub-component separator
N DGFLD ;field subscript
N DGFLDVAL ;field value
N DGSEP ;HL7 separator
N DGREP ;repetition subscript
N DGREPVAL ;repetition value
N DGCMP ;component subscript
N DGCMPVAL ;component value
N DGSUB ;sub-component subscript
N DGSUBVAL ;sub-component value
;
Q:($G(DGTYP)']"")
;
S DGCNT=1
S DGSEGSTR(DGCNT)=DGTYP
S DGFS=DGHL("FS")
S DGCS=$E(DGHL("ECH"))
S DGRS=$E(DGHL("ECH"),2)
S DGSS=$E(DGHL("ECH"),4)
;
F DGFLD=1:1:$O(DGVAL(""),-1) D
. I DGTYP="ADD" S DGCNT=DGCNT+1,DGSEGSTR(DGCNT)=DGTYP
. S DGFLDVAL=$G(DGVAL(DGFLD)),DGSEP=DGFS
. D ADD(DGFLDVAL,DGSEP,.DGSEGSTR,.DGCNT)
. F DGREP=1:1:$O(DGVAL(DGFLD,""),-1) D
. . S DGREPVAL=$G(DGVAL(DGFLD,DGREP))
. . S DGSEP=$S(DGREP=1:"",1:DGRS)
. . D ADD(DGREPVAL,DGSEP,.DGSEGSTR,.DGCNT)
. . F DGCMP=1:1:$O(DGVAL(DGFLD,DGREP,""),-1) D
. . . S DGCMPVAL=$G(DGVAL(DGFLD,DGREP,DGCMP))
. . . S DGSEP=$S(DGCMP=1:"",1:DGCS)
. . . D ADD(DGCMPVAL,DGSEP,.DGSEGSTR,.DGCNT)
. . . F DGSUB=1:1:$O(DGVAL(DGFLD,DGREP,DGCMP,""),-1) D
. . . . S DGSUBVAL=$G(DGVAL(DGFLD,DGREP,DGCMP,DGSUB))
. . . . S DGSEP=$S(DGSUB=1:"",1:DGSS)
. . . . D ADD(DGSUBVAL,DGSEP,.DGSEGSTR,.DGCNT)
. S DGTYP="ADD"
Q
;
ADD(DGVAL,DGSEP,DGSEGSTR,DGCNT) ;append a value onto segment
;
; Input:
; DGVAL - value to append
; DGSEP - HL7 separator
;
; Output:
; DGSEGSTR(DGCNT) - segment passed by reference
;
S DGSEP=$G(DGSEP)
S DGVAL=$G(DGVAL)
S DGSEGSTR(DGCNT)=DGSEGSTR(DGCNT)_DGSEP_DGVAL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGROHLU1 3430 printed Sep 23, 2025@20:31:12 Page 2
DGROHLU1 ;DJH/AMA - ROM HL7 BUILD FDA SEGMENT ; 24 Jun 2003 3:53 PM
+1 ;;5.3;Registration;**533,572**;Aug 13, 1993
+2 ;
+3 QUIT
+4 ;
FDA(DGROFDA,DGSEGSTR) ; FDA SEGMENT API
+1 ;Called from BLDORF^DGROHLQ
+2 ;
+3 ; INPUT:
+4 ; DGROFDA - POINTER TO THE GLOBAL DATA ARRAY, ^TMP("DGROFDA",$J)
+5 ;
+6 ; OUTPUT:
+7 ; DGSEGSTR - ARRAY OF SEGMENTS
+8 ;
+9 NEW DGVAL
+10 ;
+11 if '$DATA(@DGROFDA)
QUIT
+12 IF $$FDAVAL(.DGVAL)
Begin DoDot:1
+13 DO BLDFDA("FDA",.DGVAL,.DGSEGSTR,.DGHL)
End DoDot:1
+14 QUIT
+15 ;
FDAVAL(DGVAL) ; FORMAT THE DATA ARRAY FOR THE FDA SEGMENT
+1 ; Input:
+2 ; DGVAL - array of data
+3 ;
+4 NEW DGRSLT,DGX,DGF,DGIEN,DGFLD,DGEI,DGCHAR
+5 ;
+6 SET (DGRSLT,DGX)=0
+7 SET DGF=0
FOR
SET DGF=$ORDER(@DGROFDA@(DGF))
if 'DGF
QUIT
Begin DoDot:1
+8 SET DGIEN=""
FOR
SET DGIEN=$ORDER(@DGROFDA@(DGF,DGIEN))
if DGIEN=""
QUIT
Begin DoDot:2
+9 SET DGFLD=0
FOR
SET DGFLD=$ORDER(@DGROFDA@(DGF,DGIEN,DGFLD))
if 'DGFLD
QUIT
Begin DoDot:3
+10 SET DGX=DGX+1
+11 SET DGVAL(DGX,1,1)=DGF
+12 SET DGVAL(DGX,1,2)=DGIEN
+13 SET DGVAL(DGX,1,3)=DGFLD
+14 ;*Get all External values (DG*5.3*572)
+15 SET DGVAL(DGX,2,1)=$GET(@DGROFDA@(DGF,DGIEN,DGFLD,"E"))
End DoDot:3
End DoDot:2
+16 SET DGRSLT=1
End DoDot:1
+17 ;
+18 QUIT DGRSLT
+19 ;
BLDFDA(DGTYP,DGVAL,DGSEGSTR,DGHL) ;FDA SEGMENT BUILDER
+1 ;BUILDS THE FDA SEGMENT IN THE FOLLOWING FORMAT:
+2 ; FDA ^ FILE | IEN | FIELD ~ EXTERNAL VALUE
+3 ; ADD ^ FILE | IEN | FIELD ~ EXTERNAL VALUE
+4 ; ADD ^ FILE | IEN | FIELD ~ EXTERNAL VALUE
+5 ; etc., etc.
+6 ;
+7 ; INPUT:
+8 ; DGTYP - SEGMENT TYPE
+9 ; DGVAL - FIELD DATA ARRAY [SUB1:field, SUB2:repetition
+10 ; SUB3:component, SUB4:sub-component]
+11 ; DGSEGSTR - ARRAY OF SEGMENTS, EACH NO GREATER THAN 245 CHARACTERS
+12 ; DGHL - HL7 ENVIRONMENT ARRAY
+13 ;
+14 ; OUTPUT:
+15 ; FUNCTION VALUE - FORMATTED ARRAY OF HL7 SEGMENTS ON SUCCESS, "" ON FAILURE
+16 ;
+17 ;array counter
NEW DGCNT
+18 ;field separator
NEW DGFS
+19 ;component separator
NEW DGCS
+20 ;repetition separator
NEW DGRS
+21 ;sub-component separator
NEW DGSS
+22 ;field subscript
NEW DGFLD
+23 ;field value
NEW DGFLDVAL
+24 ;HL7 separator
NEW DGSEP
+25 ;repetition subscript
NEW DGREP
+26 ;repetition value
NEW DGREPVAL
+27 ;component subscript
NEW DGCMP
+28 ;component value
NEW DGCMPVAL
+29 ;sub-component subscript
NEW DGSUB
+30 ;sub-component value
NEW DGSUBVAL
+31 ;
+32 if ($GET(DGTYP)']"")
QUIT
+33 ;
+34 SET DGCNT=1
+35 SET DGSEGSTR(DGCNT)=DGTYP
+36 SET DGFS=DGHL("FS")
+37 SET DGCS=$EXTRACT(DGHL("ECH"))
+38 SET DGRS=$EXTRACT(DGHL("ECH"),2)
+39 SET DGSS=$EXTRACT(DGHL("ECH"),4)
+40 ;
+41 FOR DGFLD=1:1:$ORDER(DGVAL(""),-1)
Begin DoDot:1
+42 IF DGTYP="ADD"
SET DGCNT=DGCNT+1
SET DGSEGSTR(DGCNT)=DGTYP
+43 SET DGFLDVAL=$GET(DGVAL(DGFLD))
SET DGSEP=DGFS
+44 DO ADD(DGFLDVAL,DGSEP,.DGSEGSTR,.DGCNT)
+45 FOR DGREP=1:1:$ORDER(DGVAL(DGFLD,""),-1)
Begin DoDot:2
+46 SET DGREPVAL=$GET(DGVAL(DGFLD,DGREP))
+47 SET DGSEP=$SELECT(DGREP=1:"",1:DGRS)
+48 DO ADD(DGREPVAL,DGSEP,.DGSEGSTR,.DGCNT)
+49 FOR DGCMP=1:1:$ORDER(DGVAL(DGFLD,DGREP,""),-1)
Begin DoDot:3
+50 SET DGCMPVAL=$GET(DGVAL(DGFLD,DGREP,DGCMP))
+51 SET DGSEP=$SELECT(DGCMP=1:"",1:DGCS)
+52 DO ADD(DGCMPVAL,DGSEP,.DGSEGSTR,.DGCNT)
+53 FOR DGSUB=1:1:$ORDER(DGVAL(DGFLD,DGREP,DGCMP,""),-1)
Begin DoDot:4
+54 SET DGSUBVAL=$GET(DGVAL(DGFLD,DGREP,DGCMP,DGSUB))
+55 SET DGSEP=$SELECT(DGSUB=1:"",1:DGSS)
+56 DO ADD(DGSUBVAL,DGSEP,.DGSEGSTR,.DGCNT)
End DoDot:4
End DoDot:3
End DoDot:2
+57 SET DGTYP="ADD"
End DoDot:1
+58 QUIT
+59 ;
ADD(DGVAL,DGSEP,DGSEGSTR,DGCNT) ;append a value onto segment
+1 ;
+2 ; Input:
+3 ; DGVAL - value to append
+4 ; DGSEP - HL7 separator
+5 ;
+6 ; Output:
+7 ; DGSEGSTR(DGCNT) - segment passed by reference
+8 ;
+9 SET DGSEP=$GET(DGSEP)
+10 SET DGVAL=$GET(DGVAL)
+11 SET DGSEGSTR(DGCNT)=DGSEGSTR(DGCNT)_DGSEP_DGVAL
+12 QUIT
