- LA7VHLU3 ;DALOI/JMC - HL7 Segment Utility ;Feb 13, 2009
- ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,68,74**;Sep 27, 1994;Build 229
- ;
- Q
- ;
- NTE(LA7ARRAY,LA7TXT,LA7TYP,LA7FS,LA7ECH,LA7NTESN,LA7CMTYP,LA7FMT) ; Build NTE segment - notes and comments
- ; Call with LA7ARRAY = array to return NTE segment, pass by reference
- ; LA7TXT = text to send (by value if format=0, by reference if format>0)
- ; LA7TYP = source of comment - HL table 0105 Default to L (ancilliary/filler)
- ; LA7FS = HL field separator
- ; LA7ECH = HL encoding characters
- ; LA7NTESN = segment SET ID (pass by reference)
- ; LA7CMTYP = comment type code (HL table 0364)
- ; LA7FMT = format of text (0=single, 1=multi-line formatted text, 2=multi-line repetition)
- ;
- N LA7CTYPE,LA7NTE,LA7TEXT
- ;
- S LA7FS=$G(LA7FS),LA7TXT=$G(LA7TXT),(LA7CTYPE,LA7TEXT)="",LA7FMT=$G(LA7FMT)
- ;
- ; Remove leading "~" from comments and escape encode text
- I 'LA7FMT D
- . I $E(LA7TXT,1)="~" S LA7TXT=$$TRIM^XLFSTR(LA7TXT,"L","~")
- . S LA7TXT=$$TRIM^XLFSTR(LA7TXT,"R"," ")
- . S LA7TEXT=$$CHKDATA^LA7VHLU3(LA7TXT,LA7FS_LA7ECH)
- ;
- I LA7FMT>0 D
- . N LA7I,LA7J
- . S (LA7I,LA7J)=0
- . F S LA7I=$O(LA7TXT(LA7I)) Q:'LA7I D
- . . S LA7J=LA7J+1
- . . I $E(LA7TXT(LA7I),1)="~" S LA7TXT(LA7I)=$$TRIM^XLFSTR(LA7TXT(LA7I),"L","~")
- . . S LA7TXT(LA7I)=$$TRIM^XLFSTR(LA7TXT(LA7I),"R"," ")
- . . S LA7TXT(LA7I)=$$CHKDATA^LA7VHLU3(LA7TXT(LA7I),LA7FS_LA7ECH)
- . . I LA7FMT=1 S LA7TEXT(LA7I)=LA7TEXT_$S(LA7J>1:$E(LA7ECH,3)_".br"_$E(LA7ECH,3),1:"")_LA7TXT(LA7I) Q
- . . I LA7FMT=2 S LA7TEXT(LA7I)=LA7TEXT_$S(LA7J>1:$E(LA7ECH,2),1:"")_LA7TXT(LA7I) Q
- ;
- ; Update segment SET ID
- S LA7NTESN=$G(LA7NTESN)+1
- ;
- ; Default source of comment if undefined
- I $G(LA7TYP)="" S LA7TYP="L"
- ;
- ; Encode HL7 table 0364 with comment type
- ; If no type passed then default to REmark
- ; If 'code' not found in table then send 'code' in text (2nd component).
- I $G(LA7CMTYP)="" S LA7CMTYP="RE"
- I '$D(^TMP($J,"HL70364")) D HL70364
- S LA7X=$G(^TMP($J,"HL70364",LA7CMTYP))
- I LA7X="" S $P(LA7CTYPE,$E(LA7ECH,1),2)=$$CHKDATA^LA7VHLU3(LA7CMTYP,LA7FS_LA7ECH)
- E D
- . S LA7CTYPE=LA7CMTYP
- . S $P(LA7CTYPE,$E(LA7ECH,1),2)=$$CHKDATA^LA7VHLU3(LA7X,LA7FS_LA7ECH)
- . S $P(LA7CTYPE,$E(LA7ECH,1),3)="HL70364"
- ;
- S LA7NTE(0)="NTE"
- S LA7NTE(1)=LA7NTESN
- S LA7NTE(2)=LA7TYP
- M LA7NTE(3)=LA7TEXT
- S LA7NTE(4)=LA7CTYPE
- ;
- D BUILDSEG^LA7VHLU(.LA7NTE,.LA7ARRAY,LA7FS)
- ;
- Q
- ;
- ;
- CHKDATA(LA7IN,LA7CH) ; Check data to be built into an HL7 field for characters that
- ; conflict with encoding characters. Convert conflicting character using HL7 escape encoding.
- ;
- ; Call with LA7IN = data to be checked
- ; LA7CH = HL7 delimiters to check for
- ;
- ; Returns LA7OUT - checked data, converted if appropriate
- ;
- N J,LA7ESC,LA7LEN,LA7OUT,X
- ;
- S LA7IN=$G(LA7IN),LA7CH=$G(LA7CH),LA7OUT=""
- ;
- I LA7IN=""!(LA7CH="") Q LA7OUT
- ;
- ; Build array of encoding characters to check
- S LA7LEN=$L(LA7CH),LA7ESC=$E(LA7CH,4)
- F J=1:1:LA7LEN S LA7CH($E(LA7CH,J))=$E("FSRET",J)
- ;
- ; Check each character and convert if appropriate
- F J=1:1:$L(LA7IN) D
- . S X=$E(LA7IN,J)
- . I $D(LA7CH(X)) S X=LA7ESC_LA7CH(X)_LA7ESC
- . S LA7OUT=LA7OUT_X
- ;
- Q LA7OUT
- ;
- ;
- CNVFLD(LA7IN,LA7ECH1,LA7ECH2) ; Convert an encoded HL7 segment/field from one encoding scheme to another
- ; Call with LA7IN = data to be converted
- ; LA7ECH1 = delimiters of input
- ; LA7ECH2 = delimiters of output
- ;
- ; Returns LA7OUT = segment/field converted to new encoding scheme
- ;
- N J,LA7ECH,LA7ESC,LA7OUT,X
- ;
- S LA7IN=$G(LA7IN),LA7ECH1=$G(LA7ECH1),LA7ECH2=$G(LA7ECH2),LA7OUT=""
- ;
- I LA7IN=""!(LA7ECH1="")!(LA7ECH2="") Q LA7OUT
- ;
- ; Abort if input encoding length greater than output
- I $L(LA7ECH1)>$L(LA7ECH2) Q LA7OUT
- ;
- ; If same then return input as output
- I LA7ECH1=LA7ECH2 Q LA7IN
- ;
- S LA7ESC=$E(LA7ECH2,4)
- ;
- ; Build array to convert source encoding to target encoding
- F J=1:1:$L(LA7ECH1) S LA7ECH($E(LA7ECH1,J))=$E(LA7ECH2,J)
- ;
- ; Check each character and convert if appropriate
- ; If source conflicts with target encoding character then convert to escape encoding
- ; If match on source encoding character - convert to new encoding
- F J=1:1:$L(LA7IN) D
- . S X=$E(LA7IN,J)
- . I '$D(LA7ECH(X)),LA7ECH2[X S X=LA7ESC_$E("FSRET",($F(LA7ECH2,X)-1))_LA7ESC
- . I $D(LA7ECH(X)) S X=LA7ECH(X)
- . S LA7OUT=LA7OUT_X
- ;
- Q LA7OUT
- ;
- ;
- UNESC(LA7X,LA7CH) ; Unescape data using HL7 escape encoding
- ; Call with LA7X = string to decode
- ; LA7CH = HL7 delimiters (both field separator & encoding characters)
- ;
- ; Returns string of unencoded data.
- ;
- N J,LA7ESC
- ;
- ; If data does not contain escape encoding then return input string as output
- S LA7ESC=$E(LA7CH,4)
- I LA7X'[LA7ESC Q LA7X
- ;
- ; Build array of encoding characters to replace
- F J=1:1:$L(LA7CH) S LA7CH(LA7ESC_$E("FSRET",J)_LA7ESC)=$E(LA7CH,J)
- ;
- Q $$REPLACE^XLFSTR(LA7X,.LA7CH)
- ;
- ;
- UNESCFT(LA7X,LA7CH,LA7Y) ; Unescape formatted text data using HL7 escape encoding
- ; Call with LA7X = array to decode (pass by reference)
- ; LA7CH = HL7 delimiters (both field separator & encoding characters)
- ;
- ; Returns LA7Y = array of unencoded data.
- ;
- N J,K,LA7ESC,LA7I,LA7Z,SAVX,SAVY,Z
- ;
- S J=0,LA7ESC=$E(LA7CH,$L(LA7CH)-1),(LA7I,SAVX,SAVY)=""
- F S LA7I=$O(LA7X(LA7I)) Q:LA7I="" D
- . S J=J+1
- . I LA7X(LA7I)'[LA7ESC,SAVY="" S LA7Y(J,0)=LA7X(LA7I) Q
- . F K=1:1:$L(LA7X(LA7I)) D
- . . S Z=$E(LA7X(LA7I),K)
- . . I Z=LA7ESC D Q
- . . . I SAVY="" S SAVY=Z Q
- . . . S SAVY=SAVY_Z
- . . . I $P(SAVY,LA7ESC,2)=".br" S LA7Y(J,0)=$S(SAVX]"":SAVX,1:" "),SAVX="",J=J+1
- . . . I $E(SAVY,2)'="." S SAVX=SAVX_$$UNESC(SAVY,LA7CH)
- . . . S SAVY=""
- . . I SAVY]"" S SAVY=SAVY_Z Q
- . . S SAVX=SAVX_Z
- . S LA7Y(J,0)=SAVX,SAVX=""
- S LA7Y=J
- ;
- Q
- ;
- ;
- HL70364 ; Build HL7 table 0364 - Comment Type
- ;
- S ^TMP($J,"HL70364","PI")="Patient Instructions"
- S ^TMP($J,"HL70364","AI")="Ancillary Instructions"
- S ^TMP($J,"HL70364","GI")="General Instructions"
- S ^TMP($J,"HL70364","1R")="Primary Reason"
- S ^TMP($J,"HL70364","2R")="Secondary Reason"
- S ^TMP($J,"HL70364","GR")="General Reason"
- S ^TMP($J,"HL70364","RE")="Remark"
- S ^TMP($J,"HL70364","DR")="Duplicate/Interaction Reason"
- S ^TMP($J,"HL70364","VA-LR001")="Order Comment"
- S ^TMP($J,"HL70364","VA-LR002")="Result Comment"
- S ^TMP($J,"HL70364","VA-LR003")="Result Interpretation"
- S ^TMP($J,"HL70364","VA-LRMI001")="Comment on Specimen (#.99)"
- S ^TMP($J,"HL70364","VA-LRMI010")="Bact Rpt Remark (#13)"
- S ^TMP($J,"HL70364","VA-LRMI011")="Preliminary Bact Comment (#1)"
- S ^TMP($J,"HL70364","VA-LRMI012")="Bacteriology Test(s) (#1.5)"
- S ^TMP($J,"HL70364","VA-LRMI013")="Bacteriology Smear/Prep (#11.7)"
- S ^TMP($J,"HL70364","VA-LRMI020")="Parasite Rpt Remark (#17)"
- S ^TMP($J,"HL70364","VA-LRMI021")="Preliminary Parasite Comment (#16.5)"
- S ^TMP($J,"HL70364","VA-LRMI022")="Parasite Test(s) (16.4)"
- S ^TMP($J,"HL70364","VA-LRMI023")="Parasitology Smear/Prep (#15.51)"
- S ^TMP($J,"HL70364","VA-LRMI030")="Mycology RPT Remark (#21)"
- S ^TMP($J,"HL70364","VA-LRMI031")="Preliminary Mycology Comment (#20.5)"
- S ^TMP($J,"HL70364","VA-LRMI032")="Mycology Test(s) (#20.4)"
- S ^TMP($J,"HL70364","VA-LRMI033")="Mycology Smear/Prep (#19.6)"
- S ^TMP($J,"HL70364","VA-LRMI040")="TB Rpt Remark (#27)"
- S ^TMP($J,"HL70364","VA-LRMI041")="Preliminary TB Comment (#26.5)"
- S ^TMP($J,"HL70364","VA-LRMI042")="TB Test(s) (#26.4)"
- S ^TMP($J,"HL70364","VA-LRMI050")="Virology Rpt Remark (#37)"
- S ^TMP($J,"HL70364","VA-LRMI051")="Preliminary Virology Comment (#36.5)"
- S ^TMP($J,"HL70364","VA-LRMI052")="Virology Test (#36.4)"
- Q
- ;
- ;
- PCENC(LRDFN,LRSS,LRIDT) ; Find PCE encounter for an entry in file #63
- ;
- ; Call with LRDFN = entry in file #63
- ; LRSS = file #63 subscript
- ; LRIDT = inverse date/time of specimen in file #63
- ;
- ; Returns LA7ENC = related PCE encounter
- ;
- N LA7ENC,LA7UID,LA7X,LA7Y,LRODT,LRSN
- S LA7ENC="",LA7UID=$P($G(^LR(LRDFN,LRSS,LRIDT,"ORU")),"^")
- I LA7UID'="" D
- . S LA7X=$$CHECKUID^LRWU4(LA7UID)
- . I 'LA7X Q
- . S LA7Y=$G(^LRO(68,$P(LA7X,"^",2),1,$P(LA7X,"^",3),1,$P(LA7X,"^",4),0))
- . S LRODT=+$P(LA7Y,"^",4),LRSN=+$P(LA7Y,"^",5)
- . I $P(LA7Y,"^",2)=2,LRODT,LRSN S LA7ENC=$G(^LRO(69,LRODT,1,LRSN,"PCE"))
- ;
- Q LA7ENC
- ;
- ;
- SDENC(LA7PCE) ; Find SD Outpatient Encounter for an entry in file #63
- ;
- ; Call with LA7PCE = PCE encounters from file #69
- ;
- ; Returns LA7ENC = related SD encounter
- ;
- N LA7ENC,LA7X,LA7Y,LA7Z
- ;
- S LA7ENC=""
- F LA7I=1:1 S LA7X=$P(LA7PCE,";",LA7I) Q:LA7X="" D Q:LA7ENC'=""
- . K LA7Y
- . D LISTVST^SDOERPC(.LA7Y,LA7X)
- . S LA7Z=$Q(@LA7Y)
- . I $QS(LA7Z,1)="SD ENCOUNTER LIST",$QS(LA7Z,2)=$J S LA7ENC=$QS(LA7Z,3)
- . K @LA7Y
- ;
- Q LA7ENC
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7VHLU3 8916 printed Jan 18, 2025@02:41:23 Page 2
- LA7VHLU3 ;DALOI/JMC - HL7 Segment Utility ;Feb 13, 2009
- +1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,68,74**;Sep 27, 1994;Build 229
- +2 ;
- +3 QUIT
- +4 ;
- 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
- +2 ; LA7TXT = text to send (by value if format=0, by reference if format>0)
- +3 ; LA7TYP = source of comment - HL table 0105 Default to L (ancilliary/filler)
- +4 ; LA7FS = HL field separator
- +5 ; LA7ECH = HL encoding characters
- +6 ; LA7NTESN = segment SET ID (pass by reference)
- +7 ; LA7CMTYP = comment type code (HL table 0364)
- +8 ; LA7FMT = format of text (0=single, 1=multi-line formatted text, 2=multi-line repetition)
- +9 ;
- +10 NEW LA7CTYPE,LA7NTE,LA7TEXT
- +11 ;
- +12 SET LA7FS=$GET(LA7FS)
- SET LA7TXT=$GET(LA7TXT)
- SET (LA7CTYPE,LA7TEXT)=""
- SET LA7FMT=$GET(LA7FMT)
- +13 ;
- +14 ; Remove leading "~" from comments and escape encode text
- +15 IF 'LA7FMT
- Begin DoDot:1
- +16 IF $EXTRACT(LA7TXT,1)="~"
- SET LA7TXT=$$TRIM^XLFSTR(LA7TXT,"L","~")
- +17 SET LA7TXT=$$TRIM^XLFSTR(LA7TXT,"R"," ")
- +18 SET LA7TEXT=$$CHKDATA^LA7VHLU3(LA7TXT,LA7FS_LA7ECH)
- End DoDot:1
- +19 ;
- +20 IF LA7FMT>0
- Begin DoDot:1
- +21 NEW LA7I,LA7J
- +22 SET (LA7I,LA7J)=0
- +23 FOR
- SET LA7I=$ORDER(LA7TXT(LA7I))
- if 'LA7I
- QUIT
- Begin DoDot:2
- +24 SET LA7J=LA7J+1
- +25 IF $EXTRACT(LA7TXT(LA7I),1)="~"
- SET LA7TXT(LA7I)=$$TRIM^XLFSTR(LA7TXT(LA7I),"L","~")
- +26 SET LA7TXT(LA7I)=$$TRIM^XLFSTR(LA7TXT(LA7I),"R"," ")
- +27 SET LA7TXT(LA7I)=$$CHKDATA^LA7VHLU3(LA7TXT(LA7I),LA7FS_LA7ECH)
- +28 IF LA7FMT=1
- SET LA7TEXT(LA7I)=LA7TEXT_$SELECT(LA7J>1:$EXTRACT(LA7ECH,3)_".br"_$EXTRACT(LA7ECH,3),1:"")_LA7TXT(LA7I)
- QUIT
- +29 IF LA7FMT=2
- SET LA7TEXT(LA7I)=LA7TEXT_$SELECT(LA7J>1:$EXTRACT(LA7ECH,2),1:"")_LA7TXT(LA7I)
- QUIT
- End DoDot:2
- End DoDot:1
- +30 ;
- +31 ; Update segment SET ID
- +32 SET LA7NTESN=$GET(LA7NTESN)+1
- +33 ;
- +34 ; Default source of comment if undefined
- +35 IF $GET(LA7TYP)=""
- SET LA7TYP="L"
- +36 ;
- +37 ; Encode HL7 table 0364 with comment type
- +38 ; If no type passed then default to REmark
- +39 ; If 'code' not found in table then send 'code' in text (2nd component).
- +40 IF $GET(LA7CMTYP)=""
- SET LA7CMTYP="RE"
- +41 IF '$DATA(^TMP($JOB,"HL70364"))
- DO HL70364
- +42 SET LA7X=$GET(^TMP($JOB,"HL70364",LA7CMTYP))
- +43 IF LA7X=""
- SET $PIECE(LA7CTYPE,$EXTRACT(LA7ECH,1),2)=$$CHKDATA^LA7VHLU3(LA7CMTYP,LA7FS_LA7ECH)
- +44 IF '$TEST
- Begin DoDot:1
- +45 SET LA7CTYPE=LA7CMTYP
- +46 SET $PIECE(LA7CTYPE,$EXTRACT(LA7ECH,1),2)=$$CHKDATA^LA7VHLU3(LA7X,LA7FS_LA7ECH)
- +47 SET $PIECE(LA7CTYPE,$EXTRACT(LA7ECH,1),3)="HL70364"
- End DoDot:1
- +48 ;
- +49 SET LA7NTE(0)="NTE"
- +50 SET LA7NTE(1)=LA7NTESN
- +51 SET LA7NTE(2)=LA7TYP
- +52 MERGE LA7NTE(3)=LA7TEXT
- +53 SET LA7NTE(4)=LA7CTYPE
- +54 ;
- +55 DO BUILDSEG^LA7VHLU(.LA7NTE,.LA7ARRAY,LA7FS)
- +56 ;
- +57 QUIT
- +58 ;
- +59 ;
- 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.
- +2 ;
- +3 ; Call with LA7IN = data to be checked
- +4 ; LA7CH = HL7 delimiters to check for
- +5 ;
- +6 ; Returns LA7OUT - checked data, converted if appropriate
- +7 ;
- +8 NEW J,LA7ESC,LA7LEN,LA7OUT,X
- +9 ;
- +10 SET LA7IN=$GET(LA7IN)
- SET LA7CH=$GET(LA7CH)
- SET LA7OUT=""
- +11 ;
- +12 IF LA7IN=""!(LA7CH="")
- QUIT LA7OUT
- +13 ;
- +14 ; Build array of encoding characters to check
- +15 SET LA7LEN=$LENGTH(LA7CH)
- SET LA7ESC=$EXTRACT(LA7CH,4)
- +16 FOR J=1:1:LA7LEN
- SET LA7CH($EXTRACT(LA7CH,J))=$EXTRACT("FSRET",J)
- +17 ;
- +18 ; Check each character and convert if appropriate
- +19 FOR J=1:1:$LENGTH(LA7IN)
- Begin DoDot:1
- +20 SET X=$EXTRACT(LA7IN,J)
- +21 IF $DATA(LA7CH(X))
- SET X=LA7ESC_LA7CH(X)_LA7ESC
- +22 SET LA7OUT=LA7OUT_X
- End DoDot:1
- +23 ;
- +24 QUIT LA7OUT
- +25 ;
- +26 ;
- CNVFLD(LA7IN,LA7ECH1,LA7ECH2) ; Convert an encoded HL7 segment/field from one encoding scheme to another
- +1 ; Call with LA7IN = data to be converted
- +2 ; LA7ECH1 = delimiters of input
- +3 ; LA7ECH2 = delimiters of output
- +4 ;
- +5 ; Returns LA7OUT = segment/field converted to new encoding scheme
- +6 ;
- +7 NEW J,LA7ECH,LA7ESC,LA7OUT,X
- +8 ;
- +9 SET LA7IN=$GET(LA7IN)
- SET LA7ECH1=$GET(LA7ECH1)
- SET LA7ECH2=$GET(LA7ECH2)
- SET LA7OUT=""
- +10 ;
- +11 IF LA7IN=""!(LA7ECH1="")!(LA7ECH2="")
- QUIT LA7OUT
- +12 ;
- +13 ; Abort if input encoding length greater than output
- +14 IF $LENGTH(LA7ECH1)>$LENGTH(LA7ECH2)
- QUIT LA7OUT
- +15 ;
- +16 ; If same then return input as output
- +17 IF LA7ECH1=LA7ECH2
- QUIT LA7IN
- +18 ;
- +19 SET LA7ESC=$EXTRACT(LA7ECH2,4)
- +20 ;
- +21 ; Build array to convert source encoding to target encoding
- +22 FOR J=1:1:$LENGTH(LA7ECH1)
- SET LA7ECH($EXTRACT(LA7ECH1,J))=$EXTRACT(LA7ECH2,J)
- +23 ;
- +24 ; Check each character and convert if appropriate
- +25 ; If source conflicts with target encoding character then convert to escape encoding
- +26 ; If match on source encoding character - convert to new encoding
- +27 FOR J=1:1:$LENGTH(LA7IN)
- Begin DoDot:1
- +28 SET X=$EXTRACT(LA7IN,J)
- +29 IF '$DATA(LA7ECH(X))
- IF LA7ECH2[X
- SET X=LA7ESC_$EXTRACT("FSRET",($FIND(LA7ECH2,X)-1))_LA7ESC
- +30 IF $DATA(LA7ECH(X))
- SET X=LA7ECH(X)
- +31 SET LA7OUT=LA7OUT_X
- End DoDot:1
- +32 ;
- +33 QUIT LA7OUT
- +34 ;
- +35 ;
- UNESC(LA7X,LA7CH) ; Unescape data using HL7 escape encoding
- +1 ; Call with LA7X = string to decode
- +2 ; LA7CH = HL7 delimiters (both field separator & encoding characters)
- +3 ;
- +4 ; Returns string of unencoded data.
- +5 ;
- +6 NEW J,LA7ESC
- +7 ;
- +8 ; If data does not contain escape encoding then return input string as output
- +9 SET LA7ESC=$EXTRACT(LA7CH,4)
- +10 IF LA7X'[LA7ESC
- QUIT LA7X
- +11 ;
- +12 ; Build array of encoding characters to replace
- +13 FOR J=1:1:$LENGTH(LA7CH)
- SET LA7CH(LA7ESC_$EXTRACT("FSRET",J)_LA7ESC)=$EXTRACT(LA7CH,J)
- +14 ;
- +15 QUIT $$REPLACE^XLFSTR(LA7X,.LA7CH)
- +16 ;
- +17 ;
- UNESCFT(LA7X,LA7CH,LA7Y) ; Unescape formatted text data using HL7 escape encoding
- +1 ; Call with LA7X = array to decode (pass by reference)
- +2 ; LA7CH = HL7 delimiters (both field separator & encoding characters)
- +3 ;
- +4 ; Returns LA7Y = array of unencoded data.
- +5 ;
- +6 NEW J,K,LA7ESC,LA7I,LA7Z,SAVX,SAVY,Z
- +7 ;
- +8 SET J=0
- SET LA7ESC=$EXTRACT(LA7CH,$LENGTH(LA7CH)-1)
- SET (LA7I,SAVX,SAVY)=""
- +9 FOR
- SET LA7I=$ORDER(LA7X(LA7I))
- if LA7I=""
- QUIT
- Begin DoDot:1
- +10 SET J=J+1
- +11 IF LA7X(LA7I)'[LA7ESC
- IF SAVY=""
- SET LA7Y(J,0)=LA7X(LA7I)
- QUIT
- +12 FOR K=1:1:$LENGTH(LA7X(LA7I))
- Begin DoDot:2
- +13 SET Z=$EXTRACT(LA7X(LA7I),K)
- +14 IF Z=LA7ESC
- Begin DoDot:3
- +15 IF SAVY=""
- SET SAVY=Z
- QUIT
- +16 SET SAVY=SAVY_Z
- +17 IF $PIECE(SAVY,LA7ESC,2)=".br"
- SET LA7Y(J,0)=$SELECT(SAVX]"":SAVX,1:" ")
- SET SAVX=""
- SET J=J+1
- +18 IF $EXTRACT(SAVY,2)'="."
- SET SAVX=SAVX_$$UNESC(SAVY,LA7CH)
- +19 SET SAVY=""
- End DoDot:3
- QUIT
- +20 IF SAVY]""
- SET SAVY=SAVY_Z
- QUIT
- +21 SET SAVX=SAVX_Z
- End DoDot:2
- +22 SET LA7Y(J,0)=SAVX
- SET SAVX=""
- End DoDot:1
- +23 SET LA7Y=J
- +24 ;
- +25 QUIT
- +26 ;
- +27 ;
- HL70364 ; Build HL7 table 0364 - Comment Type
- +1 ;
- +2 SET ^TMP($JOB,"HL70364","PI")="Patient Instructions"
- +3 SET ^TMP($JOB,"HL70364","AI")="Ancillary Instructions"
- +4 SET ^TMP($JOB,"HL70364","GI")="General Instructions"
- +5 SET ^TMP($JOB,"HL70364","1R")="Primary Reason"
- +6 SET ^TMP($JOB,"HL70364","2R")="Secondary Reason"
- +7 SET ^TMP($JOB,"HL70364","GR")="General Reason"
- +8 SET ^TMP($JOB,"HL70364","RE")="Remark"
- +9 SET ^TMP($JOB,"HL70364","DR")="Duplicate/Interaction Reason"
- +10 SET ^TMP($JOB,"HL70364","VA-LR001")="Order Comment"
- +11 SET ^TMP($JOB,"HL70364","VA-LR002")="Result Comment"
- +12 SET ^TMP($JOB,"HL70364","VA-LR003")="Result Interpretation"
- +13 SET ^TMP($JOB,"HL70364","VA-LRMI001")="Comment on Specimen (#.99)"
- +14 SET ^TMP($JOB,"HL70364","VA-LRMI010")="Bact Rpt Remark (#13)"
- +15 SET ^TMP($JOB,"HL70364","VA-LRMI011")="Preliminary Bact Comment (#1)"
- +16 SET ^TMP($JOB,"HL70364","VA-LRMI012")="Bacteriology Test(s) (#1.5)"
- +17 SET ^TMP($JOB,"HL70364","VA-LRMI013")="Bacteriology Smear/Prep (#11.7)"
- +18 SET ^TMP($JOB,"HL70364","VA-LRMI020")="Parasite Rpt Remark (#17)"
- +19 SET ^TMP($JOB,"HL70364","VA-LRMI021")="Preliminary Parasite Comment (#16.5)"
- +20 SET ^TMP($JOB,"HL70364","VA-LRMI022")="Parasite Test(s) (16.4)"
- +21 SET ^TMP($JOB,"HL70364","VA-LRMI023")="Parasitology Smear/Prep (#15.51)"
- +22 SET ^TMP($JOB,"HL70364","VA-LRMI030")="Mycology RPT Remark (#21)"
- +23 SET ^TMP($JOB,"HL70364","VA-LRMI031")="Preliminary Mycology Comment (#20.5)"
- +24 SET ^TMP($JOB,"HL70364","VA-LRMI032")="Mycology Test(s) (#20.4)"
- +25 SET ^TMP($JOB,"HL70364","VA-LRMI033")="Mycology Smear/Prep (#19.6)"
- +26 SET ^TMP($JOB,"HL70364","VA-LRMI040")="TB Rpt Remark (#27)"
- +27 SET ^TMP($JOB,"HL70364","VA-LRMI041")="Preliminary TB Comment (#26.5)"
- +28 SET ^TMP($JOB,"HL70364","VA-LRMI042")="TB Test(s) (#26.4)"
- +29 SET ^TMP($JOB,"HL70364","VA-LRMI050")="Virology Rpt Remark (#37)"
- +30 SET ^TMP($JOB,"HL70364","VA-LRMI051")="Preliminary Virology Comment (#36.5)"
- +31 SET ^TMP($JOB,"HL70364","VA-LRMI052")="Virology Test (#36.4)"
- +32 QUIT
- +33 ;
- +34 ;
- PCENC(LRDFN,LRSS,LRIDT) ; Find PCE encounter for an entry in file #63
- +1 ;
- +2 ; Call with LRDFN = entry in file #63
- +3 ; LRSS = file #63 subscript
- +4 ; LRIDT = inverse date/time of specimen in file #63
- +5 ;
- +6 ; Returns LA7ENC = related PCE encounter
- +7 ;
- +8 NEW LA7ENC,LA7UID,LA7X,LA7Y,LRODT,LRSN
- +9 SET LA7ENC=""
- SET LA7UID=$PIECE($GET(^LR(LRDFN,LRSS,LRIDT,"ORU")),"^")
- +10 IF LA7UID'=""
- Begin DoDot:1
- +11 SET LA7X=$$CHECKUID^LRWU4(LA7UID)
- +12 IF 'LA7X
- QUIT
- +13 SET LA7Y=$GET(^LRO(68,$PIECE(LA7X,"^",2),1,$PIECE(LA7X,"^",3),1,$PIECE(LA7X,"^",4),0))
- +14 SET LRODT=+$PIECE(LA7Y,"^",4)
- SET LRSN=+$PIECE(LA7Y,"^",5)
- +15 IF $PIECE(LA7Y,"^",2)=2
- IF LRODT
- IF LRSN
- SET LA7ENC=$GET(^LRO(69,LRODT,1,LRSN,"PCE"))
- End DoDot:1
- +16 ;
- +17 QUIT LA7ENC
- +18 ;
- +19 ;
- SDENC(LA7PCE) ; Find SD Outpatient Encounter for an entry in file #63
- +1 ;
- +2 ; Call with LA7PCE = PCE encounters from file #69
- +3 ;
- +4 ; Returns LA7ENC = related SD encounter
- +5 ;
- +6 NEW LA7ENC,LA7X,LA7Y,LA7Z
- +7 ;
- +8 SET LA7ENC=""
- +9 FOR LA7I=1:1
- SET LA7X=$PIECE(LA7PCE,";",LA7I)
- if LA7X=""
- QUIT
- Begin DoDot:1
- +10 KILL LA7Y
- +11 DO LISTVST^SDOERPC(.LA7Y,LA7X)
- +12 SET LA7Z=$QUERY(@LA7Y)
- +13 IF $QSUBSCRIPT(LA7Z,1)="SD ENCOUNTER LIST"
- IF $QSUBSCRIPT(LA7Z,2)=$JOB
- SET LA7ENC=$QSUBSCRIPT(LA7Z,3)
- +14 KILL @LA7Y
- End DoDot:1
- if LA7ENC'=""
- QUIT
- +15 ;
- +16 QUIT LA7ENC