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