| [613] | 1 | DGQEHLUT ;ALB/RPM - VIC REPLACEMENT HL7 UTILITIES ; 10/6/03
|
|---|
| 2 | ;;5.3;Registration;**571**;Aug 13, 1993
|
|---|
| 3 | ;This routine contains generic utilities used when building
|
|---|
| 4 | ;or processing received VIC REPLACEMENT HL7 messages.
|
|---|
| 5 | ;
|
|---|
| 6 | Q ;no supported direct entry
|
|---|
| 7 | ;
|
|---|
| 8 | INIT(DGPROT,DGHL) ;Kernel HL7 INIT wrapper
|
|---|
| 9 | ;
|
|---|
| 10 | ; Supported Reference:
|
|---|
| 11 | ; DBIA #2161: INIT^HLFNC2
|
|---|
| 12 | ;
|
|---|
| 13 | ; Input:
|
|---|
| 14 | ; DGPROT - Event protocol name
|
|---|
| 15 | ;
|
|---|
| 16 | ; Output:
|
|---|
| 17 | ; Function value - HLEID on success;0 on failure
|
|---|
| 18 | ; DGHL - HL array from INIT^HLFNC2 Kernel call
|
|---|
| 19 | ;
|
|---|
| 20 | N DGHLEID
|
|---|
| 21 | S DGHLEID=0
|
|---|
| 22 | S DGHLEID=$$HLEID(DGPROT)
|
|---|
| 23 | I DGHLEID D
|
|---|
| 24 | . D INIT^HLFNC2(DGHLEID,.DGHL)
|
|---|
| 25 | . I $O(DGHL(""))="" S DGHLEID=0
|
|---|
| 26 | Q DGHLEID
|
|---|
| 27 | ;
|
|---|
| 28 | ;
|
|---|
| 29 | HLEID(DGPROT) ;return IEN of HL7 protocol
|
|---|
| 30 | ;
|
|---|
| 31 | ; Input:
|
|---|
| 32 | ; DGPROT - Protocol name
|
|---|
| 33 | ;
|
|---|
| 34 | ; Output:
|
|---|
| 35 | ; Function value - IEN of protocol on success, 0 on failure
|
|---|
| 36 | ;
|
|---|
| 37 | I $G(DGPROT)="" Q 0
|
|---|
| 38 | Q +$O(^ORD(101,"B",DGPROT,0))
|
|---|
| 39 | ;
|
|---|
| 40 | ;
|
|---|
| 41 | NXTSEG(DGROOT,DGCURR,DGFS,DGFLD) ;retrieves next sequential segment
|
|---|
| 42 | ; This function retrieves the next segment in the work global, returns
|
|---|
| 43 | ; an array of field values and the segment's work global index. If
|
|---|
| 44 | ; the next segment does not exist, then the function returns a zero.
|
|---|
| 45 | ;
|
|---|
| 46 | ; Input:
|
|---|
| 47 | ; DGROOT - close root name of work global
|
|---|
| 48 | ; DGCURR - index of current segment
|
|---|
| 49 | ; DGFS - HL7 field separator character
|
|---|
| 50 | ;
|
|---|
| 51 | ; Output:
|
|---|
| 52 | ; Function Value - index of the next segment on success, 0 on failure
|
|---|
| 53 | ; DGFLD - array of segment field values
|
|---|
| 54 | ;
|
|---|
| 55 | N NXTSEG
|
|---|
| 56 | ;
|
|---|
| 57 | S DGCURR=DGCURR+1
|
|---|
| 58 | S NXTSEG=$G(@DGROOT@(DGCURR,0))
|
|---|
| 59 | I NXTSEG]"" D
|
|---|
| 60 | . D GETFLDS(NXTSEG,DGFS,.DGFLD)
|
|---|
| 61 | E D
|
|---|
| 62 | . S DGCURR=0
|
|---|
| 63 | Q DGCURR
|
|---|
| 64 | ;
|
|---|
| 65 | ;
|
|---|
| 66 | GETFLDS(DGSEG,DGFS,DGFLD) ;retrieve HL7 segment fields into an array
|
|---|
| 67 | ;This procedure parses a single HL7 segment and builds an array
|
|---|
| 68 | ;subscripted by the field number that contains the data for that field.
|
|---|
| 69 | ;An additional subscript node, "TYPE" is created containing the segment
|
|---|
| 70 | ;type.
|
|---|
| 71 | ;
|
|---|
| 72 | ; Input:
|
|---|
| 73 | ; DGSEG - HL7 segment to parse
|
|---|
| 74 | ; DGFS - HL7 field separator
|
|---|
| 75 | ;
|
|---|
| 76 | ; Output:
|
|---|
| 77 | ; DGFLD - array of segment field values subscripted by field #
|
|---|
| 78 | ; Example: DGFLD(2)="DOE,JOHN"
|
|---|
| 79 | ;
|
|---|
| 80 | N DGI
|
|---|
| 81 | ;
|
|---|
| 82 | S DGFLD("TYPE")=$P(DGSEG,DGFS)
|
|---|
| 83 | F DGI=2:1:$L(DGSEG,DGFS) D
|
|---|
| 84 | . S DGFLD($S(DGFLD("TYPE")="MSH":DGI,1:DGI-1))=$P(DGSEG,DGFS,DGI)
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | ;
|
|---|
| 88 | BLDSEG(DGTYP,DGVAL,DGHL) ;generic segment builder
|
|---|
| 89 | ;
|
|---|
| 90 | ; Input:
|
|---|
| 91 | ; DGTYP - segment type
|
|---|
| 92 | ; DGVAL - field data array [SUB1:field, SUB2:repetition,
|
|---|
| 93 | ; SUB3:component, SUB4:sub-component]
|
|---|
| 94 | ; DGHL - HL7 environment array
|
|---|
| 95 | ;
|
|---|
| 96 | ; Output:
|
|---|
| 97 | ; Function Value - Formatted HL7 segment on success, "" on failure
|
|---|
| 98 | ;
|
|---|
| 99 | N DGCMP ;component subscript
|
|---|
| 100 | N DGCMPVAL ;component value
|
|---|
| 101 | N DGFLD ;field subscript
|
|---|
| 102 | N DGFLDVAL ;field value
|
|---|
| 103 | N DGREP ;repetition subscript
|
|---|
| 104 | N DGREPVAL ;repetition value
|
|---|
| 105 | N DGSUB ;sub-component subscript
|
|---|
| 106 | N DGSUBVAL ;suc-component value
|
|---|
| 107 | N DGFS ;field separator
|
|---|
| 108 | N DGCS ;component separator
|
|---|
| 109 | N DGRS ;repetition separator
|
|---|
| 110 | N DGSS ;sub-component separator
|
|---|
| 111 | N DGSEG
|
|---|
| 112 | N DGSEP
|
|---|
| 113 | ;
|
|---|
| 114 | Q:($G(DGTYP)']"") ""
|
|---|
| 115 | ;
|
|---|
| 116 | S DGSEG=DGTYP
|
|---|
| 117 | S DGFS=DGHL("FS")
|
|---|
| 118 | S DGCS=$E(DGHL("ECH"))
|
|---|
| 119 | S DGRS=$E(DGHL("ECH"),2)
|
|---|
| 120 | S DGSS=$E(DGHL("ECH"),4)
|
|---|
| 121 | ;
|
|---|
| 122 | F DGFLD=1:1:$O(DGVAL(""),-1) D
|
|---|
| 123 | . S DGFLDVAL=$G(DGVAL(DGFLD)),DGSEP=DGFS
|
|---|
| 124 | . D ADD(DGFLDVAL,DGSEP,.DGSEG)
|
|---|
| 125 | . F DGREP=1:1:$O(DGVAL(DGFLD,""),-1) D
|
|---|
| 126 | . . S DGREPVAL=$G(DGVAL(DGFLD,DGREP))
|
|---|
| 127 | . . S DGSEP=$S(DGREP=1:"",1:DGRS)
|
|---|
| 128 | . . D ADD(DGREPVAL,DGSEP,.DGSEG)
|
|---|
| 129 | . . F DGCMP=1:1:$O(DGVAL(DGFLD,DGREP,""),-1) D
|
|---|
| 130 | . . . S DGCMPVAL=$G(DGVAL(DGFLD,DGREP,DGCMP))
|
|---|
| 131 | . . . S DGSEP=$S(DGCMP=1:"",1:DGCS)
|
|---|
| 132 | . . . D ADD(DGCMPVAL,DGSEP,.DGSEG)
|
|---|
| 133 | . . . F DGSUB=1:1:$O(DGVAL(DGFLD,DGREP,DGCMP,""),-1) D
|
|---|
| 134 | . . . . S DGSUBVAL=$G(DGVAL(DGFLD,DGREP,DGCMP,DGSUB))
|
|---|
| 135 | . . . . S DGSEP=$S(DGSUB=1:"",1:DGSS)
|
|---|
| 136 | . . . . D ADD(DGSUBVAL,DGSEP,.DGSEG)
|
|---|
| 137 | Q DGSEG
|
|---|
| 138 | ;
|
|---|
| 139 | ;
|
|---|
| 140 | ADD(DGVAL,DGSEP,DGSEG) ;append a value onto segment
|
|---|
| 141 | ;
|
|---|
| 142 | ; Input:
|
|---|
| 143 | ; DGVAL - value to append
|
|---|
| 144 | ; DGSEP - HL7 separator
|
|---|
| 145 | ;
|
|---|
| 146 | ; Output:
|
|---|
| 147 | ; DGSEG - segment passed by reference
|
|---|
| 148 | ;
|
|---|
| 149 | S DGSEP=$G(DGSEP)
|
|---|
| 150 | S DGVAL=$G(DGVAL)
|
|---|
| 151 | S DGSEG=DGSEG_DGSEP_DGVAL
|
|---|
| 152 | Q
|
|---|
| 153 | ;
|
|---|
| 154 | CKSTR(DGFLDS,DGSTR) ;validate comma-delimited HL7 field string
|
|---|
| 155 | ;
|
|---|
| 156 | ; Input:
|
|---|
| 157 | ; DGFLDS - (required) comma delimited string of required fields
|
|---|
| 158 | ; DGSTR - (optional) comma delimited string of fields to include
|
|---|
| 159 | ; in an HL7 segment.
|
|---|
| 160 | ;
|
|---|
| 161 | ; Output:
|
|---|
| 162 | ; Function Value - validated string of fields
|
|---|
| 163 | ;
|
|---|
| 164 | N DGI ;generic index
|
|---|
| 165 | N DGREQ ;required field
|
|---|
| 166 | ;
|
|---|
| 167 | Q:($G(DGFLDS)']"") ""
|
|---|
| 168 | S DGSTR=$G(DGSTR)
|
|---|
| 169 | F DGI=1:1 S DGREQ=$P(DGFLDS,",",DGI) Q:DGREQ="" D
|
|---|
| 170 | . I ","_DGSTR_","'[(","_DGREQ_",") S DGSTR=DGSTR_$S($L(DGSTR)>0:",",1:"")_DGREQ
|
|---|
| 171 | Q DGSTR
|
|---|
