242 lines
8.7 KiB
Mathematica
242 lines
8.7 KiB
Mathematica
|
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)
|