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 Oct 16, 2024@17:41:01 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
