RORUPD04 ;HCIOFO/SG - PROCESSING OF THE LAB DATA ;12/8/05 8:20am
;;1.5;CLINICAL CASE REGISTRIES;**14,37,38**;Feb 17, 2006;Build 2
;
Q
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*14 APR 2011 A SAUNDERS LAB: added call to new tag HCV to look
; for HCV results.
;ROR*1.5*37 NOV 2020 F TRAXLER Adding UNDET check in CHKIND subroutine
;ROR*1.5*38 APR 2021 F TRAXLER Fix bug introduced by ROR*1.5*37 change.
;******************************************************************************
;******************************************************************************
;***** CHECKS AN INDICATOR CONDITION
;
; LSI Indicator (internal value)
; VAL Indicated value
; .RESULT( Result value
; "RH") Reference high
; "RL") Reference low
;
; Return Values:
; 0 False
; >0 True
;
CHKIND(LSI,VAL,RESULT) ;
S RESULT=$$UP^XLFSTR(RESULT)
;--- Reference Range. (Note: See subfile #798.92, field #1(INDICATOR) for LSI values 0-6.
I LSI=1 D Q LSI
. I $G(RESULT("RL"))'="" Q:RESULT<RESULT("RL")
. I $G(RESULT("RH"))'="" Q:RESULT>RESULT("RH")
. S LSI=0
;--- Positive Result
I LSI=6 S VAL=0 D Q VAL
. I RESULT["UNDET" Q
. I (RESULT="P")!(RESULT="R") S VAL=1 Q
. I RESULT'["POS",RESULT'["REA",RESULT'["DETEC" Q
. I RESULT'["NEG",RESULT'["NO",RESULT'["IND" S VAL=1
;--- Compare to the value
Q:VAL="" 0
I LSI=3 Q (RESULT>VAL) ;greater than
I LSI=4 Q (RESULT<VAL) ;less than
S VAL=$$UP^XLFSTR(VAL)
I LSI=2 Q (RESULT[VAL) ;contains
I LSI=5 Q (RESULT=VAL) ;equal to
Q 0
;
;***** PROCESSING OF THE 'LAB DATA' FILE
;
; UPDSTART Date of the earliest update (DO NOT pass by
; reference)
; PATIEN Patient IEN
;
; Return values:
; <0 Error code
; 0 Continue processing of the current patient
; 1 Stop processing
;
LAB(UPDSTART,PATIEN) ;
N RORFILE ; File number
;
N DM,DSEND,LABIENS,RC,RORLAB,TMP
S RORFILE=63,DSEND=RORUPD("DSEND")
K RORVALS("LS")
;--- If the start date is more than 60 days in the past, results
; should be loaded using collection dates. Otherwise, dates of
;--- the results are used).
S DM=$S($$FMDIFF^XLFDT(DT,UPDSTART)>60:"^CD",1:"^RAD")
;--- Check the event references if the events are enabled
I $G(RORUPD("FLAGS"))["E" D Q:RC'>0 RC
. S RC=$$GET^RORUPP02(PATIEN,1,.UPDSTART,.DSEND)
. ;--- If dates have been modified according to the event references,
. ;--- they are the collection dates/times.
. S:RC>1 UPDSTART=UPDSTART\1,DSEND=$$FMADD^XLFDT(DSEND\1,1),DM="^CD"
;---
S TMP=$$LABREF^RORUTL18(PATIEN) Q:TMP'>0 TMP
S LABIENS=TMP_",",RC=0
;
S RORLAB=$$ALLOC^RORTMP() D D FREE^RORTMP(RORLAB)
. ;--- Load the Lab results
. I $G(RORLRC)="" S RORLRC="CH,MI"
. S RC=$$LABRSLTS^RORUTL02(PATIEN,UPDSTART_DM,DSEND_DM,RORLAB)
. I RC<0 D INCEC^RORUPDUT(.RC) Q
. ;--- Process the results
. Q:$$RESULTS(PATIEN,RORLAB)<0
. ;--- Load necessary data elements
. I $D(RORUPD("SR",RORFILE,"F"))>1 D I TMP<0 D INCEC^RORUPDUT() Q
. . S TMP=$$LOAD(LABIENS)
. ;--- Apply "before" rules
. S RC=$$APLRULES^RORUPDUT(RORFILE,LABIENS,"B")
. I RC D INCEC^RORUPDUT(.RC) Q
. ;--- Apply "after" rules
. S RC=$$APLRULES^RORUPDUT(RORFILE,LABIENS,"A")
. I RC D INCEC^RORUPDUT(.RC) Q
. ;check if patient has positive HCV LOINC test result
. D HCV(PATIEN,RORLAB)
;
D CLRDES^RORUPDUT(RORFILE)
Q RC
;
;***** LOAD DATA ELEMENTS
;
; IENS IENS of the current record
;
; Return values:
; <0 Error code
; 0 Ok
;
LOAD(IENS) ;
N RC S RC=0
;--- API #1
I $D(RORUPD("SR",RORFILE,"F",1)) D Q:RC<0 RC
. S RC=$$LOADFLDS^RORUPDUT(RORFILE,IENS)
;--- API #2
Q 0
;
;***** EXTRACTS PROPER RESULT CODE FROM THE OBSERVATION ID
;
; OID Observation ID in HL7 format
; CS HL7 component separator
;
; Return values:
; Lab result code (see the LA7SC parameter of
; the GCPR^LA7QRY entry point)
; ^1: Result code
; ^2: Coding system ("LN" or "NLT")
; Or an empty string if coding system is unknown or there
; are no active search indicators exist for this code.
;
RESCODE(OID,CS) ;
N CODE,I,RESCODE,TYPE
S RESCODE=""
F I=1,4 D Q:RESCODE'=""
. S CODE=$P(OID,CS,I),TYPE=$P(OID,CS,I+2) Q:CODE=""
. S TYPE=$S(TYPE="LN":"LN",TYPE="99VA64":"NLT",1:"") Q:TYPE=""
. ;--- Check if the search indicators exist for this code
. S RESCODE=CODE_U_TYPE
. S:$D(@RORUPDPI@("LS",RESCODE))<10 RESCODE=""
Q RESCODE
;
;***** LOADS AND PROCESSES RESULTS OF THE TESTS
;
; PATIEN Patient IEN
; ROR8LAB Closed root of the HL7 message created by GCPR^LA7QRY
;
; Return values:
; <0 Error code
; 0 Ok
;
RESULTS(PATIEN,ROR8LAB) ;
N CS,DATE,FS,I,ISEG,LOCATION,LSIEN,LSNODE,RC,RESCODE,RESVAL,RORHL,SEG,SEGTYPE,TMP
S ISEG="",RC=0
F S ISEG=$O(@ROR8LAB@(ISEG)) Q:ISEG="" D Q:RC<0
. S SEG=$G(@ROR8LAB@(ISEG))
. ;--- Extract separators from the MSH segment
. I $E(SEG,1,3)="MSH" D Q
. . S (RORHL("FS"),FS)=$E(SEG,4),TMP=$P(SEG,FS,2)
. . S CS=$E(TMP,1)
. ;--- Skip all segments except OBX
. S SEGTYPE=$P(SEG,FS)
. Q:SEGTYPE'="OBX"
. ;--- Get lab result code
. S RESCODE=$$RESCODE($P(SEG,FS,4),CS) Q:RESCODE=""
. ;--- Load the full segment
. D LOADSEG^RORHL7A(.SEG,$NA(@ROR8LAB@(ISEG)))
. ;--- Get the result data
. S RESVAL=$G(SEG(5)),TMP=$G(SEG(7))
. S RESVAL("RL")=$P(TMP,"-",1) ; Reference Low
. S RESVAL("RH")=$P(TMP,"-",2) ; Reference High
. S DATE=$$HL7TFM^XLFDT($G(SEG(14)),"L")\1
. ;--- Analyze the result
. K LOCATION
. S LSNODE=$NA(@RORUPDPI@("LS",RESCODE))
. S LSIEN=""
. F S LSIEN=$O(@LSNODE@(LSIEN)) Q:LSIEN="" D Q:RC<0
. . S I="",RC=0
. . F S I=$O(@LSNODE@(LSIEN,I)) Q:I="" D Q:RC
. . . S TMP=$G(@LSNODE@(LSIEN,I))
. . . S RC=$$CHKIND(+TMP,$P(TMP,U,2),.RESVAL)
. . Q:RC'>0
. . S TMP=+$G(RORVALS("LS",LSIEN))
. . I TMP Q:(DATE'>0)!(DATE'<TMP)
. . S:'$D(LOCATION) LOCATION=$$IEN^XUAF4($P($G(SEG(15)),CS))
. . S RORVALS("LS",LSIEN)=DATE_U_LOCATION
;---
Q $S(RC<0:RC,1:0)
;
;***** IMPLEMENTATION OF THE SELECTION RULE
;
; LSIEN Lab Search IEN
;
; Return values:
; 0 Skip the patient
; 1 Add the patient
;
RULE(LSIEN) ;
Q:'$D(RORVALS("LS",LSIEN)) 0
N DATE,LOC,SRDT
S DATE=+$G(RORVALS("LS",LSIEN))
D:DATE>0
. S LOC=$P($G(RORVALS("LS",LSIEN)),U,2)
. S SRDT=$$GETVAL^RORUPDUT("ROR SRDT")
. I (DATE<SRDT)!(SRDT'>0) D Q
. . S RORVALS("SV","ROR SRDT")=DATE
. . S RORVALS("SV","ROR SRLOC")=LOC
. I DATE=SRDT D:$$GETVAL^RORUPDUT("ROR SRLOC")="" Q
. . S RORVALS("SV","ROR SRLOC")=LOC
Q 1
;
;***** ADD PATIENT TO ARRAY IF THEY HAVE A POSITIVE HCV TEST RESULT
;Patients will be automatically confirmed into the registry during the
;nightly job in ADD^RORUPD50 if they have a positive HCV test result
;Note: all other registry 'update' criteria must be met as well
;
;Input
; DFN Patient DFN
; RORLAB Array with patient's lab test results. In HL7 format,
; returned from GCPR^LA7QRY
;
;Output
; ^TMP("ROR HCV CONFIRM",$J,DFN)="" patient is added to this array if they
; have positive HCV test result. Array is used in ADD^RORUPD50.
;
HCV(DFN,RORLAB) ;
N RORI,RORSEG,RORTYPE,RORVAL,HLFS,HLCS,RORLOINC,RORDONE
S HLFS="|",HLCS="^" ;HL7 field and component separator in the Lab data array
;loop through lab output and see if the test result value is for an HCV LOINC
;Array is used in ADD^RORUPD50
S RORI=0,RORDONE=0
F S RORI=$O(@RORLAB@(RORI)) Q:'RORI Q:RORDONE D
. S RORSEG=$G(@RORLAB@(RORI)) ;entire HL7 segment data
. S SEGTYPE=$P(RORSEG,HLFS,1) ;segment type (PID,OBR,OBX,etc.)
. Q:SEGTYPE'="OBX" ;we only want OBX segments
. S RORLOINC=$P($P($G(RORSEG),HLFS,4),HLCS,1)
. I $G(RORLOINC)'="",'$D(^TMP("ROR HCV LIST",$J,RORLOINC)) Q ;quit if not HCV LOINC
. S RORVAL=$P(RORSEG,HLFS,6) ; HCV test result value
. I $L($G(RORVAL))>0 S RORVAL=$TR(RORVAL,"""","") ;get rid of any double quotes
. I $E($G(RORVAL),1,1)=">" D ;if positive test result
.. S ^TMP("ROR HCV CONFIRM",$J,DFN)="" ;add patient to HCV auto-confirm list
.. S RORDONE=1 ;end of HCV processing for this patient
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORUPD04 8805 printed Sep 23, 2025@19:19:39 Page 2
RORUPD04 ;HCIOFO/SG - PROCESSING OF THE LAB DATA ;12/8/05 8:20am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**14,37,38**;Feb 17, 2006;Build 2
+2 ;
+3 QUIT
+4 ;
+5 ;******************************************************************************
+6 ;******************************************************************************
+7 ; --- ROUTINE MODIFICATION LOG ---
+8 ;
+9 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+10 ;----------- ---------- ----------- ----------------------------------------
+11 ;ROR*1.5*14 APR 2011 A SAUNDERS LAB: added call to new tag HCV to look
+12 ; for HCV results.
+13 ;ROR*1.5*37 NOV 2020 F TRAXLER Adding UNDET check in CHKIND subroutine
+14 ;ROR*1.5*38 APR 2021 F TRAXLER Fix bug introduced by ROR*1.5*37 change.
+15 ;******************************************************************************
+16 ;******************************************************************************
+17 ;***** CHECKS AN INDICATOR CONDITION
+18 ;
+19 ; LSI Indicator (internal value)
+20 ; VAL Indicated value
+21 ; .RESULT( Result value
+22 ; "RH") Reference high
+23 ; "RL") Reference low
+24 ;
+25 ; Return Values:
+26 ; 0 False
+27 ; >0 True
+28 ;
CHKIND(LSI,VAL,RESULT) ;
+1 SET RESULT=$$UP^XLFSTR(RESULT)
+2 ;--- Reference Range. (Note: See subfile #798.92, field #1(INDICATOR) for LSI values 0-6.
+3 IF LSI=1
Begin DoDot:1
+4 IF $GET(RESULT("RL"))'=""
if RESULT<RESULT("RL")
QUIT
+5 IF $GET(RESULT("RH"))'=""
if RESULT>RESULT("RH")
QUIT
+6 SET LSI=0
End DoDot:1
QUIT LSI
+7 ;--- Positive Result
+8 IF LSI=6
SET VAL=0
Begin DoDot:1
+9 IF RESULT["UNDET"
QUIT
+10 IF (RESULT="P")!(RESULT="R")
SET VAL=1
QUIT
+11 IF RESULT'["POS"
IF RESULT'["REA"
IF RESULT'["DETEC"
QUIT
+12 IF RESULT'["NEG"
IF RESULT'["NO"
IF RESULT'["IND"
SET VAL=1
End DoDot:1
QUIT VAL
+13 ;--- Compare to the value
+14 if VAL=""
QUIT 0
+15 ;greater than
IF LSI=3
QUIT (RESULT>VAL)
+16 ;less than
IF LSI=4
QUIT (RESULT<VAL)
+17 SET VAL=$$UP^XLFSTR(VAL)
+18 ;contains
IF LSI=2
QUIT (RESULT[VAL)
+19 ;equal to
IF LSI=5
QUIT (RESULT=VAL)
+20 QUIT 0
+21 ;
+22 ;***** PROCESSING OF THE 'LAB DATA' FILE
+23 ;
+24 ; UPDSTART Date of the earliest update (DO NOT pass by
+25 ; reference)
+26 ; PATIEN Patient IEN
+27 ;
+28 ; Return values:
+29 ; <0 Error code
+30 ; 0 Continue processing of the current patient
+31 ; 1 Stop processing
+32 ;
LAB(UPDSTART,PATIEN) ;
+1 ; File number
NEW RORFILE
+2 ;
+3 NEW DM,DSEND,LABIENS,RC,RORLAB,TMP
+4 SET RORFILE=63
SET DSEND=RORUPD("DSEND")
+5 KILL RORVALS("LS")
+6 ;--- If the start date is more than 60 days in the past, results
+7 ; should be loaded using collection dates. Otherwise, dates of
+8 ;--- the results are used).
+9 SET DM=$SELECT($$FMDIFF^XLFDT(DT,UPDSTART)>60:"^CD",1:"^RAD")
+10 ;--- Check the event references if the events are enabled
+11 IF $GET(RORUPD("FLAGS"))["E"
Begin DoDot:1
+12 SET RC=$$GET^RORUPP02(PATIEN,1,.UPDSTART,.DSEND)
+13 ;--- If dates have been modified according to the event references,
+14 ;--- they are the collection dates/times.
+15 if RC>1
SET UPDSTART=UPDSTART\1
SET DSEND=$$FMADD^XLFDT(DSEND\1,1)
SET DM="^CD"
End DoDot:1
if RC'>0
QUIT RC
+16 ;---
+17 SET TMP=$$LABREF^RORUTL18(PATIEN)
if TMP'>0
QUIT TMP
+18 SET LABIENS=TMP_","
SET RC=0
+19 ;
+20 SET RORLAB=$$ALLOC^RORTMP()
Begin DoDot:1
+21 ;--- Load the Lab results
+22 IF $GET(RORLRC)=""
SET RORLRC="CH,MI"
+23 SET RC=$$LABRSLTS^RORUTL02(PATIEN,UPDSTART_DM,DSEND_DM,RORLAB)
+24 IF RC<0
DO INCEC^RORUPDUT(.RC)
QUIT
+25 ;--- Process the results
+26 if $$RESULTS(PATIEN,RORLAB)<0
QUIT
+27 ;--- Load necessary data elements
+28 IF $DATA(RORUPD("SR",RORFILE,"F"))>1
Begin DoDot:2
+29 SET TMP=$$LOAD(LABIENS)
End DoDot:2
IF TMP<0
DO INCEC^RORUPDUT()
QUIT
+30 ;--- Apply "before" rules
+31 SET RC=$$APLRULES^RORUPDUT(RORFILE,LABIENS,"B")
+32 IF RC
DO INCEC^RORUPDUT(.RC)
QUIT
+33 ;--- Apply "after" rules
+34 SET RC=$$APLRULES^RORUPDUT(RORFILE,LABIENS,"A")
+35 IF RC
DO INCEC^RORUPDUT(.RC)
QUIT
+36 ;check if patient has positive HCV LOINC test result
+37 DO HCV(PATIEN,RORLAB)
End DoDot:1
DO FREE^RORTMP(RORLAB)
+38 ;
+39 DO CLRDES^RORUPDUT(RORFILE)
+40 QUIT RC
+41 ;
+42 ;***** LOAD DATA ELEMENTS
+43 ;
+44 ; IENS IENS of the current record
+45 ;
+46 ; Return values:
+47 ; <0 Error code
+48 ; 0 Ok
+49 ;
LOAD(IENS) ;
+1 NEW RC
SET RC=0
+2 ;--- API #1
+3 IF $DATA(RORUPD("SR",RORFILE,"F",1))
Begin DoDot:1
+4 SET RC=$$LOADFLDS^RORUPDUT(RORFILE,IENS)
End DoDot:1
if RC<0
QUIT RC
+5 ;--- API #2
+6 QUIT 0
+7 ;
+8 ;***** EXTRACTS PROPER RESULT CODE FROM THE OBSERVATION ID
+9 ;
+10 ; OID Observation ID in HL7 format
+11 ; CS HL7 component separator
+12 ;
+13 ; Return values:
+14 ; Lab result code (see the LA7SC parameter of
+15 ; the GCPR^LA7QRY entry point)
+16 ; ^1: Result code
+17 ; ^2: Coding system ("LN" or "NLT")
+18 ; Or an empty string if coding system is unknown or there
+19 ; are no active search indicators exist for this code.
+20 ;
RESCODE(OID,CS) ;
+1 NEW CODE,I,RESCODE,TYPE
+2 SET RESCODE=""
+3 FOR I=1,4
Begin DoDot:1
+4 SET CODE=$PIECE(OID,CS,I)
SET TYPE=$PIECE(OID,CS,I+2)
if CODE=""
QUIT
+5 SET TYPE=$SELECT(TYPE="LN":"LN",TYPE="99VA64":"NLT",1:"")
if TYPE=""
QUIT
+6 ;--- Check if the search indicators exist for this code
+7 SET RESCODE=CODE_U_TYPE
+8 if $DATA(@RORUPDPI@("LS",RESCODE))<10
SET RESCODE=""
End DoDot:1
if RESCODE'=""
QUIT
+9 QUIT RESCODE
+10 ;
+11 ;***** LOADS AND PROCESSES RESULTS OF THE TESTS
+12 ;
+13 ; PATIEN Patient IEN
+14 ; ROR8LAB Closed root of the HL7 message created by GCPR^LA7QRY
+15 ;
+16 ; Return values:
+17 ; <0 Error code
+18 ; 0 Ok
+19 ;
RESULTS(PATIEN,ROR8LAB) ;
+1 NEW CS,DATE,FS,I,ISEG,LOCATION,LSIEN,LSNODE,RC,RESCODE,RESVAL,RORHL,SEG,SEGTYPE,TMP
+2 SET ISEG=""
SET RC=0
+3 FOR
SET ISEG=$ORDER(@ROR8LAB@(ISEG))
if ISEG=""
QUIT
Begin DoDot:1
+4 SET SEG=$GET(@ROR8LAB@(ISEG))
+5 ;--- Extract separators from the MSH segment
+6 IF $EXTRACT(SEG,1,3)="MSH"
Begin DoDot:2
+7 SET (RORHL("FS"),FS)=$EXTRACT(SEG,4)
SET TMP=$PIECE(SEG,FS,2)
+8 SET CS=$EXTRACT(TMP,1)
End DoDot:2
QUIT
+9 ;--- Skip all segments except OBX
+10 SET SEGTYPE=$PIECE(SEG,FS)
+11 if SEGTYPE'="OBX"
QUIT
+12 ;--- Get lab result code
+13 SET RESCODE=$$RESCODE($PIECE(SEG,FS,4),CS)
if RESCODE=""
QUIT
+14 ;--- Load the full segment
+15 DO LOADSEG^RORHL7A(.SEG,$NAME(@ROR8LAB@(ISEG)))
+16 ;--- Get the result data
+17 SET RESVAL=$GET(SEG(5))
SET TMP=$GET(SEG(7))
+18 ; Reference Low
SET RESVAL("RL")=$PIECE(TMP,"-",1)
+19 ; Reference High
SET RESVAL("RH")=$PIECE(TMP,"-",2)
+20 SET DATE=$$HL7TFM^XLFDT($GET(SEG(14)),"L")\1
+21 ;--- Analyze the result
+22 KILL LOCATION
+23 SET LSNODE=$NAME(@RORUPDPI@("LS",RESCODE))
+24 SET LSIEN=""
+25 FOR
SET LSIEN=$ORDER(@LSNODE@(LSIEN))
if LSIEN=""
QUIT
Begin DoDot:2
+26 SET I=""
SET RC=0
+27 FOR
SET I=$ORDER(@LSNODE@(LSIEN,I))
if I=""
QUIT
Begin DoDot:3
+28 SET TMP=$GET(@LSNODE@(LSIEN,I))
+29 SET RC=$$CHKIND(+TMP,$PIECE(TMP,U,2),.RESVAL)
End DoDot:3
if RC
QUIT
+30 if RC'>0
QUIT
+31 SET TMP=+$GET(RORVALS("LS",LSIEN))
+32 IF TMP
if (DATE'>0)!(DATE'<TMP)
QUIT
+33 if '$DATA(LOCATION)
SET LOCATION=$$IEN^XUAF4($PIECE($GET(SEG(15)),CS))
+34 SET RORVALS("LS",LSIEN)=DATE_U_LOCATION
End DoDot:2
if RC<0
QUIT
End DoDot:1
if RC<0
QUIT
+35 ;---
+36 QUIT $SELECT(RC<0:RC,1:0)
+37 ;
+38 ;***** IMPLEMENTATION OF THE SELECTION RULE
+39 ;
+40 ; LSIEN Lab Search IEN
+41 ;
+42 ; Return values:
+43 ; 0 Skip the patient
+44 ; 1 Add the patient
+45 ;
RULE(LSIEN) ;
+1 if '$DATA(RORVALS("LS",LSIEN))
QUIT 0
+2 NEW DATE,LOC,SRDT
+3 SET DATE=+$GET(RORVALS("LS",LSIEN))
+4 if DATE>0
Begin DoDot:1
+5 SET LOC=$PIECE($GET(RORVALS("LS",LSIEN)),U,2)
+6 SET SRDT=$$GETVAL^RORUPDUT("ROR SRDT")
+7 IF (DATE<SRDT)!(SRDT'>0)
Begin DoDot:2
+8 SET RORVALS("SV","ROR SRDT")=DATE
+9 SET RORVALS("SV","ROR SRLOC")=LOC
End DoDot:2
QUIT
+10 IF DATE=SRDT
if $$GETVAL^RORUPDUT("ROR SRLOC")=""
Begin DoDot:2
+11 SET RORVALS("SV","ROR SRLOC")=LOC
End DoDot:2
QUIT
End DoDot:1
+12 QUIT 1
+13 ;
+14 ;***** ADD PATIENT TO ARRAY IF THEY HAVE A POSITIVE HCV TEST RESULT
+15 ;Patients will be automatically confirmed into the registry during the
+16 ;nightly job in ADD^RORUPD50 if they have a positive HCV test result
+17 ;Note: all other registry 'update' criteria must be met as well
+18 ;
+19 ;Input
+20 ; DFN Patient DFN
+21 ; RORLAB Array with patient's lab test results. In HL7 format,
+22 ; returned from GCPR^LA7QRY
+23 ;
+24 ;Output
+25 ; ^TMP("ROR HCV CONFIRM",$J,DFN)="" patient is added to this array if they
+26 ; have positive HCV test result. Array is used in ADD^RORUPD50.
+27 ;
HCV(DFN,RORLAB) ;
+1 NEW RORI,RORSEG,RORTYPE,RORVAL,HLFS,HLCS,RORLOINC,RORDONE
+2 ;HL7 field and component separator in the Lab data array
SET HLFS="|"
SET HLCS="^"
+3 ;loop through lab output and see if the test result value is for an HCV LOINC
+4 ;Array is used in ADD^RORUPD50
+5 SET RORI=0
SET RORDONE=0
+6 FOR
SET RORI=$ORDER(@RORLAB@(RORI))
if 'RORI
QUIT
if RORDONE
QUIT
Begin DoDot:1
+7 ;entire HL7 segment data
SET RORSEG=$GET(@RORLAB@(RORI))
+8 ;segment type (PID,OBR,OBX,etc.)
SET SEGTYPE=$PIECE(RORSEG,HLFS,1)
+9 ;we only want OBX segments
if SEGTYPE'="OBX"
QUIT
+10 SET RORLOINC=$PIECE($PIECE($GET(RORSEG),HLFS,4),HLCS,1)
+11 ;quit if not HCV LOINC
IF $GET(RORLOINC)'=""
IF '$DATA(^TMP("ROR HCV LIST",$JOB,RORLOINC))
QUIT
+12 ; HCV test result value
SET RORVAL=$PIECE(RORSEG,HLFS,6)
+13 ;get rid of any double quotes
IF $LENGTH($GET(RORVAL))>0
SET RORVAL=$TRANSLATE(RORVAL,"""","")
+14 ;if positive test result
IF $EXTRACT($GET(RORVAL),1,1)=">"
Begin DoDot:2
+15 ;add patient to HCV auto-confirm list
SET ^TMP("ROR HCV CONFIRM",$JOB,DFN)=""
+16 ;end of HCV processing for this patient
SET RORDONE=1
End DoDot:2
End DoDot:1
+17 ;
+18 QUIT
