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

LA7VHLU7.m

Go to the documentation of this file.
LA7VHLU7 ;DALOI/JDB - HL7 utility ;07/07/09  14:19
 ;;5.2;AUTOMATED LAB INSTRUMENTS;**74**;Sep 27, 1994;Build 229
 ;
 Q
 ;
CODSYS(FLD2ARR,RSLT,CODSYS) ;
 ; HL7 Coding System from HL7 Component types
 ; Input
 ; FLD2ARR:<byref> The array that may contain coding system info.
 ;         This array was generated by the FLD2ARR function.
 ;    RSLT:<byref> Array to hold the results
 ;  CODSYS:  <opt> If specified this function will only look
 ;         for the coding system specified.
 ; Output
 ;    RSLT: If a CODSYS was specified and the coding system was
 ;          found then the array will be defined as follows:
 ;              RSLT(1)=1st field of CE
 ;              RSLT(2)=2nd field of CE
 ;              RSLT(3)=3rd field of CE
 ;          If a CODSYS was not specified then the array will
 ;          contain an index of all potential coding systems
 ;              RSLT("B","99LRE",3)=""
 ;              RSLT("B","99VA64",6)=""
 ;          where the 3rd subscript indicates the subscript level
 ;          in the original FLD2ARR array.
 N I,X
 S CODSYS=$G(CODSYS)
 S I=0
 S RSLT=""
 F  S I=$O(FLD2ARR(I)) Q:'I  D  ;
 . Q:I#3  ;code sys is always on 3rd tuplet
 . S X=FLD2ARR(I)
 . I CODSYS'="" I CODSYS=X D  ;
 . . S RSLT=I
 . . S RSLT(1)=$G(FLD2ARR(I-2))
 . . S RSLT(2)=$G(FLD2ARR(I-1))
 . . S RSLT(3)=X
 . I CODSYS="" I X'="" S RSLT("B",X,I)=""
 Q
 ;
