Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORUTL10

RORUTL10.m

Go to the documentation of this file.
  1. RORUTL10 ;HCIOFO/SG - LAB DATA SEARCH ; 10/14/05 3:29pm
  1. ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
  1. ;
  1. ; This routine uses the following IAs:
  1. ;
  1. ; #91 Read access to the file #60
  1. ; #554 Read access to the file #63
  1. ; #998 Laboratory reference from file #2
  1. ;
  1. Q
  1. ;
  1. ;***** LOADS THE LIST OF TESTS FROM THE REGISTRY PARAMETERS
  1. ;
  1. ; ROR8LTST Closed root of a variable, which will contain
  1. ; a list of lab tests of interest:
  1. ;
  1. ; @ROR8LTST@(ResultNode,TestIEN)
  1. ; ^01: Test IEN (in file #60)
  1. ; ^02: Test name
  1. ; ^03: Code of the group
  1. ; ^04: Group name
  1. ; ^05: Location subscript
  1. ; ^06: Result node
  1. ;
  1. ; REGIEN Registry IEN
  1. ;
  1. ; [GROUPS] List of codes (separated by commas) of Lab Groups
  1. ; to load (1 - CD4, 2 - CD4 %, 3 - Viral Load).
  1. ; If this parameter is undefined or empty then all
  1. ; tests will be loaded.
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 No tests are defined
  1. ; >0 Number of the tests
  1. ;
  1. LOADTSTS(ROR8LTST,REGIEN,GROUPS) ;
  1. N BUF,CNT,GRIEN,I,IEN,IENS,LTIEN,LTNODE,NAME,NODE,RC,RGIENS,RORBUF,RORMSG,TMP
  1. S RC=0,RGIENS=","_(+REGIEN)_"," K @ROR8LTST
  1. S NODE=$$ROOT^DILFD(798.128,RGIENS,1)
  1. ;--- List of Group IEN's
  1. S GROUPS=$TR($G(GROUPS)," ")
  1. D:GROUPS'=""
  1. . F I=1:1 S TMP=$P(GROUPS,",",I) Q:TMP'>0 D
  1. . . S TMP=$$ITEMIEN^RORUTL09(3,REGIEN,TMP)
  1. . . S:TMP>0 GRIEN(TMP)=""
  1. ;---
  1. S (CNT,IEN)=0
  1. F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D Q:RC<0
  1. . K RORBUF S BUF=""
  1. . ;--- Load the local test reference
  1. . S IENS=IEN_RGIENS
  1. . D GETS^DIQ(798.128,IENS,".01;.02","I","RORBUF","RORMSG")
  1. . I $G(DIERR) D Q
  1. . . S RC=$$DBS^RORERR("RORMSG",-9,,,798.128,IENS)
  1. . S (BUF,LTIEN)=+$G(RORBUF(798.128,IENS,.01,"I"))
  1. . Q:LTIEN'>0
  1. . ;--- Check the Lab Group
  1. . S GRIEN=+$G(RORBUF(798.128,IENS,.02,"I"))
  1. . I $D(GRIEN)>1 Q:'$D(GRIEN(GRIEN))
  1. . I GRIEN>0 D Q:RC<0
  1. . . S TMP=$$ITEMCODE^RORUTL09(GRIEN,.NAME)
  1. . . I TMP'>0 S:TMP<0 RC=+TMP Q
  1. . . S $P(BUF,U,3,4)=TMP_U_NAME ; Code and name of the group
  1. . ;--- Load the lab test parameters
  1. . S IENS=LTIEN_","
  1. . D GETS^DIQ(60,IENS,".01;5","EI","RORBUF","RORMSG")
  1. . I $G(DIERR) D Q
  1. . . S RC=$$DBS^RORERR("RORMSG",-9,,,60,IENS)
  1. . S LTNODE=$P($G(RORBUF(60,IENS,5,"I")),";",2)
  1. . Q:LTNODE=""
  1. . S TMP=$G(RORBUF(60,IENS,.01,"E")) ; Name of the test
  1. . S $P(BUF,U,2)=$S(TMP'="":TMP,1:"Unknown ("_LTIEN_")")
  1. . S $P(BUF,U,5)=$P(RORBUF(60,IENS,5,"I"),";",1) ; Subscript
  1. . S $P(BUF,U,6)=$P(RORBUF(60,IENS,5,"I"),";",2) ; Result node
  1. . ;--- Create the reference
  1. . S @ROR8LTST@(LTNODE,LTIEN)=BUF,CNT=CNT+1
  1. ;---
  1. Q $S(RC<0:RC,1:CNT)
  1. ;
  1. ;***** SEARCHES THE LAB DATA FOR REGISTRY SPECIFIC RESULTS
  1. ;
  1. ; PATIEN IEN of the patient (DFN)
  1. ;
  1. ; ROR8LT Closed root of a variable, which contains a list
  1. ; of lab tests of interest (in the same format as
  1. ; the list returned by the $$LOADTSTS^RORUTL10).
  1. ;
  1. ; If the "*" is passed via this parameter then all
  1. ; lab tests are considered.
  1. ;
  1. ; If this parameter has a pure numeric value then
  1. ; it is considered as registry IEN and the default
  1. ; list of registry specific tests is automatically
  1. ; compiled by the $$LOADTSTS^RORUTL10 function.
  1. ;
  1. ; [[.]ROR8DST] Closed root of an array where the results will be
  1. ; returned (the ^TMP("RORUTL10",$J), by default).
  1. ; The results will be stored into the destination
  1. ; array in following format:
  1. ;
  1. ; @ROR8DST@(i,
  1. ; 1) Result Descriptor
  1. ; ^01: IEN in the file #63 (inverted date)
  1. ; ^02: Date of the test (FileMan)
  1. ; ^03: Result
  1. ; 2) Test Descriptor
  1. ; ^01: Test IEN (in the file #60)
  1. ; ^02: Test name
  1. ; ^03: Code of the group
  1. ; ^04: Group name
  1. ; ^05: Location subscript
  1. ; ^06: Result node
  1. ;
  1. ; Example:
  1. ; S RC=$$LTSEARCH^RORUTL10(DFN,REGIEN,"RORBUF")
  1. ;
  1. ; If this parameter is passed by reference, you can
  1. ; provide a full name ($$TAG^ROUTINE) of the callback
  1. ; function, which will process and store the results,
  1. ; as the value of the "RORCB" node.
  1. ;
  1. ; Any additional nodes created in this variable will
  1. ; be accessible in the callback function. Several
  1. ; nodes are created automatically:
  1. ;
  1. ; "RORDFN" IEN of the registry patient (DFN)
  1. ;
  1. ; "ROREDT" End date
  1. ;
  1. ; "RORFLAGS" Value of parameter of the same name
  1. ;
  1. ; "RORSDT" Start date
  1. ;
  1. ; The callback function must accept 3 parameters:
  1. ;
  1. ; .ROR8DST Reference to the ROR8DST parameter.
  1. ;
  1. ; INVDT IEN of the Lab test (inverted date)
  1. ;
  1. ; .RESULT Reference to a local variable,
  1. ; which contains the result in the
  1. ; same format as it is stored into
  1. ; the destination array by default.
  1. ;
  1. ; The function should return the following values:
  1. ;
  1. ; <0 Error code (the search will be aborted)
  1. ; 0 Ok
  1. ; 1 Skip this result
  1. ; 2 Skip this and all remaining results
  1. ;
  1. ; Example:
  1. ; S RORDST=$NA(^TMP("RORBUF",$J))
  1. ; S RORDST("RORPTR")=+$O(@RORDST@(""),-1)
  1. ; S RORDST("RORCB")="$$LTCB^RORUT999"
  1. ; S RC=$$LTSEARCH^RORUTL10(DFN,REGIEN,.RORDST)
  1. ;
  1. ; [RORFLAGS] Flags to control processing (reserved)
  1. ;
  1. ; [STDT] Start date (FileMan)
  1. ; [ENDT] End date (FileMan)
  1. ;
  1. ; The search is performed exactly between provided
  1. ; boundaries (the time parts are considered).
  1. ;
  1. ; The ^TMP("RORUTL10",$J) global node is used by this function.
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 No results have been found
  1. ; >0 Number of results
  1. ;
  1. LTSEARCH(PATIEN,ROR8LT,ROR8DST,RORFLAGS,STDT,ENDT) ;
  1. N BUF,CNT,EXIT,GRC,ILDT,LTDT,LTFREE,LTIEN,LTLOC,LTNODE,LTRES,RC,ROR8SET,RORLR,RORMSG,TMP
  1. S:$G(ROR8DST)="" ROR8DST=$NA(^TMP("RORUTL10",$J))
  1. Q:$G(ROR8LT)="" 0 ; No Lab tests to search for
  1. S RORFLAGS=$G(RORFLAGS),(LTFREE,RC)=0
  1. ;
  1. ;--- Determine the storage method (default or callback)
  1. I $G(ROR8DST("RORCB"))?2"$"1.8UN1"^"1.8UN D Q:RC<0 RC
  1. . S ROR8SET="S RC="_ROR8DST("RORCB")_"(.ROR8DST,ILDT,.BUF)"
  1. . S ROR8DST("RORDFN")=PATIEN
  1. . S ROR8DST("ROREDT")=$G(ENDT)
  1. . S ROR8DST("RORFLAGS")=RORFLAGS
  1. . S ROR8DST("RORSDT")=$G(STDT)
  1. E S ROR8SET="" K @ROR8DST
  1. ;
  1. ;--- Get the Lab reference
  1. S RORLR=$P($G(^DPT(PATIEN,"LR")),U) Q:RORLR'>0 0
  1. ;
  1. ;--- Prepare the list of tests of interest
  1. I (+ROR8LT)=ROR8LT D Q:RC'>0 RC
  1. . S TMP=+ROR8LT,ROR8LT=$$ALLOC^RORTMP(),LTFREE=1
  1. . S RC=$$LOADTSTS(ROR8LT,TMP)
  1. I ROR8LT'="*",$D(@ROR8LT)<10 Q 0
  1. ;
  1. ;--- Search the Lab data
  1. S STDT=$$INVDATE^RORUTL01($S($G(STDT)>0:STDT,1:0))
  1. S ILDT=$S($G(ENDT)>0:$$INVDATE^RORUTL01(ENDT),1:0)
  1. S (CNT,RC)=0
  1. F S ILDT=$O(^LR(RORLR,"CH",ILDT)) Q:(ILDT'>0)!(ILDT>STDT) D Q:RC
  1. . S LTNODE=1
  1. . F S LTNODE=$O(^LR(RORLR,"CH",ILDT,LTNODE)) Q:LTNODE="" D Q:RC
  1. . . S LTRES=$P($G(^LR(RORLR,"CH",ILDT,LTNODE)),U)
  1. . . Q:LTRES="" ; Skip empty results
  1. . . S TMP=$$UP^XLFSTR(LTRES)
  1. . . Q:TMP["CANC" ; Skip cancelled tests
  1. . . S LTDT=$P($G(^LR(RORLR,"CH",ILDT,0)),U)
  1. . . ;--- Only selected tests
  1. . . I ROR8LT'="*" D Q
  1. . . . S LTIEN=""
  1. . . . F S LTIEN=$O(@ROR8LT@(LTNODE,LTIEN)) Q:LTIEN="" D Q:RC
  1. . . . . S GRC=$P(@ROR8LT@(LTNODE,LTIEN),U,3) Q:GRC'>0
  1. . . . . K BUF
  1. . . . . S BUF(1)=ILDT_U_LTDT_U_LTRES
  1. . . . . S BUF(2)=@ROR8LT@(LTNODE,LTIEN)
  1. . . . . ;--- Default output
  1. . . . . I ROR8SET="" S CNT=CNT+1 M @ROR8DST@(CNT)=BUF Q
  1. . . . . ;--- Callback function
  1. . . . . X ROR8SET
  1. . . . . I RC S:RC=1 RC=0 Q
  1. . . . . S CNT=CNT+1
  1. . . ;--- Consider all tests
  1. . . S LTLOC="CH;"_LTNODE_";1",LTIEN=""
  1. . . F S LTIEN=$O(^LAB(60,"C",LTLOC,LTIEN)) Q:LTIEN="" D Q:RC
  1. . . . K BUF
  1. . . . S BUF(1)=ILDT_U_LTDT_U_LTRES
  1. . . . S TMP=$$GET1^DIQ(60,LTIEN,.01,,,"RORMSG")
  1. . . . S BUF(2)=LTIEN_U_$S(TMP'="":TMP,1:"Unknown ("_LTIEN_")")
  1. . . . S $P(BUF(2),U,5,6)="CH"_U_LTNODE
  1. . . . ;--- Default output
  1. . . . I ROR8SET="" S CNT=CNT+1 M @ROR8DST@(CNT)=BUF Q
  1. . . . ;--- Callback function
  1. . . . X ROR8SET
  1. . . . I RC S:RC=1 RC=0 Q
  1. . . . S CNT=CNT+1
  1. ;
  1. ;--- Cleanup
  1. D:LTFREE FREE^RORTMP(ROR8LT)
  1. Q $S(RC<0:RC,1:CNT)