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

LA7VHLU3.m

Go to the documentation of this file.
  1. LA7VHLU3 ;DALOI/JMC - HL7 Segment Utility ;Feb 13, 2009
  1. ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,68,74**;Sep 27, 1994;Build 229
  1. ;
  1. Q
  1. ;
  1. NTE(LA7ARRAY,LA7TXT,LA7TYP,LA7FS,LA7ECH,LA7NTESN,LA7CMTYP,LA7FMT) ; Build NTE segment - notes and comments
  1. ; Call with LA7ARRAY = array to return NTE segment, pass by reference
  1. ; LA7TXT = text to send (by value if format=0, by reference if format>0)
  1. ; LA7TYP = source of comment - HL table 0105 Default to L (ancilliary/filler)
  1. ; LA7FS = HL field separator
  1. ; LA7ECH = HL encoding characters
  1. ; LA7NTESN = segment SET ID (pass by reference)
  1. ; LA7CMTYP = comment type code (HL table 0364)
  1. ; LA7FMT = format of text (0=single, 1=multi-line formatted text, 2=multi-line repetition)
  1. ;
  1. N LA7CTYPE,LA7NTE,LA7TEXT
  1. ;
  1. S LA7FS=$G(LA7FS),LA7TXT=$G(LA7TXT),(LA7CTYPE,LA7TEXT)="",LA7FMT=$G(LA7FMT)
  1. ;
  1. ; Remove leading "~" from comments and escape encode text
  1. I 'LA7FMT D
  1. . I $E(LA7TXT,1)="~" S LA7TXT=$$TRIM^XLFSTR(LA7TXT,"L","~")
  1. . S LA7TXT=$$TRIM^XLFSTR(LA7TXT,"R"," ")
  1. . S LA7TEXT=$$CHKDATA^LA7VHLU3(LA7TXT,LA7FS_LA7ECH)
  1. ;
  1. I LA7FMT>0 D
  1. . N LA7I,LA7J
  1. . S (LA7I,LA7J)=0
  1. . F S LA7I=$O(LA7TXT(LA7I)) Q:'LA7I D
  1. . . S LA7J=LA7J+1
  1. . . I $E(LA7TXT(LA7I),1)="~" S LA7TXT(LA7I)=$$TRIM^XLFSTR(LA7TXT(LA7I),"L","~")
  1. . . S LA7TXT(LA7I)=$$TRIM^XLFSTR(LA7TXT(LA7I),"R"," ")
  1. . . S LA7TXT(LA7I)=$$CHKDATA^LA7VHLU3(LA7TXT(LA7I),LA7FS_LA7ECH)
  1. . . I LA7FMT=1 S LA7TEXT(LA7I)=LA7TEXT_$S(LA7J>1:$E(LA7ECH,3)_".br"_$E(LA7ECH,3),1:"")_LA7TXT(LA7I) Q
  1. . . I LA7FMT=2 S LA7TEXT(LA7I)=LA7TEXT_$S(LA7J>1:$E(LA7ECH,2),1:"")_LA7TXT(LA7I) Q
  1. ;
  1. ; Update segment SET ID
  1. S LA7NTESN=$G(LA7NTESN)+1
  1. ;
  1. ; Default source of comment if undefined
  1. I $G(LA7TYP)="" S LA7TYP="L"
  1. ;
  1. ; Encode HL7 table 0364 with comment type
  1. ; If no type passed then default to REmark
  1. ; If 'code' not found in table then send 'code' in text (2nd component).
  1. I $G(LA7CMTYP)="" S LA7CMTYP="RE"
  1. I '$D(^TMP($J,"HL70364")) D HL70364
  1. S LA7X=$G(^TMP($J,"HL70364",LA7CMTYP))
  1. I LA7X="" S $P(LA7CTYPE,$E(LA7ECH,1),2)=$$CHKDATA^LA7VHLU3(LA7CMTYP,LA7FS_LA7ECH)
  1. E D
  1. . S LA7CTYPE=LA7CMTYP
  1. . S $P(LA7CTYPE,$E(LA7ECH,1),2)=$$CHKDATA^LA7VHLU3(LA7X,LA7FS_LA7ECH)
  1. . S $P(LA7CTYPE,$E(LA7ECH,1),3)="HL70364"
  1. ;
  1. S LA7NTE(0)="NTE"
  1. S LA7NTE(1)=LA7NTESN
  1. S LA7NTE(2)=LA7TYP
  1. M LA7NTE(3)=LA7TEXT
  1. S LA7NTE(4)=LA7CTYPE
  1. ;
  1. D BUILDSEG^LA7VHLU(.LA7NTE,.LA7ARRAY,LA7FS)
  1. ;
  1. Q
  1. ;
  1. ;
  1. CHKDATA(LA7IN,LA7CH) ; Check data to be built into an HL7 field for characters that
  1. ; conflict with encoding characters. Convert conflicting character using HL7 escape encoding.
  1. ;
  1. ; Call with LA7IN = data to be checked
  1. ; LA7CH = HL7 delimiters to check for
  1. ;
  1. ; Returns LA7OUT - checked data, converted if appropriate
  1. ;
  1. N J,LA7ESC,LA7LEN,LA7OUT,X
  1. ;
  1. S LA7IN=$G(LA7IN),LA7CH=$G(LA7CH),LA7OUT=""
  1. ;
  1. I LA7IN=""!(LA7CH="") Q LA7OUT
  1. ;
  1. ; Build array of encoding characters to check
  1. S LA7LEN=$L(LA7CH),LA7ESC=$E(LA7CH,4)
  1. F J=1:1:LA7LEN S LA7CH($E(LA7CH,J))=$E("FSRET",J)
  1. ;
  1. ; Check each character and convert if appropriate
  1. F J=1:1:$L(LA7IN) D
  1. . S X=$E(LA7IN,J)
  1. . I $D(LA7CH(X)) S X=LA7ESC_LA7CH(X)_LA7ESC
  1. . S LA7OUT=LA7OUT_X
  1. ;
  1. Q LA7OUT
  1. ;
  1. ;
  1. CNVFLD(LA7IN,LA7ECH1,LA7ECH2) ; Convert an encoded HL7 segment/field from one encoding scheme to another
  1. ; Call with LA7IN = data to be converted
  1. ; LA7ECH1 = delimiters of input
  1. ; LA7ECH2 = delimiters of output
  1. ;
  1. ; Returns LA7OUT = segment/field converted to new encoding scheme
  1. ;
  1. N J,LA7ECH,LA7ESC,LA7OUT,X
  1. ;
  1. S LA7IN=$G(LA7IN),LA7ECH1=$G(LA7ECH1),LA7ECH2=$G(LA7ECH2),LA7OUT=""
  1. ;
  1. I LA7IN=""!(LA7ECH1="")!(LA7ECH2="") Q LA7OUT
  1. ;
  1. ; Abort if input encoding length greater than output
  1. I $L(LA7ECH1)>$L(LA7ECH2) Q LA7OUT
  1. ;
  1. ; If same then return input as output
  1. I LA7ECH1=LA7ECH2 Q LA7IN
  1. ;
  1. S LA7ESC=$E(LA7ECH2,4)
  1. ;
  1. ; Build array to convert source encoding to target encoding
  1. F J=1:1:$L(LA7ECH1) S LA7ECH($E(LA7ECH1,J))=$E(LA7ECH2,J)
  1. ;
  1. ; Check each character and convert if appropriate
  1. ; If source conflicts with target encoding character then convert to escape encoding
  1. ; If match on source encoding character - convert to new encoding
  1. F J=1:1:$L(LA7IN) D
  1. . S X=$E(LA7IN,J)
  1. . I '$D(LA7ECH(X)),LA7ECH2[X S X=LA7ESC_$E("FSRET",($F(LA7ECH2,X)-1))_LA7ESC
  1. . I $D(LA7ECH(X)) S X=LA7ECH(X)
  1. . S LA7OUT=LA7OUT_X
  1. ;
  1. Q LA7OUT
  1. ;
  1. ;
  1. UNESC(LA7X,LA7CH) ; Unescape data using HL7 escape encoding
  1. ; Call with LA7X = string to decode
  1. ; LA7CH = HL7 delimiters (both field separator & encoding characters)
  1. ;
  1. ; Returns string of unencoded data.
  1. ;
  1. N J,LA7ESC
  1. ;
  1. ; If data does not contain escape encoding then return input string as output
  1. S LA7ESC=$E(LA7CH,4)
  1. I LA7X'[LA7ESC Q LA7X
  1. ;
  1. ; Build array of encoding characters to replace
  1. F J=1:1:$L(LA7CH) S LA7CH(LA7ESC_$E("FSRET",J)_LA7ESC)=$E(LA7CH,J)
  1. ;
  1. Q $$REPLACE^XLFSTR(LA7X,.LA7CH)
  1. ;
  1. ;
  1. UNESCFT(LA7X,LA7CH,LA7Y) ; Unescape formatted text data using HL7 escape encoding
  1. ; Call with LA7X = array to decode (pass by reference)
  1. ; LA7CH = HL7 delimiters (both field separator & encoding characters)
  1. ;
  1. ; Returns LA7Y = array of unencoded data.
  1. ;
  1. N J,K,LA7ESC,LA7I,LA7Z,SAVX,SAVY,Z
  1. ;
  1. S J=0,LA7ESC=$E(LA7CH,$L(LA7CH)-1),(LA7I,SAVX,SAVY)=""
  1. F S LA7I=$O(LA7X(LA7I)) Q:LA7I="" D
  1. . S J=J+1
  1. . I LA7X(LA7I)'[LA7ESC,SAVY="" S LA7Y(J,0)=LA7X(LA7I) Q
  1. . F K=1:1:$L(LA7X(LA7I)) D
  1. . . S Z=$E(LA7X(LA7I),K)
  1. . . I Z=LA7ESC D Q
  1. . . . I SAVY="" S SAVY=Z Q
  1. . . . S SAVY=SAVY_Z
  1. . . . I $P(SAVY,LA7ESC,2)=".br" S LA7Y(J,0)=$S(SAVX]"":SAVX,1:" "),SAVX="",J=J+1
  1. . . . I $E(SAVY,2)'="." S SAVX=SAVX_$$UNESC(SAVY,LA7CH)
  1. . . . S SAVY=""
  1. . . I SAVY]"" S SAVY=SAVY_Z Q
  1. . . S SAVX=SAVX_Z
  1. . S LA7Y(J,0)=SAVX,SAVX=""
  1. S LA7Y=J
  1. ;
  1. Q
  1. ;
  1. ;
  1. HL70364 ; Build HL7 table 0364 - Comment Type
  1. ;
  1. S ^TMP($J,"HL70364","PI")="Patient Instructions"
  1. S ^TMP($J,"HL70364","AI")="Ancillary Instructions"
  1. S ^TMP($J,"HL70364","GI")="General Instructions"
  1. S ^TMP($J,"HL70364","1R")="Primary Reason"
  1. S ^TMP($J,"HL70364","2R")="Secondary Reason"
  1. S ^TMP($J,"HL70364","GR")="General Reason"
  1. S ^TMP($J,"HL70364","RE")="Remark"
  1. S ^TMP($J,"HL70364","DR")="Duplicate/Interaction Reason"
  1. S ^TMP($J,"HL70364","VA-LR001")="Order Comment"
  1. S ^TMP($J,"HL70364","VA-LR002")="Result Comment"
  1. S ^TMP($J,"HL70364","VA-LR003")="Result Interpretation"
  1. S ^TMP($J,"HL70364","VA-LRMI001")="Comment on Specimen (#.99)"
  1. S ^TMP($J,"HL70364","VA-LRMI010")="Bact Rpt Remark (#13)"
  1. S ^TMP($J,"HL70364","VA-LRMI011")="Preliminary Bact Comment (#1)"
  1. S ^TMP($J,"HL70364","VA-LRMI012")="Bacteriology Test(s) (#1.5)"
  1. S ^TMP($J,"HL70364","VA-LRMI013")="Bacteriology Smear/Prep (#11.7)"
  1. S ^TMP($J,"HL70364","VA-LRMI020")="Parasite Rpt Remark (#17)"
  1. S ^TMP($J,"HL70364","VA-LRMI021")="Preliminary Parasite Comment (#16.5)"
  1. S ^TMP($J,"HL70364","VA-LRMI022")="Parasite Test(s) (16.4)"
  1. S ^TMP($J,"HL70364","VA-LRMI023")="Parasitology Smear/Prep (#15.51)"
  1. S ^TMP($J,"HL70364","VA-LRMI030")="Mycology RPT Remark (#21)"
  1. S ^TMP($J,"HL70364","VA-LRMI031")="Preliminary Mycology Comment (#20.5)"
  1. S ^TMP($J,"HL70364","VA-LRMI032")="Mycology Test(s) (#20.4)"
  1. S ^TMP($J,"HL70364","VA-LRMI033")="Mycology Smear/Prep (#19.6)"
  1. S ^TMP($J,"HL70364","VA-LRMI040")="TB Rpt Remark (#27)"
  1. S ^TMP($J,"HL70364","VA-LRMI041")="Preliminary TB Comment (#26.5)"
  1. S ^TMP($J,"HL70364","VA-LRMI042")="TB Test(s) (#26.4)"
  1. S ^TMP($J,"HL70364","VA-LRMI050")="Virology Rpt Remark (#37)"
  1. S ^TMP($J,"HL70364","VA-LRMI051")="Preliminary Virology Comment (#36.5)"
  1. S ^TMP($J,"HL70364","VA-LRMI052")="Virology Test (#36.4)"
  1. Q
  1. ;
  1. ;
  1. PCENC(LRDFN,LRSS,LRIDT) ; Find PCE encounter for an entry in file #63
  1. ;
  1. ; Call with LRDFN = entry in file #63
  1. ; LRSS = file #63 subscript
  1. ; LRIDT = inverse date/time of specimen in file #63
  1. ;
  1. ; Returns LA7ENC = related PCE encounter
  1. ;
  1. N LA7ENC,LA7UID,LA7X,LA7Y,LRODT,LRSN
  1. S LA7ENC="",LA7UID=$P($G(^LR(LRDFN,LRSS,LRIDT,"ORU")),"^")
  1. I LA7UID'="" D
  1. . S LA7X=$$CHECKUID^LRWU4(LA7UID)
  1. . I 'LA7X Q
  1. . S LA7Y=$G(^LRO(68,$P(LA7X,"^",2),1,$P(LA7X,"^",3),1,$P(LA7X,"^",4),0))
  1. . S LRODT=+$P(LA7Y,"^",4),LRSN=+$P(LA7Y,"^",5)
  1. . I $P(LA7Y,"^",2)=2,LRODT,LRSN S LA7ENC=$G(^LRO(69,LRODT,1,LRSN,"PCE"))
  1. ;
  1. Q LA7ENC
  1. ;
  1. ;
  1. SDENC(LA7PCE) ; Find SD Outpatient Encounter for an entry in file #63
  1. ;
  1. ; Call with LA7PCE = PCE encounters from file #69
  1. ;
  1. ; Returns LA7ENC = related SD encounter
  1. ;
  1. N LA7ENC,LA7X,LA7Y,LA7Z
  1. ;
  1. S LA7ENC=""
  1. F LA7I=1:1 S LA7X=$P(LA7PCE,";",LA7I) Q:LA7X="" D Q:LA7ENC'=""
  1. . K LA7Y
  1. . D LISTVST^SDOERPC(.LA7Y,LA7X)
  1. . S LA7Z=$Q(@LA7Y)
  1. . I $QS(LA7Z,1)="SD ENCOUNTER LIST",$QS(LA7Z,2)=$J S LA7ENC=$QS(LA7Z,3)
  1. . K @LA7Y
  1. ;
  1. Q LA7ENC