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

DGROHLUT.m

Go to the documentation of this file. 
  1. DGROHLUT ;DJH/AMA - ROM HL7 UTILITIES ; 24 Jun 2003  3:53 PM
  1.  ;;5.3;Registration;**533,1015**;Aug 13, 1993;Build 21
  1.  ;This routine contains generic utilities used when building
  1.  ;or processing received patient record flag HL7 messages.
  1.  ;
  1.  Q  ;no supported direct entry
  1.  ;
  1. INIT(DGPROT,DGHL) ;Kernel HL7 INIT wrapper
  1.  ;Called from SNDQRY^DGROHLS
  1.  ;  Supported DBIA #2161:  The supported DBIA is used to access the
  1.  ;                         VistA HL7 API to initialize the HL7 environ-
  1.  ;                         ment variables.
  1.  ;
  1.  ;  Input:
  1.  ;    DGPROT - Event protocol name
  1.  ;
  1.  ;  Output:
  1.  ;    Function value - HLEID on success;0 on failure
  1.  ;    DGHL - HL array from INIT^HLFNC2 Kernel call
  1.  ;
  1.  N DGHLEID
  1.  S DGHLEID=$$HLEID(DGPROT)
  1.  I DGHLEID D
  1.  . D INIT^HLFNC2(DGHLEID,.DGHL)
  1.  . I $O(DGHL(""))="" S DGHLEID=0
  1.  Q DGHLEID
  1.  ;
  1. HLEID(DGPROT) ;return IEN of HL7 protocol
  1.  ;
  1.  ;  Input:  
  1.  ;    DGPROT - Protocol name
  1.  ;
  1.  ;  Output:  
  1.  ;   Function value - IEN of protocol on success, 0 on failure
  1.  ;
  1.  I $G(DGPROT)="" Q 0
  1.  Q +$$FIND1^DIC(101,,"B",DGPROT)
  1.  ;
  1.  ;Called from SNDQRY^DGROHLS
  1.  ;  Supported DBIA #2271:  The supported DBIA is used to access the
  1.  ;                         VistA HL7 API to retrieve logical links
  1.  ;                         given a pointer to the INSTITUTION (#4) file.
  1.  ;
  1.  ;  Input:
  1.  ;    DGINST - IEN of site in INSTITUTION (#4) file
  1.  ;
  1.  ;  Output:
  1.  ;    Function Value - HL Logical link on success, 0 on failure
  1.  ;
  1.  N DGLINKS,DGLNK,DGRSLT
  1.  ;
  1.  S DGRSLT=0
  1.  I $G(DGINST)>0 D
  1.  . D LINK^HLUTIL3(DGINST,.DGLINKS,"I")
  1.  . S DGLNK=$O(DGLINKS(0))
  1.  . S DGRSLT=$S(DGLNK>0:DGLINKS(DGLNK),1:0)
  1.  Q DGRSLT
  1.  ;
  1. NXTSEG(DGROOT,DGCURR,DGFS,DGFLD) ;retrieves next sequential segment
  1.  ;This function retrieves the next segment in the work global, returns
  1.  ;an array of field values and the segment's work global index.  If
  1.  ;the next segment does not exist, then the function returns a zero.
  1.  ;  Called from PARSQRY and PARSORF^DGROHLQ3,
  1.  ;              RCV^DGROHLR, and PARSACK^DGROHLU4
  1.  ;
  1.  ;  Input:
  1.  ;    DGROOT - close root name of work global
  1.  ;    DGCURR - index of current segment
  1.  ;      DGFS - HL7 field separator character
  1.  ;
  1.  ;  Output:
  1.  ;   Function Value  - index of the next segment on success, 0 on failure
  1.  ;             DGFLD - array of segment field values
  1.  ;
  1.  N NXTSEG
  1.  ;
  1.  S DGCURR=DGCURR+1
  1.  S NXTSEG=$G(@DGROOT@(DGCURR,0))
  1.  I NXTSEG]"" D
  1.  . D GETFLDS(NXTSEG,DGFS,.DGFLD)
  1.  E  D
  1.  . S DGCURR=0
  1.  Q DGCURR
  1.  ;
  1. GETFLDS(DGSEG,DGFS,DGFLD) ;retrieve HL7 segment fields into an array
  1.  ;This procedure parses a single HL7 segment and builds an array
  1.  ;subscripted by the field number that contains the data for that
  1.  ;field.  An additional subscript node, "TYPE" is created containing
  1.  ;the segment type.
  1.  ;
  1.  ;  Input:
  1.  ;     DGSEG - HL7 segment to parse
  1.  ;      DGFS - HL7 field separator
  1.  ;
  1.  ;  Output:
  1.  ;    DGFLD - array of segment field values subscripted by field #
  1.  ;            Example: DGFLD(2)="DOE,JOHN"
  1.  ;
  1.  N DGI
  1.  ;
  1.  S DGFLD("TYPE")=$P(DGSEG,DGFS)
  1.  F DGI=2:1:$L(DGSEG,DGFS) D
  1.  . S DGFLD($S(DGFLD("TYPE")="MSH":DGI,1:DGI-1))=$P(DGSEG,DGFS,DGI)
  1.  Q
  1.  ;
  1. STRIPTS(DGSTR) ;Strip trailing spaces from a line of text
  1.  ;
  1.  ;  Input:
  1.  ;    DGSTR - Text string
  1.  ;
  1.  ;  Output:
  1.  ;   Function Value - Input text string with trailing spaces removed
  1.  ;
  1.  N SPACE
  1.  S SPACE=$C(32)
  1.  F  Q:$E(DGSTR,$L(DGSTR))'=SPACE  S DGSTR=$E(DGSTR,1,$L(DGSTR)-1)
  1.  Q DGSTR
  1.  ;
  1. BLDSEG(DGTYP,DGVAL,DGHL) ;generic segment builder
  1.  ;Called from QRD^DGROHLQ1, QRF^DGROHLQ2, and MSA and ERR^DGROHLU3
  1.  ;  Input:
  1.  ;    DGTYP - segment type
  1.  ;    DGVAL - field data array [SUB1:field, SUB2:repetition,
  1.  ;                              SUB3:component, SUB4:sub-component] 
  1.  ;     DGHL - HL7 environment array
  1.  ;
  1.  ;  Output:
  1.  ;    Function Value - Formatted HL7 segment on success, "" on failure
  1.  ;
  1.  N DGCMP     ;component subscript
  1.  N DGCMPVAL  ;component value
  1.  N DGFLD     ;field subscript
  1.  N DGFLDVAL  ;field value
  1.  N DGREP     ;repetition subscript
  1.  N DGREPVAL  ;repetition value
  1.  N DGSUB     ;sub-component subscript
  1.  N DGSUBVAL  ;sub-component value
  1.  N DGFS      ;field separator
  1.  N DGCS      ;component separator
  1.  N DGRS      ;repetition separator
  1.  N DGSS      ;sub-component separator
  1.  N DGSEG,DGSEP
  1.  ;
  1.  Q:($G(DGTYP)']"") ""
  1.  ;
  1.  S DGSEG=DGTYP
  1.  S DGFS=DGHL("FS")
  1.  S DGCS=$E(DGHL("ECH"))
  1.  S DGRS=$E(DGHL("ECH"),2)
  1.  S DGSS=$E(DGHL("ECH"),4)
  1.  ;
  1.  F DGFLD=1:1:$O(DGVAL(""),-1) D
  1.  . S DGFLDVAL=$G(DGVAL(DGFLD)),DGSEP=DGFS
  1.  . D ADD(DGFLDVAL,DGSEP,.DGSEG)
  1.  . F DGREP=1:1:$O(DGVAL(DGFLD,""),-1)  D
  1.  . . S DGREPVAL=$G(DGVAL(DGFLD,DGREP))
  1.  . . S DGSEP=$S(DGREP=1:"",1:DGRS)
  1.  . . D ADD(DGREPVAL,DGSEP,.DGSEG)
  1.  . . F DGCMP=1:1:$O(DGVAL(DGFLD,DGREP,""),-1) D
  1.  . . . S DGCMPVAL=$G(DGVAL(DGFLD,DGREP,DGCMP))
  1.  . . . S DGSEP=$S(DGCMP=1:"",1:DGCS)
  1.  . . . D ADD(DGCMPVAL,DGSEP,.DGSEG)
  1.  . . . F DGSUB=1:1:$O(DGVAL(DGFLD,DGREP,DGCMP,""),-1) D
  1.  . . . . S DGSUBVAL=$G(DGVAL(DGFLD,DGREP,DGCMP,DGSUB))
  1.  . . . . S DGSEP=$S(DGSUB=1:"",1:DGSS)
  1.  . . . . D ADD(DGSUBVAL,DGSEP,.DGSEG)
  1.  Q DGSEG
  1.  ;
  1. ADD(DGVAL,DGSEP,DGSEG) ;append a value onto segment
  1.  ;
  1.  ;  Input:
  1.  ;    DGVAL - value to append
  1.  ;    DGSEP - HL7 separator
  1.  ;
  1.  ;  Output:
  1.  ;    DGSEG - segment passed by reference
  1.  ;
  1.  S DGSEP=$G(DGSEP)
  1.  S DGVAL=$G(DGVAL)
  1.  S DGSEG=DGSEG_DGSEP_DGVAL
  1.  Q
  1.  ;
  1. CKSTR(DGFLDS,DGSTR) ;validate comma-delimited HL7 field string
  1.  ;Called from QRD^DGROHLQ1, QRF^DGROHLQ2, and MSA and ERR^DGROHLU3
  1.  ;  Input:
  1.  ;    DGFLDS - (required) comma delimited string of required fields
  1.  ;    DGSTR - (optional) comma delimited string of fields to include
  1.  ;            in an HL7 segment.
  1.  ;
  1.  ;  Output:
  1.  ;   Function Value - validated string of fields
  1.  ;
  1.  N DGI     ;generic index
  1.  N DGREQ   ;required field
  1.  ;
  1.  Q:($G(DGFLDS)']"") ""
  1.  S DGSTR=$G(DGSTR)
  1.  F DGI=1:1 S DGREQ=$P(DGFLDS,",",DGI) Q:DGREQ=""  D
  1.  . I ","_DGSTR_","'[(","_DGREQ_",") S DGSTR=DGSTR_$S($L(DGSTR)>0:",",1:"")_DGREQ
  1.  Q DGSTR