DGROHLUT ;DJH/AMA - ROM HL7 UTILITIES ; 24 Jun 2003 3:53 PM
;;5.3;Registration;**533,1015**;Aug 13, 1993;Build 21
;This routine contains generic utilities used when building
;or processing received patient record flag HL7 messages.
;
Q ;no supported direct entry
;
INIT(DGPROT,DGHL) ;Kernel HL7 INIT wrapper
;Called from SNDQRY^DGROHLS
; Supported DBIA #2161: The supported DBIA is used to access the
; VistA HL7 API to initialize the HL7 environ-
; ment variables.
;
; 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=$$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 +$$FIND1^DIC(101,,"B",DGPROT)
;
GETLINK(DGINST) ;retrieve a single link for a given institution
;Called from SNDQRY^DGROHLS
; Supported DBIA #2271: The supported DBIA is used to access the
; VistA HL7 API to retrieve logical links
; given a pointer to the INSTITUTION (#4) file.
;
; Input:
; DGINST - IEN of site in INSTITUTION (#4) file
;
; Output:
; Function Value - HL Logical link on success, 0 on failure
;
N DGLINKS,DGLNK,DGRSLT
;
S DGRSLT=0
I $G(DGINST)>0 D
. D LINK^HLUTIL3(DGINST,.DGLINKS,"I")
. S DGLNK=$O(DGLINKS(0))
. S DGRSLT=$S(DGLNK>0:DGLINKS(DGLNK),1:0)
Q DGRSLT
;
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.
; Called from PARSQRY and PARSORF^DGROHLQ3,
; RCV^DGROHLR, and PARSACK^DGROHLU4
;
; 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
;
STRIPTS(DGSTR) ;Strip trailing spaces from a line of text
;
; Input:
; DGSTR - Text string
;
; Output:
; Function Value - Input text string with trailing spaces removed
;
N SPACE
S SPACE=$C(32)
F Q:$E(DGSTR,$L(DGSTR))'=SPACE S DGSTR=$E(DGSTR,1,$L(DGSTR)-1)
Q DGSTR
;
BLDSEG(DGTYP,DGVAL,DGHL) ;generic segment builder
;Called from QRD^DGROHLQ1, QRF^DGROHLQ2, and MSA and ERR^DGROHLU3
; 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 ;sub-component value
N DGFS ;field separator
N DGCS ;component separator
N DGRS ;repetition separator
N DGSS ;sub-component separator
N DGSEG,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
;Called from QRD^DGROHLQ1, QRF^DGROHLQ2, and MSA and ERR^DGROHLU3
; 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
DGROHLUT ;DJH/AMA - ROM HL7 UTILITIES ; 24 Jun 2003 3:53 PM
+1 ;;5.3;Registration;**533,1015**;Aug 13, 1993;Build 21
+2 ;This routine contains generic utilities used when building
+3 ;or processing received patient record flag HL7 messages.
+4 ;
+5 ;no supported direct entry
QUIT
+6 ;
INIT(DGPROT,DGHL) ;Kernel HL7 INIT wrapper
+1 ;Called from SNDQRY^DGROHLS
+2 ; Supported DBIA #2161: The supported DBIA is used to access the
+3 ; VistA HL7 API to initialize the HL7 environ-
+4 ; ment variables.
+5 ;
+6 ; Input:
+7 ; DGPROT - Event protocol name
+8 ;
+9 ; Output:
+10 ; Function value - HLEID on success;0 on failure
+11 ; DGHL - HL array from INIT^HLFNC2 Kernel call
+12 ;
+13 NEW DGHLEID
+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 ;
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 +$$FIND1^DIC(101,,"B",DGPROT)
+10 ;
GETLINK(DGINST) ;retrieve a single link for a given institution
+1 ;Called from SNDQRY^DGROHLS
+2 ; Supported DBIA #2271: The supported DBIA is used to access the
+3 ; VistA HL7 API to retrieve logical links
+4 ; given a pointer to the INSTITUTION (#4) file.
+5 ;
+6 ; Input:
+7 ; DGINST - IEN of site in INSTITUTION (#4) file
+8 ;
+9 ; Output:
+10 ; Function Value - HL Logical link on success, 0 on failure
+11 ;
+12 NEW DGLINKS,DGLNK,DGRSLT
+13 ;
+14 SET DGRSLT=0
+15 IF $GET(DGINST)>0
Begin DoDot:1
+16 DO LINK^HLUTIL3(DGINST,.DGLINKS,"I")
+17 SET DGLNK=$ORDER(DGLINKS(0))
+18 SET DGRSLT=$SELECT(DGLNK>0:DGLINKS(DGLNK),1:0)
End DoDot:1
+19 QUIT DGRSLT
+20 ;
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 ; Called from PARSQRY and PARSORF^DGROHLQ3,
+5 ; RCV^DGROHLR, and PARSACK^DGROHLU4
+6 ;
+7 ; Input:
+8 ; DGROOT - close root name of work global
+9 ; DGCURR - index of current segment
+10 ; DGFS - HL7 field separator character
+11 ;
+12 ; Output:
+13 ; Function Value - index of the next segment on success, 0 on failure
+14 ; DGFLD - array of segment field values
+15 ;
+16 NEW NXTSEG
+17 ;
+18 SET DGCURR=DGCURR+1
+19 SET NXTSEG=$GET(@DGROOT@(DGCURR,0))
+20 IF NXTSEG]""
Begin DoDot:1
+21 DO GETFLDS(NXTSEG,DGFS,.DGFLD)
End DoDot:1
+22 IF '$TEST
Begin DoDot:1
+23 SET DGCURR=0
End DoDot:1
+24 QUIT DGCURR
+25 ;
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
+3 ;field. An additional subscript node, "TYPE" is created containing
+4 ;the segment 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 ;
STRIPTS(DGSTR) ;Strip trailing spaces from a line of text
+1 ;
+2 ; Input:
+3 ; DGSTR - Text string
+4 ;
+5 ; Output:
+6 ; Function Value - Input text string with trailing spaces removed
+7 ;
+8 NEW SPACE
+9 SET SPACE=$CHAR(32)
+10 FOR
IF $EXTRACT(DGSTR,$LENGTH(DGSTR))'=SPACE
QUIT
SET DGSTR=$EXTRACT(DGSTR,1,$LENGTH(DGSTR)-1)
+11 QUIT DGSTR
+12 ;
BLDSEG(DGTYP,DGVAL,DGHL) ;generic segment builder
+1 ;Called from QRD^DGROHLQ1, QRF^DGROHLQ2, and MSA and ERR^DGROHLU3
+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 ;sub-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,DGSEP
+24 ;
+25 IF ($GET(DGTYP)']"")
QUIT ""
+26 ;
+27 SET DGSEG=DGTYP
+28 SET DGFS=DGHL("FS")
+29 SET DGCS=$EXTRACT(DGHL("ECH"))
+30 SET DGRS=$EXTRACT(DGHL("ECH"),2)
+31 SET DGSS=$EXTRACT(DGHL("ECH"),4)
+32 ;
+33 FOR DGFLD=1:1:$ORDER(DGVAL(""),-1)
Begin DoDot:1
+34 SET DGFLDVAL=$GET(DGVAL(DGFLD))
SET DGSEP=DGFS
+35 DO ADD(DGFLDVAL,DGSEP,.DGSEG)
+36 FOR DGREP=1:1:$ORDER(DGVAL(DGFLD,""),-1)
Begin DoDot:2
+37 SET DGREPVAL=$GET(DGVAL(DGFLD,DGREP))
+38 SET DGSEP=$SELECT(DGREP=1:"",1:DGRS)
+39 DO ADD(DGREPVAL,DGSEP,.DGSEG)
+40 FOR DGCMP=1:1:$ORDER(DGVAL(DGFLD,DGREP,""),-1)
Begin DoDot:3
+41 SET DGCMPVAL=$GET(DGVAL(DGFLD,DGREP,DGCMP))
+42 SET DGSEP=$SELECT(DGCMP=1:"",1:DGCS)
+43 DO ADD(DGCMPVAL,DGSEP,.DGSEG)
+44 FOR DGSUB=1:1:$ORDER(DGVAL(DGFLD,DGREP,DGCMP,""),-1)
Begin DoDot:4
+45 SET DGSUBVAL=$GET(DGVAL(DGFLD,DGREP,DGCMP,DGSUB))
+46 SET DGSEP=$SELECT(DGSUB=1:"",1:DGSS)
+47 DO ADD(DGSUBVAL,DGSEP,.DGSEG)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+48 QUIT DGSEG
+49 ;
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 ;Called from QRD^DGROHLQ1, QRF^DGROHLQ2, and MSA and ERR^DGROHLU3
+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