FLD2ARR(VAR,FSECH) ;
 ; Places an HL7 field into a local array
 ; Requires LA7FS,LA7CS,LA7ECH
 ; Inputs
 ;   VAR :<byref> The local variable to hold the array
 ;       :VAR should be set to the complete HL7 field's data
 ;       :before calling into this routine.
 ; FSECH :<opt> HL7 Field Sep & Encoding Characters
 ;       :Defaults to LA7FS_LA7ECH
 ; Outputs
 ;   VAR :Will contain the added nodes
 ;       :VAR(1) = component #1
 ;       :VAR(1,1) = subcomponent #1 of component #1 (HL7 escaped)
 ;       : The component is not HL7 unescaped but the subcomponent
 ;       : is HL7 unescaped
 ;
 N I,II,X,X2,Z,HLEC
 S Z=VAR
 S FSECH=$G(FSECH)
 S HLEC=""
 D EC(.HLEC,FSECH)
 F I=1:1:$L(Z,HLEC("CS")) D  ;
 . S (X,X2)=$$COMP(I,Z,HLEC("ECH"))
 . I X2'[HLEC("SS") S X2=$$UNESC^LA7VHLU3(X2,HLEC)
 . S VAR(I)=X2
 . I X[HLEC("SS") F II=1:1:$L(X,HLEC("SS")) D  ;
 . . S X2=$$SUB(II,X,HLEC("ECH"))
 . . S VAR(I,II)=$$UNESC^LA7VHLU3(X2,HLEC)
 . ;
 Q
 ;
VALUE(STR,FSECH) ;
 ; For use with the generated FLD2ARR array
 ; Call VALUE to return the unescaped value of the first subcomponent
 ; ie  X(1)="A~B~C"  X(1,1)=A  X(1,2)=B  X(1,3)=C
 ;     $$VALUE(X(1),"^@{}~") returns "A"
 N X,HLEC
 S FSECH=$G(FSECH)
 S HLEC=""
 D EC(.HLEC,FSECH)
 S X=$P(STR,HLEC("SS"))
 Q $$UNESC^LA7VHLU3(X,HLEC)
 ;
FIELD(FLD,FS) ;
 ; Gets the field from an HL7 segment
 ; Requires the LA7SEG array
 ;
 ; Inputs
 ;  FLD  :The HL7 segment's field number
 ;   FS  :<opt> The HL7 Field Separator character
 ;       : Defaults to LA7FS
 ; Output
 ;   The data for the specified field
 ;
 S FS=$G(FS)
 I FS="" S FS=$G(LA7FS)
 Q $$P^LA7VHLU(.LA7SEG,+$G(FLD)+1,FS)
 ;
COMP(POS,STR,ECH) ;
 ; Gets the component from an HL7 field
 ;
 ; Inputs
 ; POS  :The HL7 component's position number
 ; STR  :The string that holds the complete HL7 field data
 ;      :for this particular component
 ; ECH  :<opt> The HL7 Encoding string
 ;      :Defaults to LA7ECH
 ; Output
 ;    The data for the specified component
 ;
 N X
 S ECH=$G(ECH)
 I ECH="" S ECH=$G(LA7ECH)
 S X(0)=STR
 Q $$P^LA7VHLU(.X,POS,$E(ECH,1,1))
 ;
SUB(POS,STR,ECH) ;
 ; Gets the subcomponent from an HL7 component
 ;
 ; Inputs
 ; POS  :The HL7 subcomponent's position number
 ; STR  :The string that holds the complete HL7 component data
 ;      :for this particular subcomponent
 ; ECH  :<opt> The HL7 Encoding string
 ;      : Defaults to LA7ECH
 ; Output
 ;    The data for the specified subcomponent
 N X
 S ECH=$G(ECH)
 I ECH="" S ECH=$G(LA7ECH)
 S X(0)=STR
 Q $$P^LA7VHLU(.X,POS,$E(ECH,4))
 ;
EC(VAR,FSEC) ;
 ; Builds the HL7 Field Sep and Encoding Characters array
 ;
 ; Inputs
 ;   VAR :<byref> <output>
 ;  FSEC : <opt> The HL7 Field Separator and Encoding Characters
 ;       : Uses LA7FS and LA7ECH if not defined
 ; Outputs
 ;   VAR : VAR=FSEC   VAR("FS")=Field Separator
 ;       : VAR("CS")=Component Sep  VAR("SS")=Subcomponent Sep
 ;       : VAR("ECH")=Encoding Chars
 ;
 S FSEC=$G(FSEC)
 I FSEC="" S FSEC=$G(LA7FS)_$G(LA7ECH)
 S VAR=FSEC
 S VAR("FS")=$E(FSEC,1)
 S VAR("ECH")=$E(FSEC,2,5)
 S VAR("CS")=$E(FSEC,2,2)
 S VAR("RS")=$E(FSEC,3,3)
 S VAR("EC")=$E(FSEC,4,4)
 S VAR("SS")=$E(FSEC,5,5)
 Q
 ;
 ;
DBSTORE(FLD2ARR,API,VERS,R6247,R6248,OUT) ;
 ;
 ; Inputs
 ; FLD2ARR <byref>
 ;     API : <opt>
 ;    VERS : Version number
 ;   R6247 : <opt> File #62.47 IEN (Concept)
 ;   R6248 : <opt> File #62.48 IEN
 ;     OUT : <opt> <byref> The 3rd piece of the tuplet used that
 ;         : the DBSTORE was found for.
 ; Output
 ;   The corresponding API's output (data or null) or -99 if nothing
 ;   Also see variable OUT above.
 ;   ie: OBX3="123\GARDIA\SCT" and a valid DBSTORE was found
 ;   then OUT=3
 ;
 N DBSTORE,I,CODE,STR,CODESYS,X,X2
 S API=+$G(API,1)
 S VERS=$G(VERS,1)
 S R6247=$G(R6247)
 S R6248=+$G(R6248)
 I R6248<1 S R6248=$G(LA76248)
 K OUT
 F I=3:3:$O(FLD2ARR("A"),-1) D  Q:$D(DBSTORE)  ;
 . S CODE=$G(FLD2ARR(I-2))
 . S STR=$G(FLD2ARR(I-1))
 . S CODESYS=$G(FLD2ARR(I))
 . Q:CODESYS=""  Q:CODE=""  ;
 . I API=1 D  ;
 . . N I
 . . S X=$$HL2LAH^LA7VHLU6(CODE,STR,CODESYS,VERS,R6248,$G(LA7SS))
 . . S X2=+$P(X,"^",1)
 . . I X2=-1!(X2>0) S DBSTORE=X
 . I API=2 D  ;
 . . N I
 . . S X=$$HL2VA^LA7VHLU6(CODE,STR,CODESYS,VERS,R6247,R6248)
 . . S X2=+$P(X,"^",1)
 . . I X2=-1!(X2>0) S DBSTORE=X
 . I $D(DBSTORE) S OUT=I
 I '$D(DBSTORE) S DBSTORE=-99
 Q DBSTORE
 ;
REPT2ARR(STR,FSEC,OUT) ;
 ; Puts an HL7 Repeating field into an array.
 ; The array nodes are also HL7 decoded.
 ; Input
 ;   STR : Input text that may contain the HL7 repeat character
 ;  FSEC : HL7 Field Separator and Encoding Characters string
 ;   OUT :<byref> The array that holds the split string
 ; Output
 ;       : see OUT variable above
 N I,RPT,J
 S RPT=$E(FSEC,3)
 S J=0
 I $D(OUT)>9 S J=+$O(OUT("A"),-1) ;find next available subscr
 F I=1:1:$L(STR,RPT) S OUT(I+J)=$P(STR,RPT,I) S OUT(I+J)=$$UNESC^LA7VHLU3(OUT(I+J),FSEC)
 Q
 ;
SEG2FLDS(IN,SUBSCR,FS) ;
 ;  Inputs
 ;      IN        Closed root for input data ie ^TMP($J,"I",0)
 ;                Each node is sequentially numbered
 ;  SUBSCR <opt>  Subscript name to use in ^TMP global for output
 ;                Defaults to "S2F"
 ;                Output = ^TMP($$RTNNM-"S2F",$J,SUBSCR)
 ;                This setting allows using the utility numerous
 ;                times in the same routine (ie recursive entry)
 ;      FS <opt>  Field Separator (default=^)
 ;                Useful when separating HL7 coded elements,etc.
 ;
 ; Converts only one HL7 segment at a time.  Puts the
 ; segment into an ordered array where the field number is the
 ; primary subscript.  If the field is bigger than GBLSIZE then
 ; the field will continue on the next subscript
 ; HLSEG(1)="OBR^2^3^4^5^6^7^8^9^10^11^"
 ; HLSEG(2)="12^13^14^This field is longer than GBLSIZE^16^17^18^19^"
 ; HLSEG(3)="20^21^22^23^24^25^26^27^28^29^30"
 ;
 ; OUT(1,0)=OBR
 ; OUT(2,0)=2
 ; ...
 ; OUT(15,0)=first 245 characters
 ; OUT(15,1)=next 245 characters
 ; OUT(15,2)=and so on....
 ; ...
 ;
 N SUB,DATA,SEGNUM,FLDNUM,FLD,D2,D3,SEQ,STR
 N GBLSIZE,CONTFLD,ONODE,INODE,NODE
 N OUT
 S GBLSIZE=245
 S FS=$G(FS)
 S IN=$G(IN)
 S SUBSCR=$G(SUBSCR)
 I IN="" W !,"In not specified" Q
 I SUBSCR="" S SUBSCR="S2F"
 I $E(IN,$L(IN),$L(IN))'=")" W !,"Input not closed array" Q
 S SUB=0
 S SEGNUM=0
 S FLDNUM=0
 S SEQ=0
 S ONODE="^TMP("""_$$RTNNM()_"-S2F"","_$J_","""_SUBSCR_""")"
 K @ONODE ;kill output array
 S ONODE=$E(ONODE,1,$L(ONODE)-1) ;;strip trailing )
 S INODE=$E(IN,1,$L(IN)-1)
 S INODE=INODE_",SUB)"
 S SUB=0
 F  S SUB=$O(@INODE) Q:SUB=""  D  ;
 . S DATA=@INODE
 . I FS="" S FS=$E(DATA,4,4)
 . F FLD=1:1:$L(DATA,FS) D  ;
 . . S CONTFLD=0
 . . S D2=$P(DATA,FS,FLD)
 . . ; handle field continuance
 . . I (FLD=1&(FLDNUM>1))  D  ;
 . . . S CONTFLD=1
 . . . S NODE=ONODE_","_FLDNUM_","_SEQ_")"
 . . . S D3=$G(@NODE)
 . . I 'CONTFLD D  ;
 . . . S FLDNUM=FLDNUM+1 S SEQ=0
 . . . S NODE=ONODE_","_FLDNUM_","_SEQ_")"
 . . . S @NODE=D2
 . . ;
 . . I CONTFLD D  ;
 . . . N I,X,CNT,STR
 . . . S STR=D3_D2
 . . . I $L(STR)'>GBLSIZE D  Q  ;
 . . . . S NODE=ONODE_","_FLDNUM_","_SEQ_")"
 . . . . S @NODE=STR
 . . . ;
 . . . ; Split apart and store if $L(STR)>GBLSIZE
 . . . S X=$L(STR)\GBLSIZE S:$P(X,".",2)>0 X=X+1
 . . . S CNT=$P(X,".",1)
 . . . F I=1:1:CNT D  ;
 . . . . I I=1 S NODE=ONODE_","_FLDNUM_","_SEQ_")"
 . . . . I I>1 S SEQ=SEQ+1 S NODE=ONODE_","_FLDNUM_","_SEQ_")"
 . . . . S X=I*GBLSIZE
 . . . . S @NODE=$E(STR,(X-GBLSIZE)+1,X)
 . . . ;
 . . ;
 . ;
 ;
 Q
 ;
RTNNM() ;
 ; Returns this routine's name (used for namespacing)
 Q $T(+0)