RORUTL10 ;HCIOFO/SG - LAB DATA SEARCH ; 10/14/05 3:29pm
 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
 ;
 ; This routine uses the following IAs:
 ;
 ; #91           Read access to the file #60
 ; #554          Read access to the file #63
 ; #998          Laboratory reference from file #2
 ;
 Q
 ;
 ;***** LOADS THE LIST OF TESTS FROM THE REGISTRY PARAMETERS
 ;
 ; ROR8LTST      Closed root of a variable, which will contain
 ;               a list of lab tests of interest:
 ;
 ;               @ROR8LTST@(ResultNode,TestIEN)
 ;                 ^01: Test IEN (in file #60)
 ;                 ^02: Test name
 ;                 ^03: Code of the group
 ;                 ^04: Group name
 ;                 ^05: Location subscript
 ;                 ^06: Result node
 ;
 ; REGIEN        Registry IEN
 ;
 ; [GROUPS]      List of codes (separated by commas) of Lab Groups
 ;               to load (1 - CD4, 2 - CD4 %, 3 - Viral Load).
 ;               If this parameter is undefined or empty then all
 ;               tests will be loaded.
 ;
 ; Return Values:
 ;       <0  Error code
 ;        0  No tests are defined
 ;       >0  Number of the tests
 ;
LOADTSTS(ROR8LTST,REGIEN,GROUPS) ;
 N BUF,CNT,GRIEN,I,IEN,IENS,LTIEN,LTNODE,NAME,NODE,RC,RGIENS,RORBUF,RORMSG,TMP
 S RC=0,RGIENS=","_(+REGIEN)_","  K @ROR8LTST
 S NODE=$$ROOT^DILFD(798.128,RGIENS,1)
 ;--- List of Group IEN's
 S GROUPS=$TR($G(GROUPS)," ")
 D:GROUPS'=""
 . F I=1:1  S TMP=$P(GROUPS,",",I)  Q:TMP'>0  D
 . . S TMP=$$ITEMIEN^RORUTL09(3,REGIEN,TMP)
 . . S:TMP>0 GRIEN(TMP)=""
 ;---
 S (CNT,IEN)=0
 F  S IEN=$O(@NODE@(IEN))  Q:IEN'>0  D  Q:RC<0
 . K RORBUF  S BUF=""
 . ;--- Load the local test reference
 . S IENS=IEN_RGIENS
 . D GETS^DIQ(798.128,IENS,".01;.02","I","RORBUF","RORMSG")
 . I $G(DIERR)  D  Q
 . . S RC=$$DBS^RORERR("RORMSG",-9,,,798.128,IENS)
 . S (BUF,LTIEN)=+$G(RORBUF(798.128,IENS,.01,"I"))
 . Q:LTIEN'>0
 . ;--- Check the Lab Group
 . S GRIEN=+$G(RORBUF(798.128,IENS,.02,"I"))
 . I $D(GRIEN)>1  Q:'$D(GRIEN(GRIEN))
 . I GRIEN>0  D  Q:RC<0
 . . S TMP=$$ITEMCODE^RORUTL09(GRIEN,.NAME)
 . . I TMP'>0  S:TMP<0 RC=+TMP  Q
 . . S $P(BUF,U,3,4)=TMP_U_NAME  ; Code and name of the group
 . ;--- Load the lab test parameters
 . S IENS=LTIEN_","
 . D GETS^DIQ(60,IENS,".01;5","EI","RORBUF","RORMSG")
 . I $G(DIERR)  D  Q
 . . S RC=$$DBS^RORERR("RORMSG",-9,,,60,IENS)
 . S LTNODE=$P($G(RORBUF(60,IENS,5,"I")),";",2)
 . Q:LTNODE=""
 . S TMP=$G(RORBUF(60,IENS,.01,"E"))             ; Name of the test
 . S $P(BUF,U,2)=$S(TMP'="":TMP,1:"Unknown ("_LTIEN_")")
 . S $P(BUF,U,5)=$P(RORBUF(60,IENS,5,"I"),";",1) ; Subscript
 . S $P(BUF,U,6)=$P(RORBUF(60,IENS,5,"I"),";",2) ; Result node
 . ;--- Create the reference
 . S @ROR8LTST@(LTNODE,LTIEN)=BUF,CNT=CNT+1
 ;---
 Q $S(RC<0:RC,1:CNT)
 ;
 ;***** SEARCHES THE LAB DATA FOR REGISTRY SPECIFIC RESULTS
 ;
 ; PATIEN        IEN of the patient (DFN)
 ;
 ; ROR8LT        Closed root of a variable, which contains a list
 ;               of lab tests of interest (in the same format as
 ;               the list returned by the $$LOADTSTS^RORUTL10).
 ;
 ;               If the "*" is passed via this parameter then all
 ;               lab tests are considered.
 ;
 ;               If this parameter has a pure numeric value then
 ;               it is considered as registry IEN and the default
 ;               list of registry specific tests is automatically
 ;               compiled by the $$LOADTSTS^RORUTL10 function.
 ;
 ; [[.]ROR8DST]  Closed root of an array where the results will be
 ;               returned (the ^TMP("RORUTL10",$J), by default).
 ;               The results will be stored into the destination
 ;               array in following format:
 ;
 ;                 @ROR8DST@(i,
 ;                   1)  Result Descriptor
 ;                         ^01: IEN in the file #63 (inverted date)
 ;                         ^02: Date of the test (FileMan)
 ;                         ^03: Result
 ;                   2)  Test Descriptor
 ;                         ^01: Test IEN (in the file #60)
 ;                         ^02: Test name
 ;                         ^03: Code of the group
 ;                         ^04: Group name
 ;                         ^05: Location subscript
 ;                         ^06: Result node
 ;
 ;               Example:
 ;                 S RC=$$LTSEARCH^RORUTL10(DFN,REGIEN,"RORBUF")
 ;
 ;               If this parameter is passed by reference, you can
 ;               provide a full name ($$TAG^ROUTINE) of the callback
 ;               function, which will process and store the results,
 ;               as the value of the "RORCB" node.
 ;
 ;               Any additional nodes created in this variable will
 ;               be accessible in the callback function. Several
 ;               nodes are created automatically:
 ;
 ;                 "RORDFN"      IEN of the registry patient (DFN)
 ;
 ;                 "ROREDT"      End date
 ;
 ;                 "RORFLAGS"    Value of parameter of the same name
 ;
 ;                 "RORSDT"      Start date
 ;
 ;               The callback function must accept 3 parameters:
 ;
 ;                 .ROR8DST      Reference to the ROR8DST parameter.
 ;
 ;                 INVDT         IEN of the Lab test (inverted date)
 ;
 ;                 .RESULT       Reference to a local variable,
 ;                               which contains the result in the
 ;                               same format as it is stored into
 ;                               the destination array by default.
 ;
 ;               The function should return the following values:
 ;
 ;                 <0  Error code (the search will be aborted)
 ;                  0  Ok
 ;                  1  Skip this result
 ;                  2  Skip this and all remaining results
 ;
 ;               Example:
 ;                 S RORDST=$NA(^TMP("RORBUF",$J))
 ;                 S RORDST("RORPTR")=+$O(@RORDST@(""),-1)
 ;                 S RORDST("RORCB")="$$LTCB^RORUT999"
 ;                 S RC=$$LTSEARCH^RORUTL10(DFN,REGIEN,.RORDST)
 ;
 ; [RORFLAGS]    Flags to control processing (reserved)
 ;
 ; [STDT]        Start date (FileMan)
 ; [ENDT]        End date   (FileMan)
 ;
 ;               The search is performed exactly between provided
 ;               boundaries (the time parts are considered).
 ;
 ; The ^TMP("RORUTL10",$J) global node is used by this function.
 ;
 ; Return Values:
 ;       <0  Error code
 ;        0  No results have been found
 ;       >0  Number of results
 ;
LTSEARCH(PATIEN,ROR8LT,ROR8DST,RORFLAGS,STDT,ENDT) ;
 N BUF,CNT,EXIT,GRC,ILDT,LTDT,LTFREE,LTIEN,LTLOC,LTNODE,LTRES,RC,ROR8SET,RORLR,RORMSG,TMP
 S:$G(ROR8DST)="" ROR8DST=$NA(^TMP("RORUTL10",$J))
 Q:$G(ROR8LT)="" 0  ; No Lab tests to search for
 S RORFLAGS=$G(RORFLAGS),(LTFREE,RC)=0
 ;
 ;--- Determine the storage method (default or callback)
 I $G(ROR8DST("RORCB"))?2"$"1.8UN1"^"1.8UN  D  Q:RC<0 RC
 . S ROR8SET="S RC="_ROR8DST("RORCB")_"(.ROR8DST,ILDT,.BUF)"
 . S ROR8DST("RORDFN")=PATIEN
 . S ROR8DST("ROREDT")=$G(ENDT)
 . S ROR8DST("RORFLAGS")=RORFLAGS
 . S ROR8DST("RORSDT")=$G(STDT)
 E  S ROR8SET=""  K @ROR8DST
 ;
 ;--- Get the Lab reference
 S RORLR=$P($G(^DPT(PATIEN,"LR")),U)  Q:RORLR'>0 0
 ;
 ;--- Prepare the list of tests of interest
 I (+ROR8LT)=ROR8LT  D  Q:RC'>0 RC
 . S TMP=+ROR8LT,ROR8LT=$$ALLOC^RORTMP(),LTFREE=1
 . S RC=$$LOADTSTS(ROR8LT,TMP)
 I ROR8LT'="*",$D(@ROR8LT)<10  Q 0
 ;
 ;--- Search the Lab data
 S STDT=$$INVDATE^RORUTL01($S($G(STDT)>0:STDT,1:0))
 S ILDT=$S($G(ENDT)>0:$$INVDATE^RORUTL01(ENDT),1:0)
 S (CNT,RC)=0
 F  S ILDT=$O(^LR(RORLR,"CH",ILDT))  Q:(ILDT'>0)!(ILDT>STDT)  D  Q:RC
 . S LTNODE=1
 . F  S LTNODE=$O(^LR(RORLR,"CH",ILDT,LTNODE))  Q:LTNODE=""  D  Q:RC
 . . S LTRES=$P($G(^LR(RORLR,"CH",ILDT,LTNODE)),U)
 . . Q:LTRES=""    ; Skip empty results
 . . S TMP=$$UP^XLFSTR(LTRES)
 . . Q:TMP["CANC"  ; Skip cancelled tests
 . . S LTDT=$P($G(^LR(RORLR,"CH",ILDT,0)),U)
 . . ;--- Only selected tests
 . . I ROR8LT'="*"  D  Q
 . . . S LTIEN=""
 . . . F  S LTIEN=$O(@ROR8LT@(LTNODE,LTIEN))  Q:LTIEN=""  D  Q:RC
 . . . . S GRC=$P(@ROR8LT@(LTNODE,LTIEN),U,3)  Q:GRC'>0
 . . . . K BUF
 . . . . S BUF(1)=ILDT_U_LTDT_U_LTRES
 . . . . S BUF(2)=@ROR8LT@(LTNODE,LTIEN)
 . . . . ;--- Default output
 . . . . I ROR8SET=""  S CNT=CNT+1  M @ROR8DST@(CNT)=BUF  Q
 . . . . ;--- Callback function
 . . . . X ROR8SET
 . . . . I RC  S:RC=1 RC=0  Q
 . . . . S CNT=CNT+1
 . . ;--- Consider all tests
 . . S LTLOC="CH;"_LTNODE_";1",LTIEN=""
 . . F  S LTIEN=$O(^LAB(60,"C",LTLOC,LTIEN))  Q:LTIEN=""  D  Q:RC
 . . . K BUF
 . . . S BUF(1)=ILDT_U_LTDT_U_LTRES
 . . . S TMP=$$GET1^DIQ(60,LTIEN,.01,,,"RORMSG")
 . . . S BUF(2)=LTIEN_U_$S(TMP'="":TMP,1:"Unknown ("_LTIEN_")")
 . . . S $P(BUF(2),U,5,6)="CH"_U_LTNODE
 . . . ;--- Default output
 . . . I ROR8SET=""  S CNT=CNT+1  M @ROR8DST@(CNT)=BUF  Q
 . . . ;--- Callback function
 . . . X ROR8SET
 . . . I RC  S:RC=1 RC=0  Q
 . . . S CNT=CNT+1
 ;
 ;--- Cleanup
 D:LTFREE FREE^RORTMP(ROR8LT)
 Q $S(RC<0:RC,1:CNT)
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORUTL10   9181     printed  Sep 23, 2025@19:20:03                                                                                                                                                                                                    Page 2
RORUTL10  ;HCIOFO/SG - LAB DATA SEARCH ; 10/14/05 3:29pm
 +1       ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
 +2       ;
 +3       ; This routine uses the following IAs:
 +4       ;
 +5       ; #91           Read access to the file #60
 +6       ; #554          Read access to the file #63
 +7       ; #998          Laboratory reference from file #2
 +8       ;
 +9        QUIT 
 +10      ;
 +11      ;***** LOADS THE LIST OF TESTS FROM THE REGISTRY PARAMETERS
 +12      ;
 +13      ; ROR8LTST      Closed root of a variable, which will contain
 +14      ;               a list of lab tests of interest:
 +15      ;
 +16      ;               @ROR8LTST@(ResultNode,TestIEN)
 +17      ;                 ^01: Test IEN (in file #60)
 +18      ;                 ^02: Test name
 +19      ;                 ^03: Code of the group
 +20      ;                 ^04: Group name
 +21      ;                 ^05: Location subscript
 +22      ;                 ^06: Result node
 +23      ;
 +24      ; REGIEN        Registry IEN
 +25      ;
 +26      ; [GROUPS]      List of codes (separated by commas) of Lab Groups
 +27      ;               to load (1 - CD4, 2 - CD4 %, 3 - Viral Load).
 +28      ;               If this parameter is undefined or empty then all
 +29      ;               tests will be loaded.
 +30      ;
 +31      ; Return Values:
 +32      ;       <0  Error code
 +33      ;        0  No tests are defined
 +34      ;       >0  Number of the tests
 +35      ;
LOADTSTS(ROR8LTST,REGIEN,GROUPS) ;
 +1        NEW BUF,CNT,GRIEN,I,IEN,IENS,LTIEN,LTNODE,NAME,NODE,RC,RGIENS,RORBUF,RORMSG,TMP
 +2        SET RC=0
           SET RGIENS=","_(+REGIEN)_","
           KILL @ROR8LTST
 +3        SET NODE=$$ROOT^DILFD(798.128,RGIENS,1)
 +4       ;--- List of Group IEN's
 +5        SET GROUPS=$TRANSLATE($GET(GROUPS)," ")
 +6        if GROUPS'=""
               Begin DoDot:1
 +7                FOR I=1:1
                       SET TMP=$PIECE(GROUPS,",",I)
                       if TMP'>0
                           QUIT 
                       Begin DoDot:2
 +8                        SET TMP=$$ITEMIEN^RORUTL09(3,REGIEN,TMP)
 +9                        if TMP>0
                               SET GRIEN(TMP)=""
                       End DoDot:2
               End DoDot:1
 +10      ;---
 +11       SET (CNT,IEN)=0
 +12       FOR 
               SET IEN=$ORDER(@NODE@(IEN))
               if IEN'>0
                   QUIT 
               Begin DoDot:1
 +13               KILL RORBUF
                   SET BUF=""
 +14      ;--- Load the local test reference
 +15               SET IENS=IEN_RGIENS
 +16               DO GETS^DIQ(798.128,IENS,".01;.02","I","RORBUF","RORMSG")
 +17               IF $GET(DIERR)
                       Begin DoDot:2
 +18                       SET RC=$$DBS^RORERR("RORMSG",-9,,,798.128,IENS)
                       End DoDot:2
                       QUIT 
 +19               SET (BUF,LTIEN)=+$GET(RORBUF(798.128,IENS,.01,"I"))
 +20               if LTIEN'>0
                       QUIT 
 +21      ;--- Check the Lab Group
 +22               SET GRIEN=+$GET(RORBUF(798.128,IENS,.02,"I"))
 +23               IF $DATA(GRIEN)>1
                       if '$DATA(GRIEN(GRIEN))
                           QUIT 
 +24               IF GRIEN>0
                       Begin DoDot:2
 +25                       SET TMP=$$ITEMCODE^RORUTL09(GRIEN,.NAME)
 +26                       IF TMP'>0
                               if TMP<0
                                   SET RC=+TMP
                               QUIT 
 +27      ; Code and name of the group
                           SET $PIECE(BUF,U,3,4)=TMP_U_NAME
                       End DoDot:2
                       if RC<0
                           QUIT 
 +28      ;--- Load the lab test parameters
 +29               SET IENS=LTIEN_","
 +30               DO GETS^DIQ(60,IENS,".01;5","EI","RORBUF","RORMSG")
 +31               IF $GET(DIERR)
                       Begin DoDot:2
 +32                       SET RC=$$DBS^RORERR("RORMSG",-9,,,60,IENS)
                       End DoDot:2
                       QUIT 
 +33               SET LTNODE=$PIECE($GET(RORBUF(60,IENS,5,"I")),";",2)
 +34               if LTNODE=""
                       QUIT 
 +35      ; Name of the test
                   SET TMP=$GET(RORBUF(60,IENS,.01,"E"))
 +36               SET $PIECE(BUF,U,2)=$SELECT(TMP'="":TMP,1:"Unknown ("_LTIEN_")")
 +37      ; Subscript
                   SET $PIECE(BUF,U,5)=$PIECE(RORBUF(60,IENS,5,"I"),";",1)
 +38      ; Result node
                   SET $PIECE(BUF,U,6)=$PIECE(RORBUF(60,IENS,5,"I"),";",2)
 +39      ;--- Create the reference
 +40               SET @ROR8LTST@(LTNODE,LTIEN)=BUF
                   SET CNT=CNT+1
               End DoDot:1
               if RC<0
                   QUIT 
 +41      ;---
 +42       QUIT $SELECT(RC<0:RC,1:CNT)
 +43      ;
 +44      ;***** SEARCHES THE LAB DATA FOR REGISTRY SPECIFIC RESULTS
 +45      ;
 +46      ; PATIEN        IEN of the patient (DFN)
 +47      ;
 +48      ; ROR8LT        Closed root of a variable, which contains a list
 +49      ;               of lab tests of interest (in the same format as
 +50      ;               the list returned by the $$LOADTSTS^RORUTL10).
 +51      ;
 +52      ;               If the "*" is passed via this parameter then all
 +53      ;               lab tests are considered.
 +54      ;
 +55      ;               If this parameter has a pure numeric value then
 +56      ;               it is considered as registry IEN and the default
 +57      ;               list of registry specific tests is automatically
 +58      ;               compiled by the $$LOADTSTS^RORUTL10 function.
 +59      ;
 +60      ; [[.]ROR8DST]  Closed root of an array where the results will be
 +61      ;               returned (the ^TMP("RORUTL10",$J), by default).
 +62      ;               The results will be stored into the destination
 +63      ;               array in following format:
 +64      ;
 +65      ;                 @ROR8DST@(i,
 +66      ;                   1)  Result Descriptor
 +67      ;                         ^01: IEN in the file #63 (inverted date)
 +68      ;                         ^02: Date of the test (FileMan)
 +69      ;                         ^03: Result
 +70      ;                   2)  Test Descriptor
 +71      ;                         ^01: Test IEN (in the file #60)
 +72      ;                         ^02: Test name
 +73      ;                         ^03: Code of the group
 +74      ;                         ^04: Group name
 +75      ;                         ^05: Location subscript
 +76      ;                         ^06: Result node
 +77      ;
 +78      ;               Example:
 +79      ;                 S RC=$$LTSEARCH^RORUTL10(DFN,REGIEN,"RORBUF")
 +80      ;
 +81      ;               If this parameter is passed by reference, you can
 +82      ;               provide a full name ($$TAG^ROUTINE) of the callback
 +83      ;               function, which will process and store the results,
 +84      ;               as the value of the "RORCB" node.
 +85      ;
 +86      ;               Any additional nodes created in this variable will
 +87      ;               be accessible in the callback function. Several
 +88      ;               nodes are created automatically:
 +89      ;
 +90      ;                 "RORDFN"      IEN of the registry patient (DFN)
 +91      ;
 +92      ;                 "ROREDT"      End date
 +93      ;
 +94      ;                 "RORFLAGS"    Value of parameter of the same name
 +95      ;
 +96      ;                 "RORSDT"      Start date
 +97      ;
 +98      ;               The callback function must accept 3 parameters:
 +99      ;
 +100     ;                 .ROR8DST      Reference to the ROR8DST parameter.
 +101     ;
 +102     ;                 INVDT         IEN of the Lab test (inverted date)
 +103     ;
 +104     ;                 .RESULT       Reference to a local variable,
 +105     ;                               which contains the result in the
 +106     ;                               same format as it is stored into
 +107     ;                               the destination array by default.
 +108     ;
 +109     ;               The function should return the following values:
 +110     ;
 +111     ;                 <0  Error code (the search will be aborted)
 +112     ;                  0  Ok
 +113     ;                  1  Skip this result
 +114     ;                  2  Skip this and all remaining results
 +115     ;
 +116     ;               Example:
 +117     ;                 S RORDST=$NA(^TMP("RORBUF",$J))
 +118     ;                 S RORDST("RORPTR")=+$O(@RORDST@(""),-1)
 +119     ;                 S RORDST("RORCB")="$$LTCB^RORUT999"
 +120     ;                 S RC=$$LTSEARCH^RORUTL10(DFN,REGIEN,.RORDST)
 +121     ;
 +122     ; [RORFLAGS]    Flags to control processing (reserved)
 +123     ;
 +124     ; [STDT]        Start date (FileMan)
 +125     ; [ENDT]        End date   (FileMan)
 +126     ;
 +127     ;               The search is performed exactly between provided
 +128     ;               boundaries (the time parts are considered).
 +129     ;
 +130     ; The ^TMP("RORUTL10",$J) global node is used by this function.
 +131     ;
 +132     ; Return Values:
 +133     ;       <0  Error code
 +134     ;        0  No results have been found
 +135     ;       >0  Number of results
 +136     ;
LTSEARCH(PATIEN,ROR8LT,ROR8DST,RORFLAGS,STDT,ENDT) ;
 +1        NEW BUF,CNT,EXIT,GRC,ILDT,LTDT,LTFREE,LTIEN,LTLOC,LTNODE,LTRES,RC,ROR8SET,RORLR,RORMSG,TMP
 +2        if $GET(ROR8DST)=""
               SET ROR8DST=$NAME(^TMP("RORUTL10",$JOB))
 +3       ; No Lab tests to search for
           if $GET(ROR8LT)=""
               QUIT 0
 +4        SET RORFLAGS=$GET(RORFLAGS)
           SET (LTFREE,RC)=0
 +5       ;
 +6       ;--- Determine the storage method (default or callback)
 +7        IF $GET(ROR8DST("RORCB"))?2"$"1.8UN1"^"1.8UN
               Begin DoDot:1
 +8                SET ROR8SET="S RC="_ROR8DST("RORCB")_"(.ROR8DST,ILDT,.BUF)"
 +9                SET ROR8DST("RORDFN")=PATIEN
 +10               SET ROR8DST("ROREDT")=$GET(ENDT)
 +11               SET ROR8DST("RORFLAGS")=RORFLAGS
 +12               SET ROR8DST("RORSDT")=$GET(STDT)
               End DoDot:1
               if RC<0
                   QUIT RC
 +13      IF '$TEST
               SET ROR8SET=""
               KILL @ROR8DST
 +14      ;
 +15      ;--- Get the Lab reference
 +16       SET RORLR=$PIECE($GET(^DPT(PATIEN,"LR")),U)
           if RORLR'>0
               QUIT 0
 +17      ;
 +18      ;--- Prepare the list of tests of interest
 +19       IF (+ROR8LT)=ROR8LT
               Begin DoDot:1
 +20               SET TMP=+ROR8LT
                   SET ROR8LT=$$ALLOC^RORTMP()
                   SET LTFREE=1
 +21               SET RC=$$LOADTSTS(ROR8LT,TMP)
               End DoDot:1
               if RC'>0
                   QUIT RC
 +22       IF ROR8LT'="*"
               IF $DATA(@ROR8LT)<10
                   QUIT 0
 +23      ;
 +24      ;--- Search the Lab data
 +25       SET STDT=$$INVDATE^RORUTL01($SELECT($GET(STDT)>0:STDT,1:0))
 +26       SET ILDT=$SELECT($GET(ENDT)>0:$$INVDATE^RORUTL01(ENDT),1:0)
 +27       SET (CNT,RC)=0
 +28       FOR 
               SET ILDT=$ORDER(^LR(RORLR,"CH",ILDT))
               if (ILDT'>0)!(ILDT>STDT)
                   QUIT 
               Begin DoDot:1
 +29               SET LTNODE=1
 +30               FOR 
                       SET LTNODE=$ORDER(^LR(RORLR,"CH",ILDT,LTNODE))
                       if LTNODE=""
                           QUIT 
                       Begin DoDot:2
 +31                       SET LTRES=$PIECE($GET(^LR(RORLR,"CH",ILDT,LTNODE)),U)
 +32      ; Skip empty results
                           if LTRES=""
                               QUIT 
 +33                       SET TMP=$$UP^XLFSTR(LTRES)
 +34      ; Skip cancelled tests
                           if TMP["CANC"
                               QUIT 
 +35                       SET LTDT=$PIECE($GET(^LR(RORLR,"CH",ILDT,0)),U)
 +36      ;--- Only selected tests
 +37                       IF ROR8LT'="*"
                               Begin DoDot:3
 +38                               SET LTIEN=""
 +39                               FOR 
                                       SET LTIEN=$ORDER(@ROR8LT@(LTNODE,LTIEN))
                                       if LTIEN=""
                                           QUIT 
                                       Begin DoDot:4
 +40                                       SET GRC=$PIECE(@ROR8LT@(LTNODE,LTIEN),U,3)
                                           if GRC'>0
                                               QUIT 
 +41                                       KILL BUF
 +42                                       SET BUF(1)=ILDT_U_LTDT_U_LTRES
 +43                                       SET BUF(2)=@ROR8LT@(LTNODE,LTIEN)
 +44      ;--- Default output
 +45                                       IF ROR8SET=""
                                               SET CNT=CNT+1
                                               MERGE @ROR8DST@(CNT)=BUF
                                               QUIT 
 +46      ;--- Callback function
 +47                                       XECUTE ROR8SET
 +48                                       IF RC
                                               if RC=1
                                                   SET RC=0
                                               QUIT 
 +49                                       SET CNT=CNT+1
                                       End DoDot:4
                                       if RC
                                           QUIT 
                               End DoDot:3
                               QUIT 
 +50      ;--- Consider all tests
 +51                       SET LTLOC="CH;"_LTNODE_";1"
                           SET LTIEN=""
 +52                       FOR 
                               SET LTIEN=$ORDER(^LAB(60,"C",LTLOC,LTIEN))
                               if LTIEN=""
                                   QUIT 
                               Begin DoDot:3
 +53                               KILL BUF
 +54                               SET BUF(1)=ILDT_U_LTDT_U_LTRES
 +55                               SET TMP=$$GET1^DIQ(60,LTIEN,.01,,,"RORMSG")
 +56                               SET BUF(2)=LTIEN_U_$SELECT(TMP'="":TMP,1:"Unknown ("_LTIEN_")")
 +57                               SET $PIECE(BUF(2),U,5,6)="CH"_U_LTNODE
 +58      ;--- Default output
 +59                               IF ROR8SET=""
                                       SET CNT=CNT+1
                                       MERGE @ROR8DST@(CNT)=BUF
                                       QUIT 
 +60      ;--- Callback function
 +61                               XECUTE ROR8SET
 +62                               IF RC
                                       if RC=1
                                           SET RC=0
                                       QUIT 
 +63                               SET CNT=CNT+1
                               End DoDot:3
                               if RC
                                   QUIT 
                       End DoDot:2
                       if RC
                           QUIT 
               End DoDot:1
               if RC
                   QUIT 
 +64      ;
 +65      ;--- Cleanup
 +66       if LTFREE
               DO FREE^RORTMP(ROR8LT)
 +67       QUIT $SELECT(RC<0:RC,1:CNT)