DGQEHLUT ;ALB/RPM - VIC REPLACEMENT HL7 UTILITIES ; 10/6/03
;;5.3;Registration;**571,1015**;Aug 13, 1993;Build 21
;This routine contains generic utilities used when building
;or processing received VIC REPLACEMENT HL7 messages.
;
Q ;no supported direct entry
;
INIT(DGPROT,DGHL) ;Kernel HL7 INIT wrapper
;
; Supported Reference:
; DBIA #2161: INIT^HLFNC2
;
; Input:
; DGPROT - Event protocol name
;
; Output:
; Function value - HLEID on success;0 on failure
; DGHL - HL array from INIT^HLFNC2 Kernel call
;
N DGHLEID
S DGHLEID=0
S DGHLEID=$$HLEID(DGPROT)
I DGHLEID D
. D INIT^HLFNC2(DGHLEID,.DGHL)
. I $O(DGHL(""))="" S DGHLEID=0
Q DGHLEID
;
;
HLEID(DGPROT) ;return IEN of HL7 protocol
;
; Input:
; DGPROT - Protocol name
;
; Output:
; Function value - IEN of protocol on success, 0 on failure
;
I $G(DGPROT)="" Q 0
Q +$O(^ORD(101,"B",DGPROT,0))
;
;
NXTSEG(DGROOT,DGCURR,DGFS,DGFLD) ;retrieves next sequential segment
; This function retrieves the next segment in the work global, returns
; an array of field values and the segment's work global index. If
; the next segment does not exist, then the function returns a zero.
;
; Input:
; DGROOT - close root name of work global
; DGCURR - index of current segment
; DGFS - HL7 field separator character
;
; Output:
; Function Value - index of the next segment on success, 0 on failure
; DGFLD - array of segment field values
;
N NXTSEG
;
S DGCURR=DGCURR+1
S NXTSEG=$G(@DGROOT@(DGCURR,0))
I NXTSEG]"" D
. D GETFLDS(NXTSEG,DGFS,.DGFLD)
E D
. S DGCURR=0
Q DGCURR
;
;
GETFLDS(DGSEG,DGFS,DGFLD) ;retrieve HL7 segment fields into an array
;This procedure parses a single HL7 segment and builds an array
;subscripted by the field number that contains the data for that field.
;An additional subscript node, "TYPE" is created containing the segment
;type.
;
; Input:
; DGSEG - HL7 segment to parse
; DGFS - HL7 field separator
;
; Output:
; DGFLD - array of segment field values subscripted by field #
; Example: DGFLD(2)="DOE,JOHN"
;
N DGI
;
S DGFLD("TYPE")=$P(DGSEG,DGFS)
F DGI=2:1:$L(DGSEG,DGFS) D
. S DGFLD($S(DGFLD("TYPE")="MSH":DGI,1:DGI-1))=$P(DGSEG,DGFS,DGI)
Q
;
;
BLDSEG(DGTYP,DGVAL,DGHL) ;generic segment builder
;
; Input:
; DGTYP - segment type
; DGVAL - field data array [SUB1:field, SUB2:repetition,
; SUB3:component, SUB4:sub-component]
; DGHL - HL7 environment array
;
; Output:
; Function Value - Formatted HL7 segment on success, "" on failure
;
N DGCMP ;component subscript
N DGCMPVAL ;component value
N DGFLD ;field subscript
N DGFLDVAL ;field value
N DGREP ;repetition subscript
N DGREPVAL ;repetition value
N DGSUB ;sub-component subscript
N DGSUBVAL ;suc-component value
N DGFS ;field separator
N DGCS ;component separator
N DGRS ;repetition separator
N DGSS ;sub-component separator
N DGSEG
N DGSEP
;
Q:($G(DGTYP)']"") ""
;
S DGSEG=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
. S DGFLDVAL=$G(DGVAL(DGFLD)),DGSEP=DGFS
. D ADD(DGFLDVAL,DGSEP,.DGSEG)
. 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,.DGSEG)
. . 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,.DGSEG)
. . . 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,.DGSEG)
Q DGSEG
;
;
ADD(DGVAL,DGSEP,DGSEG) ;append a value onto segment
;
; Input:
; DGVAL - value to append
; DGSEP - HL7 separator
;
; Output:
; DGSEG - segment passed by reference
;
S DGSEP=$G(DGSEP)
S DGVAL=$G(DGVAL)
S DGSEG=DGSEG_DGSEP_DGVAL
Q
;
CKSTR(DGFLDS,DGSTR) ;validate comma-delimited HL7 field string
;
; Input:
; DGFLDS - (required) comma delimited string of required fields
; DGSTR - (optional) comma delimited string of fields to include
; in an HL7 segment.
;
; Output:
; Function Value - validated string of fields
;
N DGI ;generic index
N DGREQ ;required field
;
Q:($G(DGFLDS)']"") ""
S DGSTR=$G(DGSTR)
F DGI=1:1 S DGREQ=$P(DGFLDS,",",DGI) Q:DGREQ="" D
. I ","_DGSTR_","'[(","_DGREQ_",") S DGSTR=DGSTR_$S($L(DGSTR)>0:",",1:"")_DGREQ
Q DGSTR
DGQEHLUT ;ALB/RPM - VIC REPLACEMENT HL7 UTILITIES ; 10/6/03
+1 ;;5.3;Registration;**571,1015**;Aug 13, 1993;Build 21
+2 ;This routine contains generic utilities used when building
+3 ;or processing received VIC REPLACEMENT HL7 messages.
+4 ;
+5 ;no supported direct entry
QUIT
+6 ;
INIT(DGPROT,DGHL) ;Kernel HL7 INIT wrapper
+1 ;
+2 ; Supported Reference:
+3 ; DBIA #2161: INIT^HLFNC2
+4 ;
+5 ; Input:
+6 ; DGPROT - Event protocol name
+7 ;
+8 ; Output:
+9 ; Function value - HLEID on success;0 on failure
+10 ; DGHL - HL array from INIT^HLFNC2 Kernel call
+11 ;
+12 NEW DGHLEID
+13 SET DGHLEID=0
+14 SET DGHLEID=$$HLEID(DGPROT)
+15 IF DGHLEID
Begin DoDot:1
+16 DO INIT^HLFNC2(DGHLEID,.DGHL)
+17 IF $ORDER(DGHL(""))=""
SET DGHLEID=0
End DoDot:1
+18 QUIT DGHLEID
+19 ;
+20 ;
HLEID(DGPROT) ;return IEN of HL7 protocol
+1 ;
+2 ; Input:
+3 ; DGPROT - Protocol name
+4 ;
+5 ; Output:
+6 ; Function value - IEN of protocol on success, 0 on failure
+7 ;
+8 IF $GET(DGPROT)=""
QUIT 0
+9 QUIT +$ORDER(^ORD(101,"B",DGPROT,0))
+10 ;
+11 ;
NXTSEG(DGROOT,DGCURR,DGFS,DGFLD) ;retrieves next sequential segment
+1 ; This function retrieves the next segment in the work global, returns
+2 ; an array of field values and the segment's work global index. If
+3 ; the next segment does not exist, then the function returns a zero.
+4 ;
+5 ; Input:
+6 ; DGROOT - close root name of work global
+7 ; DGCURR - index of current segment
+8 ; DGFS - HL7 field separator character
+9 ;
+10 ; Output:
+11 ; Function Value - index of the next segment on success, 0 on failure
+12 ; DGFLD - array of segment field values
+13 ;
+14 NEW NXTSEG
+15 ;
+16 SET DGCURR=DGCURR+1
+17 SET NXTSEG=$GET(@DGROOT@(DGCURR,0))
+18 IF NXTSEG]""
Begin DoDot:1
+19 DO GETFLDS(NXTSEG,DGFS,.DGFLD)
End DoDot:1
+20 IF '$TEST
Begin DoDot:1
+21 SET DGCURR=0
End DoDot:1
+22 QUIT DGCURR
+23 ;
+24 ;
GETFLDS(DGSEG,DGFS,DGFLD) ;retrieve HL7 segment fields into an array
+1 ;This procedure parses a single HL7 segment and builds an array
+2 ;subscripted by the field number that contains the data for that field.
+3 ;An additional subscript node, "TYPE" is created containing the segment
+4 ;type.
+5 ;
+6 ; Input:
+7 ; DGSEG - HL7 segment to parse
+8 ; DGFS - HL7 field separator
+9 ;
+10 ; Output:
+11 ; DGFLD - array of segment field values subscripted by field #
+12 ; Example: DGFLD(2)="DOE,JOHN"
+13 ;
+14 NEW DGI
+15 ;
+16 SET DGFLD("TYPE")=$PIECE(DGSEG,DGFS)
+17 FOR DGI=2:1:$LENGTH(DGSEG,DGFS)
Begin DoDot:1
+18 SET DGFLD($SELECT(DGFLD("TYPE")="MSH":DGI,1:DGI-1))=$PIECE(DGSEG,DGFS,DGI)
End DoDot:1
+19 QUIT
+20 ;
+21 ;
BLDSEG(DGTYP,DGVAL,DGHL) ;generic segment builder
+1 ;
+2 ; Input:
+3 ; DGTYP - segment type
+4 ; DGVAL - field data array [SUB1:field, SUB2:repetition,
+5 ; SUB3:component, SUB4:sub-component]
+6 ; DGHL - HL7 environment array
+7 ;
+8 ; Output:
+9 ; Function Value - Formatted HL7 segment on success, "" on failure
+10 ;
+11 ;component subscript
NEW DGCMP
+12 ;component value
NEW DGCMPVAL
+13 ;field subscript
NEW DGFLD
+14 ;field value
NEW DGFLDVAL
+15 ;repetition subscript
NEW DGREP
+16 ;repetition value
NEW DGREPVAL
+17 ;sub-component subscript
NEW DGSUB
+18 ;suc-component value
NEW DGSUBVAL
+19 ;field separator
NEW DGFS
+20 ;component separator
NEW DGCS
+21 ;repetition separator
NEW DGRS
+22 ;sub-component separator
NEW DGSS
+23 NEW DGSEG
+24 NEW DGSEP
+25 ;
+26 IF ($GET(DGTYP)']"")
QUIT ""
+27 ;
+28 SET DGSEG=DGTYP
+29 SET DGFS=DGHL("FS")
+30 SET DGCS=$EXTRACT(DGHL("ECH"))
+31 SET DGRS=$EXTRACT(DGHL("ECH"),2)
+32 SET DGSS=$EXTRACT(DGHL("ECH"),4)
+33 ;
+34 FOR DGFLD=1:1:$ORDER(DGVAL(""),-1)
Begin DoDot:1
+35 SET DGFLDVAL=$GET(DGVAL(DGFLD))
SET DGSEP=DGFS
+36 DO ADD(DGFLDVAL,DGSEP,.DGSEG)
+37 FOR DGREP=1:1:$ORDER(DGVAL(DGFLD,""),-1)
Begin DoDot:2
+38 SET DGREPVAL=$GET(DGVAL(DGFLD,DGREP))
+39 SET DGSEP=$SELECT(DGREP=1:"",1:DGRS)
+40 DO ADD(DGREPVAL,DGSEP,.DGSEG)
+41 FOR DGCMP=1:1:$ORDER(DGVAL(DGFLD,DGREP,""),-1)
Begin DoDot:3
+42 SET DGCMPVAL=$GET(DGVAL(DGFLD,DGREP,DGCMP))
+43 SET DGSEP=$SELECT(DGCMP=1:"",1:DGCS)
+44 DO ADD(DGCMPVAL,DGSEP,.DGSEG)
+45 FOR DGSUB=1:1:$ORDER(DGVAL(DGFLD,DGREP,DGCMP,""),-1)
Begin DoDot:4
+46 SET DGSUBVAL=$GET(DGVAL(DGFLD,DGREP,DGCMP,DGSUB))
+47 SET DGSEP=$SELECT(DGSUB=1:"",1:DGSS)
+48 DO ADD(DGSUBVAL,DGSEP,.DGSEG)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+49 QUIT DGSEG
+50 ;
+51 ;
ADD(DGVAL,DGSEP,DGSEG) ;append a value onto segment
+1 ;
+2 ; Input:
+3 ; DGVAL - value to append
+4 ; DGSEP - HL7 separator
+5 ;
+6 ; Output:
+7 ; DGSEG - segment passed by reference
+8 ;
+9 SET DGSEP=$GET(DGSEP)
+10 SET DGVAL=$GET(DGVAL)
+11 SET DGSEG=DGSEG_DGSEP_DGVAL
+12 QUIT
+13 ;
CKSTR(DGFLDS,DGSTR) ;validate comma-delimited HL7 field string
+1 ;
+2 ; Input:
+3 ; DGFLDS - (required) comma delimited string of required fields
+4 ; DGSTR - (optional) comma delimited string of fields to include
+5 ; in an HL7 segment.
+6 ;
+7 ; Output:
+8 ; Function Value - validated string of fields
+9 ;
+10 ;generic index
NEW DGI
+11 ;required field
NEW DGREQ
+12 ;
+13 IF ($GET(DGFLDS)']"")
QUIT ""
+14 SET DGSTR=$GET(DGSTR)
+15 FOR DGI=1:1
SET DGREQ=$PIECE(DGFLDS,",",DGI)
IF DGREQ=""
QUIT
Begin DoDot:1
+16 IF ","_DGSTR_","'[(","_DGREQ_",")
SET DGSTR=DGSTR_$SELECT($LENGTH(DGSTR)>0:",",1:"")_DGREQ
End DoDot:1
+17 QUIT DGSTR
