- 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 Jan 18, 2025@02:45:17 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)