248 lines
7.8 KiB
Mathematica
248 lines
7.8 KiB
Mathematica
RORXU002 ;HCIOFO/SG - REPORT BUILDER UTILITIES ; 5/18/06 11:13am
|
|
;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
|
|
;
|
|
Q
|
|
;
|
|
;***** SCANS THE TABLE DEFINITION (RORSRC) FOR COLUMN NAMES
|
|
;
|
|
; .TERM Reference to a local variable where
|
|
; is terminator is returned
|
|
;
|
|
; Return Values:
|
|
; "" End of definition
|
|
; ... Name of the column
|
|
;
|
|
COLSCAN(TERM) ;
|
|
N CH,I,TOKEN
|
|
F I=1:1 S TERM=$E(RORSRC,I) Q:"(,)"[TERM
|
|
S TOKEN=$E(RORSRC,1,I-1)
|
|
F I=I+1:1 S CH=$E(RORSRC,I) Q:(CH="")!("(,)"'[CH)
|
|
S $E(RORSRC,1,I-1)=""
|
|
Q TOKEN
|
|
;
|
|
;***** CHECKS THE FILEMAN DATE/TIME VALUE
|
|
DATE(DT) ;
|
|
Q $S(DT>0:+DT,1:"")
|
|
;
|
|
;***** OUTPUTS THE BASIC HEADER TO THE REPORT
|
|
;
|
|
; .RORTSK Task number and task parameters
|
|
;
|
|
; PARTAG Reference (IEN) to the parent tag
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; >0 IEN of the HEADER element
|
|
;
|
|
HEADER(RORTSK,PARTAG) ;
|
|
N HEADER,IENS,REGIEN,RORBUF,RORMSG,TMP
|
|
S HEADER=$$ADDVAL^RORTSK11(RORTSK,"HEADER",,PARTAG)
|
|
Q:HEADER<0 HEADER
|
|
D ADDVAL^RORTSK11(RORTSK,"DATE",$$DATE($$NOW^XLFDT),HEADER)
|
|
D ADDVAL^RORTSK11(RORTSK,"TASK_NUMBER",RORTSK,HEADER)
|
|
S REGIEN=+$$PARAM^RORTSK01("REGIEN")
|
|
;---
|
|
S IENS=REGIEN_","
|
|
D GETS^DIQ(798.1,IENS,"1;2","I","RORBUF","RORMSG")
|
|
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798.1,IENS)
|
|
S TMP=$G(RORBUF(798.1,IENS,1,"I"))
|
|
D ADDVAL^RORTSK11(RORTSK,"UPDATED_UNTIL",$$DATE(TMP),HEADER)
|
|
S TMP=$G(RORBUF(798.1,IENS,2,"I"))
|
|
D ADDVAL^RORTSK11(RORTSK,"EXTRACTED_UNTIL",$$DATE(TMP),HEADER)
|
|
Q HEADER
|
|
;
|
|
;***** PARSES THE COMMA-SEPARATED LIST
|
|
;
|
|
; .LIST Reference to a local variable that contains a list.
|
|
; Items of the list are returned as the subscripts of
|
|
; this variable.
|
|
;
|
|
LIST(LIST) ;
|
|
N I,TMP,VAL
|
|
F I=1:1 S VAL=$P(LIST,",",I) Q:VAL="" D
|
|
. S TMP=$$TRIM^XLFSTR(VAL)
|
|
. S:TMP'="" LIST(TMP)=""
|
|
Q
|
|
;
|
|
;***** COMPILES A TEXT DESCRIPTION FOR THE REPORT OPTIONS
|
|
;
|
|
; .OPTIONS Reference to a local variable containing
|
|
; the options as subscripts
|
|
;
|
|
; [DLGNUM] Number of the dialog that contains the template
|
|
; (7980000.018, by default).
|
|
;
|
|
; Return Values:
|
|
; ... Text description of the options
|
|
;
|
|
OPTXT(OPTIONS,DLGNUM) ;
|
|
N I,J,NS,RORBUF,TEXT,TMP
|
|
S:$G(DLGNUM)'>0 DLGNUM=7980000.018
|
|
D BLD^DIALOG(DLGNUM,,,"RORBUF")
|
|
S TEXT="",I=0
|
|
F S I=$O(RORBUF(I)) Q:I="" D:$E(RORBUF(I),1)'=" "
|
|
. S NS=0
|
|
. F J=1:1 S TMP=$TR($P(RORBUF(I),",",J)," ") Q:TMP="" D
|
|
. . S:$D(OPTIONS(TMP)) NS=2**(J-1)+NS
|
|
. Q:'NS
|
|
. S TMP=$$TRIM^XLFSTR($G(RORBUF(I+NS)))
|
|
. S:TMP'="" TEXT=TEXT_", "_TMP
|
|
Q $P(TEXT,", ",2,999)
|
|
;
|
|
;***** OUTPUTS THE PARAMETERS TO THE REPORT
|
|
;
|
|
; .RORTSK Task number and task parameters
|
|
;
|
|
; PARTAG Reference (IEN) to the parent tag
|
|
;
|
|
; .STDT Start and end dates of the report
|
|
; .ENDT are returned via these parameters
|
|
;
|
|
; [.FLAGS] Flags for the $$SKIP^RORXU005 are returned via this
|
|
; parameter. The "D" (skip deceased patients) and "G"
|
|
; (skip pending patients) flags are always added.
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; >0 IEN of the PARAMETERS element
|
|
;
|
|
PARAMS(RORTSK,PARTAG,STDT,ENDT,FLAGS) ;
|
|
N BUF,ELEMENT,I,LTAG,MODE,NAME,PARAMS,RC,REGIEN,RORMSG,TMP
|
|
S PARAMS=$$ADDVAL^RORTSK11(RORTSK,"PARAMETERS",,PARTAG)
|
|
S RC=0,(ENDT,STDT)="",FLAGS=""
|
|
;
|
|
;=== Registry name
|
|
S REGIEN=+$$PARAM^RORTSK01("REGIEN")
|
|
I REGIEN>0 D Q:RC<0 RC
|
|
. S TMP=$P($$REGNAME^RORUTL01(REGIEN),U)
|
|
. I TMP="" S RC=-1 Q
|
|
. S RC=$$ADDVAL^RORTSK11(RORTSK,"REGNAME",TMP,PARAMS)
|
|
;
|
|
;=== Alternate date ranges
|
|
F I=2:1:3 D Q:RC<0
|
|
. S STDT=$$PARAM^RORTSK01("DATE_RANGE_"_I,"START")\1 Q:STDT'>0
|
|
. S ENDT=$$PARAM^RORTSK01("DATE_RANGE_"_I,"END")\1 Q:ENDT'>0
|
|
. S ELEMENT=$$ADDVAL^RORTSK11(RORTSK,"DATE_RANGE_"_I,,PARAMS)
|
|
. I ELEMENT<0 S RC=+ELEMENT Q
|
|
. S RC=$$ADDATTR^RORTSK11(RORTSK,ELEMENT,"START",STDT) Q:RC<0
|
|
. S RC=$$ADDATTR^RORTSK11(RORTSK,ELEMENT,"END",ENDT)
|
|
Q:RC<0 RC
|
|
;
|
|
;=== Main date range
|
|
S STDT=$$PARAM^RORTSK01("DATE_RANGE","START")\1
|
|
S ENDT=$$PARAM^RORTSK01("DATE_RANGE","END")\1
|
|
I STDT>0,ENDT>0 D Q:RC<0 RC
|
|
. S ELEMENT=$$ADDVAL^RORTSK11(RORTSK,"DATE_RANGE",,PARAMS)
|
|
. I ELEMENT<0 S RC=+ELEMENT Q
|
|
. S RC=$$ADDATTR^RORTSK11(RORTSK,ELEMENT,"START",STDT) Q:RC<0
|
|
. S RC=$$ADDATTR^RORTSK11(RORTSK,ELEMENT,"END",ENDT)
|
|
E S (ENDT,STDT)=""
|
|
;
|
|
;=== Task comment
|
|
S TMP=$$PARAM^RORTSK01("TASK_COMMENT")
|
|
D:TMP'="" ADDVAL^RORTSK11(RORTSK,"TASK_COMMENT",TMP,PARAMS)
|
|
;
|
|
;=== Patient selection and Options
|
|
F NAME="PATIENTS","OPTIONS" D Q:RC<0
|
|
. K BUF M BUF=RORTSK("PARAMS",NAME,"A") Q:$D(BUF)<10
|
|
. ;--- Generate the XML tags
|
|
. S ELEMENT=$$ADDVAL^RORTSK11(RORTSK,NAME,$$OPTXT(.BUF),PARAMS)
|
|
. I ELEMENT'>0 S RC=ELEMENT Q
|
|
. S TMP=""
|
|
. F S TMP=$O(BUF(TMP)) Q:TMP="" D Q:RC<0
|
|
. . S RC=$$ADDATTR^RORTSK11(RORTSK,ELEMENT,TMP,"1")
|
|
. ;--- Compile the flags
|
|
. D:NAME="PATIENTS"
|
|
. . S:'$D(BUF("DE_BEFORE")) FLAGS=FLAGS_"P"
|
|
. . S:'$D(BUF("DE_DURING")) FLAGS=FLAGS_"N"
|
|
. . S:'$D(BUF("DE_AFTER")) FLAGS=FLAGS_"F"
|
|
Q:RC<0 RC
|
|
;
|
|
;=== Other Registries
|
|
I $D(RORTSK("PARAMS","OTHER_REGISTRIES","C"))>1 D Q:RC<0 RC
|
|
. N NODE,REGIEN
|
|
. S LTAG=$$ADDVAL^RORTSK11(RORTSK,"OTHER_REGISTRIES",,PARAMS)
|
|
. I LTAG<0 S RC=+LTAG Q
|
|
. S NODE=$NA(RORTSK("PARAMS","OTHER_REGISTRIES","C"))
|
|
. S REGIEN=0
|
|
. F S REGIEN=$O(@NODE@(REGIEN)) Q:REGIEN'>0 D Q:RC<0
|
|
. . S TMP=$P($$REGNAME^RORUTL01(REGIEN),U,2)
|
|
. . S MODE=+$G(@NODE@(REGIEN))
|
|
. . I 'MODE!(TMP="") K @NODE@(REGIEN) Q
|
|
. . S TMP=TMP_" ("_$S(MODE<0:"Exclude",1:"Include")_")"
|
|
. . S RC=$$ADDVAL^RORTSK11(RORTSK,"REGNAME",TMP,LTAG)
|
|
. S FLAGS=FLAGS_"R"
|
|
;
|
|
;=== Local Fields
|
|
I $D(RORTSK("PARAMS","LOCAL_FIELDS","C"))>1 D Q:RC<0 RC
|
|
. N NODE,IEN,IENS
|
|
. S LTAG=$$ADDVAL^RORTSK11(RORTSK,"LOCAL_FIELDS",,PARAMS)
|
|
. I LTAG<0 S RC=+LTAG Q
|
|
. S NODE=$NA(RORTSK("PARAMS","LOCAL_FIELDS","C"))
|
|
. S IEN=0
|
|
. F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D Q:RC<0
|
|
. . S TMP=$$GET1^DIQ(799.53,IEN_",",.01,,,"RORMSG")
|
|
. . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,799.53,IEN_",")
|
|
. . S MODE=+$G(@NODE@(IEN))
|
|
. . I 'MODE!(TMP="") K @NODE@(IEN) Q
|
|
. . S TMP=TMP_" ("_$S(MODE<0:"Exclude",1:"Include")_")"
|
|
. . S RC=$$ADDVAL^RORTSK11(RORTSK,"FIELD",TMP,LTAG)
|
|
. S FLAGS=FLAGS_"O"
|
|
;
|
|
;=== Lab test ranges
|
|
I $D(RORTSK("PARAMS","LRGRANGES","C"))>1 D Q:RC<0 RC
|
|
. N GRC,NODE
|
|
. S NODE=$NA(RORTSK("PARAMS","LRGRANGES","C"))
|
|
. S GRC=0
|
|
. F S GRC=$O(@NODE@(GRC)) Q:GRC'>0 D Q:RC<0
|
|
. . S RC=$$ITEMIEN^RORUTL09(3,REGIEN,GRC,.TMP)
|
|
. . S:RC'<0 @NODE@(GRC)=TMP
|
|
;
|
|
;=== Defaults
|
|
S TMP=$TR(FLAGS,"FNP") S:$L(FLAGS)-$L(TMP)=3 FLAGS=TMP
|
|
S FLAGS=FLAGS_"DG"
|
|
;
|
|
;=== Success
|
|
Q PARAMS
|
|
;
|
|
;***** GENERATES TABLE DEFINITION
|
|
;
|
|
; TBLREF Reference to the definition table in the source
|
|
; code (TAG^ROUTINE). See the HEADER^RORX013 for
|
|
; examples of table definitions.
|
|
;
|
|
; HEADER IEN of the HEADER element
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
;
|
|
TBLDEF(TBLREF,HEADER) ;
|
|
N COND,IT,NAME,RC,RORSRC,TBLDEF,TERM,TGET
|
|
S TGET="S RORSRC=$T("_$P(TBLREF,"^")_"+IT^"_$P(TBLREF,"^",2)_")"
|
|
S RC=0
|
|
F IT=1:1 X TGET S RORSRC=$P(RORSRC,";;",2) Q:RORSRC="" D Q:RC<0
|
|
. S COND=$$TRIM^XLFSTR($P(RORSRC,U,2,999))
|
|
. I COND'="" X COND E Q
|
|
. S RORSRC=$$TRIM^XLFSTR($P(RORSRC,U))
|
|
. S NAME=$$COLSCAN(.TERM) Q:(NAME="")!(TERM'="(")
|
|
. S TBLDEF=$$ADDVAL^RORTSK11(RORTSK,"TBLDEF",,HEADER)
|
|
. I TBLDEF<0 S RC=TBLDEF Q
|
|
. D ADDATTR^RORTSK11(RORTSK,TBLDEF,"NAME",NAME)
|
|
. D ADDATTR^RORTSK11(RORTSK,TBLDEF,"HEADER","1")
|
|
. D ADDATTR^RORTSK11(RORTSK,TBLDEF,"FOOTER","1")
|
|
. D TBLDEF1(TBLDEF)
|
|
Q $S(RC<0:RC,1:0)
|
|
;
|
|
;***** GENERATES <COLUMN> ELEMENTS FROM TABLE DEFINITION (RORSRC)
|
|
;
|
|
; PTAG IEN of the parent element
|
|
;
|
|
TBLDEF1(PTAG) ;
|
|
N COLUMN,NAME,TERM
|
|
F S NAME=$$COLSCAN(.TERM) Q:NAME="" D Q:")"[TERM
|
|
. S COLUMN=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,PTAG)
|
|
. D ADDATTR^RORTSK11(RORTSK,COLUMN,"NAME",NAME)
|
|
. D:TERM="(" TBLDEF1(COLUMN)
|
|
Q
|