218 lines
6.6 KiB
Mathematica
218 lines
6.6 KiB
Mathematica
RORX010 ;HCIOFO/SG - LAB TESTS BY RANGE REPORT ; 12/8/05 10:39am
|
|
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|
;
|
|
; This routine uses the following IAs:
|
|
;
|
|
; #10061 DEM^VADPT (supported)
|
|
;
|
|
Q
|
|
;
|
|
;***** OUTPUTS THE REPORT HEADER
|
|
;
|
|
; PARTAG Reference (IEN) to the parent tag
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
;
|
|
HEADER(PARTAG) ;
|
|
;;PATIENTS(#,NAME,LAST4,DOD,PTLRL(GROUP,DATE,NAME,RESULT))
|
|
;
|
|
N COLUMNS,HEADER,LT,NAME,TMP
|
|
S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
|
|
Q:HEADER<0 HEADER
|
|
S RC=$$TBLDEF^RORXU002("HEADER^RORX010",HEADER)
|
|
Q $S(RC<0:RC,1:HEADER)
|
|
;
|
|
;***** COMPILES THE LAB TESTS BY RANGE REPORT
|
|
; REPORT CODE: 010
|
|
;
|
|
; .RORTSK Task number and task parameters
|
|
;
|
|
; The ^TMP("RORX010",$J) global node is used by this function.
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
;
|
|
LRGRANGE(RORTSK) ;
|
|
N RORDST ; Callback descriptor
|
|
N ROREDT ; End date
|
|
N ROREDT1 ; End date + 1 day
|
|
N RORLTL ; Closed root of the list of lab tests to search for
|
|
N RORREG ; Registry IEN
|
|
N RORSDT ; Start date
|
|
;
|
|
N BODY,CNT,ECNT,IEN,IENS,LRGLST,RC,REPORT,RORPTN,SFLAGS,TMP
|
|
;--- Root node of the report
|
|
S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
|
|
Q:REPORT<0 REPORT
|
|
;
|
|
;--- Get and prepare the report parameters
|
|
S RORREG=+$$PARAM^RORTSK01("REGIEN")
|
|
S RC=$$PARAMS(REPORT,.SFLAGS,.LRGLST) Q:RC<0 RC
|
|
;
|
|
;--- Initialize constants and variables
|
|
S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
|
|
S ROREDT1=$$FMADD^XLFDT(ROREDT\1,1),ECNT=0
|
|
K ^TMP("RORX010",$J)
|
|
S RORLTL=$$ALLOC^RORTMP()
|
|
;
|
|
;--- Prepare the search parameters
|
|
S RORDST=$NA(^TMP("RORX010",$J))
|
|
S RORDST("RORCB")="$$LTCB^RORX010"
|
|
S RC=$$LOADTSTS^RORUTL10(RORLTL,+RORREG,LRGLST)
|
|
;
|
|
;--- Report header and list of patients
|
|
S RC=$$HEADER(REPORT) G:RC<0 ERROR
|
|
S BODY=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
|
|
I BODY<0 S RC=+BODY G ERROR
|
|
D ADDATTR^RORTSK11(RORTSK,BODY,"TABLE","PATIENTS")
|
|
;
|
|
;--- Browse through the registry records
|
|
S (CNT,IEN,RC)=0
|
|
F S IEN=$O(^RORDATA(798,"AC",RORREG,IEN)) Q:IEN'>0 D Q:RC<0
|
|
. S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
|
|
. S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
|
|
. S IENS=IEN_",",CNT=CNT+1
|
|
. ;--- Check if the patient should be skipped
|
|
. Q:$$SKIP^RORXU005(IEN,SFLAGS,RORSDT,ROREDT)
|
|
. ;--- Process the registry record
|
|
. I $$PATIENT(IENS,BODY)<0 S ECNT=ECNT+1 Q
|
|
;
|
|
ERROR ;--- Cleanup
|
|
D FREE^RORTMP(RORLTL)
|
|
K ^TMP("RORX010",$J)
|
|
Q $S(RC<0:RC,ECNT>0:-43,1:0)
|
|
;
|
|
;***** CALLBACK FUNCTION FOR LAB DATA SEARCH
|
|
LTCB(RORDST,INVDT,RESULT) ;
|
|
N GRP,NODE,RC,VAL
|
|
S NODE=$NA(RORTSK("PARAMS","LRGRANGES","C"))
|
|
S GRP=+$P($G(RESULT(2)),U,3)
|
|
;--- Check the result range if necessary
|
|
I $D(@NODE@(GRP))>1 S RC=1 D Q:RC RC
|
|
. S VAL=$$CLRNMVAL^RORUTL18($P($G(RESULT(1)),U,3))
|
|
. ;--- Skip a non-numeric result
|
|
. Q:'$$NUMERIC^RORUTL05(VAL)
|
|
. ;--- Check the range
|
|
. I $G(@NODE@(GRP,"L"))'="" Q:VAL<@NODE@(GRP,"L")
|
|
. I $G(@NODE@(GRP,"H"))'="" Q:VAL>@NODE@(GRP,"H")
|
|
. S RC=0
|
|
;--- Store the result
|
|
K RORDST("GRP",GRP)
|
|
S RORDST("RORPTR")=$G(RORDST("RORPTR"))+1
|
|
M @RORDST@(RORDST("RORPTR"))=RESULT
|
|
Q 0
|
|
;
|
|
;***** OUTPUTS THE REPORT PARAMETERS
|
|
;
|
|
; PARTAG Reference (IEN) to the parent tag
|
|
;
|
|
; .FLAGS Flags for the $$SKIP^RORXU005 are
|
|
; returned via this parameter
|
|
;
|
|
; .LRGLST List of lab group codes for the $$LOADTSTS^RORUTL10
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
;
|
|
PARAMS(PARTAG,FLAGS,LRGLST) ;
|
|
N PARAMS,TMP
|
|
S (FLAGS,LRGLST)=""
|
|
S PARAMS=$$PARAMS^RORXU002(.RORTSK,PARTAG,.RORSDT,.ROREDT,.FLAGS)
|
|
Q:PARAMS<0 PARAMS
|
|
;--- Lab test ranges
|
|
I $D(RORTSK("PARAMS","LRGRANGES","C"))>1 D Q:RC<0 RC
|
|
. N GRC,ELEMENT,NODE,LRGELMTS,RANGE
|
|
. S NODE=$NA(RORTSK("PARAMS","LRGRANGES","C"))
|
|
. S LRGELMTS=$$ADDVAL^RORTSK11(RORTSK,"LRGRANGES",,PARAMS)
|
|
. S (GRC,RC)=0
|
|
. F S GRC=$O(@NODE@(GRC)) Q:GRC'>0 D Q:RC<0
|
|
. . S RANGE=0,TMP=$$RANGE(GRC)
|
|
. . S ELEMENT=$$ADDVAL^RORTSK11(RORTSK,"LRGRANGE",TMP,LRGELMTS)
|
|
. . I ELEMENT<0 S RC=ELEMENT Q
|
|
. . D ADDATTR^RORTSK11(RORTSK,ELEMENT,"ID",GRC)
|
|
. . S LRGLST=LRGLST_$S(LRGLST'="":","_GRC,1:GRC)
|
|
. . ;--- Process the range values
|
|
. . S TMP=$G(@NODE@(GRC,"L"))
|
|
. . I TMP'="" D S RANGE=1
|
|
. . . D ADDATTR^RORTSK11(RORTSK,ELEMENT,"LOW",TMP)
|
|
. . S TMP=$G(@NODE@(GRC,"H"))
|
|
. . I TMP'="" D S RANGE=1
|
|
. . . D ADDATTR^RORTSK11(RORTSK,ELEMENT,"HIGH",TMP)
|
|
. . D:RANGE ADDATTR^RORTSK11(RORTSK,ELEMENT,"RANGE",1)
|
|
;--- Success
|
|
Q PARAMS
|
|
;
|
|
;***** ADDS THE PATIENT DATA TO THE REPORT
|
|
;
|
|
; IENS IENS of the patient's record in the registry
|
|
; PARTAG Reference (IEN) to the parent tag
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
;
|
|
PATIENT(IENS,PARTAG) ;
|
|
N DFN,I,LABTESTS,LT,NAME,RC,RORBUF,RORMSG,TMP,VA,VADM
|
|
;--- Get the data from the ROR REGISTRY RECORD file
|
|
D GETS^DIQ(798,IENS,".01","I","RORBUF","RORMSG")
|
|
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798,IENS)
|
|
S DFN=$G(RORBUF(798,IENS,.01,"I"))
|
|
;--- Search for the lab results
|
|
K @RORDST,RORDST("RORPTR")
|
|
M RORDST("GRP")=RORTSK("PARAMS","LRGRANGES","C")
|
|
S RC=$$LTSEARCH^RORUTL10(DFN,RORLTL,.RORDST,,RORSDT,ROREDT1)
|
|
Q:RC'>0 RC
|
|
;--- Results from all groups should be present
|
|
Q:$D(RORDST("GRP"))>1 0
|
|
;--- Load the demographic data
|
|
D VADEM^RORUTL05(DFN,1)
|
|
;--- The <PATIENT> tag
|
|
S PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PARTAG,,DFN)
|
|
Q:PTAG<0 PTAG
|
|
;--- Patient Name
|
|
D ADDVAL^RORTSK11(RORTSK,"NAME",VADM(1),PTAG,1)
|
|
;--- Last 4 digits of the SSN
|
|
D ADDVAL^RORTSK11(RORTSK,"LAST4",VA("BID"),PTAG,2)
|
|
;--- Date of death
|
|
S TMP=$$DATE^RORXU002($P(VADM(6),U)\1)
|
|
D ADDVAL^RORTSK11(RORTSK,"DOD",TMP,PTAG,1)
|
|
;--- Lab results
|
|
S LABTESTS=$$ADDVAL^RORTSK11(RORTSK,"PTLRL",,PTAG)
|
|
S I=""
|
|
F S I=$O(@RORDST@(I)) Q:I="" D
|
|
. S LT=$$ADDVAL^RORTSK11(RORTSK,"LT",,LABTESTS)
|
|
. D ADDVAL^RORTSK11(RORTSK,"GROUP",$P(@RORDST@(I,2),U,4),LT,1)
|
|
. D ADDVAL^RORTSK11(RORTSK,"DATE",$P(@RORDST@(I,1),U,2),LT,1)
|
|
. D ADDVAL^RORTSK11(RORTSK,"NAME",$P(@RORDST@(I,2),U,2),LT,1)
|
|
. D ADDVAL^RORTSK11(RORTSK,"RESULT",$P(@RORDST@(I,1),U,3),LT,3)
|
|
;---
|
|
Q $S(RC<0:RC,1:0)
|
|
;
|
|
;***** PROCESSES THE RESULT RANGE OPTIONS
|
|
;
|
|
; GRC Code of a Lab Group
|
|
;
|
|
; Return Values:
|
|
; Description of the Lab results to be included in the report.
|
|
;
|
|
RANGE(GRC) ;
|
|
N RANGE,TMP
|
|
S RANGE=""
|
|
;--- Range
|
|
D:$D(RORTSK("PARAMS","LRGRANGES","C",GRC))>1
|
|
. ;--- Low
|
|
. S TMP=$G(RORTSK("PARAMS","LRGRANGES","C",GRC,"L"))
|
|
. S:TMP'="" RANGE=RANGE_" not less than "_TMP
|
|
. ;--- High
|
|
. S TMP=$G(RORTSK("PARAMS","LRGRANGES","C",GRC,"H"))
|
|
. I TMP'="" D:RANGE'="" S RANGE=RANGE_" not greater than "_TMP
|
|
. . S RANGE=RANGE_" and"
|
|
;--- Description
|
|
S TMP=$G(RORTSK("PARAMS","LRGRANGES","C",GRC))
|
|
S:TMP="" TMP="Unknown ("_GRC_")"
|
|
Q TMP_" - "_$S(RANGE'="":"numeric results"_RANGE,1:"all results")
|