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")