Routine: RORUPD04

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

 ;******************************************************************************

 ;******************************************************************************

 ;                       --- 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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORUPD04   8805     printed  Apr 23, 2025@17:58:06                                                                                                                                                                                                    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

RORUPD04.m