| [613] | 1 | RORXU002 ;HCIOFO/SG - REPORT BUILDER UTILITIES ; 5/18/06 11:13am
|
|---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;***** SCANS THE TABLE DEFINITION (RORSRC) FOR COLUMN NAMES
|
|---|
| 7 | ;
|
|---|
| 8 | ; .TERM Reference to a local variable where
|
|---|
| 9 | ; is terminator is returned
|
|---|
| 10 | ;
|
|---|
| 11 | ; Return Values:
|
|---|
| 12 | ; "" End of definition
|
|---|
| 13 | ; ... Name of the column
|
|---|
| 14 | ;
|
|---|
| 15 | COLSCAN(TERM) ;
|
|---|
| 16 | N CH,I,TOKEN
|
|---|
| 17 | F I=1:1 S TERM=$E(RORSRC,I) Q:"(,)"[TERM
|
|---|
| 18 | S TOKEN=$E(RORSRC,1,I-1)
|
|---|
| 19 | F I=I+1:1 S CH=$E(RORSRC,I) Q:(CH="")!("(,)"'[CH)
|
|---|
| 20 | S $E(RORSRC,1,I-1)=""
|
|---|
| 21 | Q TOKEN
|
|---|
| 22 | ;
|
|---|
| 23 | ;***** CHECKS THE FILEMAN DATE/TIME VALUE
|
|---|
| 24 | DATE(DT) ;
|
|---|
| 25 | Q $S(DT>0:+DT,1:"")
|
|---|
| 26 | ;
|
|---|
| 27 | ;***** OUTPUTS THE BASIC HEADER TO THE REPORT
|
|---|
| 28 | ;
|
|---|
| 29 | ; .RORTSK Task number and task parameters
|
|---|
| 30 | ;
|
|---|
| 31 | ; PARTAG Reference (IEN) to the parent tag
|
|---|
| 32 | ;
|
|---|
| 33 | ; Return Values:
|
|---|
| 34 | ; <0 Error code
|
|---|
| 35 | ; >0 IEN of the HEADER element
|
|---|
| 36 | ;
|
|---|
| 37 | HEADER(RORTSK,PARTAG) ;
|
|---|
| 38 | N HEADER,IENS,REGIEN,RORBUF,RORMSG,TMP
|
|---|
| 39 | S HEADER=$$ADDVAL^RORTSK11(RORTSK,"HEADER",,PARTAG)
|
|---|
| 40 | Q:HEADER<0 HEADER
|
|---|
| 41 | D ADDVAL^RORTSK11(RORTSK,"DATE",$$DATE($$NOW^XLFDT),HEADER)
|
|---|
| 42 | D ADDVAL^RORTSK11(RORTSK,"TASK_NUMBER",RORTSK,HEADER)
|
|---|
| 43 | S REGIEN=+$$PARAM^RORTSK01("REGIEN")
|
|---|
| 44 | ;---
|
|---|
| 45 | S IENS=REGIEN_","
|
|---|
| 46 | D GETS^DIQ(798.1,IENS,"1;2","I","RORBUF","RORMSG")
|
|---|
| 47 | Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798.1,IENS)
|
|---|
| 48 | S TMP=$G(RORBUF(798.1,IENS,1,"I"))
|
|---|
| 49 | D ADDVAL^RORTSK11(RORTSK,"UPDATED_UNTIL",$$DATE(TMP),HEADER)
|
|---|
| 50 | S TMP=$G(RORBUF(798.1,IENS,2,"I"))
|
|---|
| 51 | D ADDVAL^RORTSK11(RORTSK,"EXTRACTED_UNTIL",$$DATE(TMP),HEADER)
|
|---|
| 52 | Q HEADER
|
|---|
| 53 | ;
|
|---|
| 54 | ;***** PARSES THE COMMA-SEPARATED LIST
|
|---|
| 55 | ;
|
|---|
| 56 | ; .LIST Reference to a local variable that contains a list.
|
|---|
| 57 | ; Items of the list are returned as the subscripts of
|
|---|
| 58 | ; this variable.
|
|---|
| 59 | ;
|
|---|
| 60 | LIST(LIST) ;
|
|---|
| 61 | N I,TMP,VAL
|
|---|
| 62 | F I=1:1 S VAL=$P(LIST,",",I) Q:VAL="" D
|
|---|
| 63 | . S TMP=$$TRIM^XLFSTR(VAL)
|
|---|
| 64 | . S:TMP'="" LIST(TMP)=""
|
|---|
| 65 | Q
|
|---|
| 66 | ;
|
|---|
| 67 | ;***** COMPILES A TEXT DESCRIPTION FOR THE REPORT OPTIONS
|
|---|
| 68 | ;
|
|---|
| 69 | ; .OPTIONS Reference to a local variable containing
|
|---|
| 70 | ; the options as subscripts
|
|---|
| 71 | ;
|
|---|
| 72 | ; [DLGNUM] Number of the dialog that contains the template
|
|---|
| 73 | ; (7980000.018, by default).
|
|---|
| 74 | ;
|
|---|
| 75 | ; Return Values:
|
|---|
| 76 | ; ... Text description of the options
|
|---|
| 77 | ;
|
|---|
| 78 | OPTXT(OPTIONS,DLGNUM) ;
|
|---|
| 79 | N I,J,NS,RORBUF,TEXT,TMP
|
|---|
| 80 | S:$G(DLGNUM)'>0 DLGNUM=7980000.018
|
|---|
| 81 | D BLD^DIALOG(DLGNUM,,,"RORBUF")
|
|---|
| 82 | S TEXT="",I=0
|
|---|
| 83 | F S I=$O(RORBUF(I)) Q:I="" D:$E(RORBUF(I),1)'=" "
|
|---|
| 84 | . S NS=0
|
|---|
| 85 | . F J=1:1 S TMP=$TR($P(RORBUF(I),",",J)," ") Q:TMP="" D
|
|---|
| 86 | . . S:$D(OPTIONS(TMP)) NS=2**(J-1)+NS
|
|---|
| 87 | . Q:'NS
|
|---|
| 88 | . S TMP=$$TRIM^XLFSTR($G(RORBUF(I+NS)))
|
|---|
| 89 | . S:TMP'="" TEXT=TEXT_", "_TMP
|
|---|
| 90 | Q $P(TEXT,", ",2,999)
|
|---|
| 91 | ;
|
|---|
| 92 | ;***** OUTPUTS THE PARAMETERS TO THE REPORT
|
|---|
| 93 | ;
|
|---|
| 94 | ; .RORTSK Task number and task parameters
|
|---|
| 95 | ;
|
|---|
| 96 | ; PARTAG Reference (IEN) to the parent tag
|
|---|
| 97 | ;
|
|---|
| 98 | ; .STDT Start and end dates of the report
|
|---|
| 99 | ; .ENDT are returned via these parameters
|
|---|
| 100 | ;
|
|---|
| 101 | ; [.FLAGS] Flags for the $$SKIP^RORXU005 are returned via this
|
|---|
| 102 | ; parameter. The "D" (skip deceased patients) and "G"
|
|---|
| 103 | ; (skip pending patients) flags are always added.
|
|---|
| 104 | ;
|
|---|
| 105 | ; Return Values:
|
|---|
| 106 | ; <0 Error code
|
|---|
| 107 | ; >0 IEN of the PARAMETERS element
|
|---|
| 108 | ;
|
|---|
| 109 | PARAMS(RORTSK,PARTAG,STDT,ENDT,FLAGS) ;
|
|---|
| 110 | N BUF,ELEMENT,I,LTAG,MODE,NAME,PARAMS,RC,REGIEN,RORMSG,TMP
|
|---|
| 111 | S PARAMS=$$ADDVAL^RORTSK11(RORTSK,"PARAMETERS",,PARTAG)
|
|---|
| 112 | S RC=0,(ENDT,STDT)="",FLAGS=""
|
|---|
| 113 | ;
|
|---|
| 114 | ;=== Registry name
|
|---|
| 115 | S REGIEN=+$$PARAM^RORTSK01("REGIEN")
|
|---|
| 116 | I REGIEN>0 D Q:RC<0 RC
|
|---|
| 117 | . S TMP=$P($$REGNAME^RORUTL01(REGIEN),U)
|
|---|
| 118 | . I TMP="" S RC=-1 Q
|
|---|
| 119 | . S RC=$$ADDVAL^RORTSK11(RORTSK,"REGNAME",TMP,PARAMS)
|
|---|
| 120 | ;
|
|---|
| 121 | ;=== Alternate date ranges
|
|---|
| 122 | F I=2:1:3 D Q:RC<0
|
|---|
| 123 | . S STDT=$$PARAM^RORTSK01("DATE_RANGE_"_I,"START")\1 Q:STDT'>0
|
|---|
| 124 | . S ENDT=$$PARAM^RORTSK01("DATE_RANGE_"_I,"END")\1 Q:ENDT'>0
|
|---|
| 125 | . S ELEMENT=$$ADDVAL^RORTSK11(RORTSK,"DATE_RANGE_"_I,,PARAMS)
|
|---|
| 126 | . I ELEMENT<0 S RC=+ELEMENT Q
|
|---|
| 127 | . S RC=$$ADDATTR^RORTSK11(RORTSK,ELEMENT,"START",STDT) Q:RC<0
|
|---|
| 128 | . S RC=$$ADDATTR^RORTSK11(RORTSK,ELEMENT,"END",ENDT)
|
|---|
| 129 | Q:RC<0 RC
|
|---|
| 130 | ;
|
|---|
| 131 | ;=== Main date range
|
|---|
| 132 | S STDT=$$PARAM^RORTSK01("DATE_RANGE","START")\1
|
|---|
| 133 | S ENDT=$$PARAM^RORTSK01("DATE_RANGE","END")\1
|
|---|
| 134 | I STDT>0,ENDT>0 D Q:RC<0 RC
|
|---|
| 135 | . S ELEMENT=$$ADDVAL^RORTSK11(RORTSK,"DATE_RANGE",,PARAMS)
|
|---|
| 136 | . I ELEMENT<0 S RC=+ELEMENT Q
|
|---|
| 137 | . S RC=$$ADDATTR^RORTSK11(RORTSK,ELEMENT,"START",STDT) Q:RC<0
|
|---|
| 138 | . S RC=$$ADDATTR^RORTSK11(RORTSK,ELEMENT,"END",ENDT)
|
|---|
| 139 | E S (ENDT,STDT)=""
|
|---|
| 140 | ;
|
|---|
| 141 | ;=== Task comment
|
|---|
| 142 | S TMP=$$PARAM^RORTSK01("TASK_COMMENT")
|
|---|
| 143 | D:TMP'="" ADDVAL^RORTSK11(RORTSK,"TASK_COMMENT",TMP,PARAMS)
|
|---|
| 144 | ;
|
|---|
| 145 | ;=== Patient selection and Options
|
|---|
| 146 | F NAME="PATIENTS","OPTIONS" D Q:RC<0
|
|---|
| 147 | . K BUF M BUF=RORTSK("PARAMS",NAME,"A") Q:$D(BUF)<10
|
|---|
| 148 | . ;--- Generate the XML tags
|
|---|
| 149 | . S ELEMENT=$$ADDVAL^RORTSK11(RORTSK,NAME,$$OPTXT(.BUF),PARAMS)
|
|---|
| 150 | . I ELEMENT'>0 S RC=ELEMENT Q
|
|---|
| 151 | . S TMP=""
|
|---|
| 152 | . F S TMP=$O(BUF(TMP)) Q:TMP="" D Q:RC<0
|
|---|
| 153 | . . S RC=$$ADDATTR^RORTSK11(RORTSK,ELEMENT,TMP,"1")
|
|---|
| 154 | . ;--- Compile the flags
|
|---|
| 155 | . D:NAME="PATIENTS"
|
|---|
| 156 | . . S:'$D(BUF("DE_BEFORE")) FLAGS=FLAGS_"P"
|
|---|
| 157 | . . S:'$D(BUF("DE_DURING")) FLAGS=FLAGS_"N"
|
|---|
| 158 | . . S:'$D(BUF("DE_AFTER")) FLAGS=FLAGS_"F"
|
|---|
| 159 | Q:RC<0 RC
|
|---|
| 160 | ;
|
|---|
| 161 | ;=== Other Registries
|
|---|
| 162 | I $D(RORTSK("PARAMS","OTHER_REGISTRIES","C"))>1 D Q:RC<0 RC
|
|---|
| 163 | . N NODE,REGIEN
|
|---|
| 164 | . S LTAG=$$ADDVAL^RORTSK11(RORTSK,"OTHER_REGISTRIES",,PARAMS)
|
|---|
| 165 | . I LTAG<0 S RC=+LTAG Q
|
|---|
| 166 | . S NODE=$NA(RORTSK("PARAMS","OTHER_REGISTRIES","C"))
|
|---|
| 167 | . S REGIEN=0
|
|---|
| 168 | . F S REGIEN=$O(@NODE@(REGIEN)) Q:REGIEN'>0 D Q:RC<0
|
|---|
| 169 | . . S TMP=$P($$REGNAME^RORUTL01(REGIEN),U,2)
|
|---|
| 170 | . . S MODE=+$G(@NODE@(REGIEN))
|
|---|
| 171 | . . I 'MODE!(TMP="") K @NODE@(REGIEN) Q
|
|---|
| 172 | . . S TMP=TMP_" ("_$S(MODE<0:"Exclude",1:"Include")_")"
|
|---|
| 173 | . . S RC=$$ADDVAL^RORTSK11(RORTSK,"REGNAME",TMP,LTAG)
|
|---|
| 174 | . S FLAGS=FLAGS_"R"
|
|---|
| 175 | ;
|
|---|
| 176 | ;=== Local Fields
|
|---|
| 177 | I $D(RORTSK("PARAMS","LOCAL_FIELDS","C"))>1 D Q:RC<0 RC
|
|---|
| 178 | . N NODE,IEN,IENS
|
|---|
| 179 | . S LTAG=$$ADDVAL^RORTSK11(RORTSK,"LOCAL_FIELDS",,PARAMS)
|
|---|
| 180 | . I LTAG<0 S RC=+LTAG Q
|
|---|
| 181 | . S NODE=$NA(RORTSK("PARAMS","LOCAL_FIELDS","C"))
|
|---|
| 182 | . S IEN=0
|
|---|
| 183 | . F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D Q:RC<0
|
|---|
| 184 | . . S TMP=$$GET1^DIQ(799.53,IEN_",",.01,,,"RORMSG")
|
|---|
| 185 | . . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,799.53,IEN_",")
|
|---|
| 186 | . . S MODE=+$G(@NODE@(IEN))
|
|---|
| 187 | . . I 'MODE!(TMP="") K @NODE@(IEN) Q
|
|---|
| 188 | . . S TMP=TMP_" ("_$S(MODE<0:"Exclude",1:"Include")_")"
|
|---|
| 189 | . . S RC=$$ADDVAL^RORTSK11(RORTSK,"FIELD",TMP,LTAG)
|
|---|
| 190 | . S FLAGS=FLAGS_"O"
|
|---|
| 191 | ;
|
|---|
| 192 | ;=== Lab test ranges
|
|---|
| 193 | I $D(RORTSK("PARAMS","LRGRANGES","C"))>1 D Q:RC<0 RC
|
|---|
| 194 | . N GRC,NODE
|
|---|
| 195 | . S NODE=$NA(RORTSK("PARAMS","LRGRANGES","C"))
|
|---|
| 196 | . S GRC=0
|
|---|
| 197 | . F S GRC=$O(@NODE@(GRC)) Q:GRC'>0 D Q:RC<0
|
|---|
| 198 | . . S RC=$$ITEMIEN^RORUTL09(3,REGIEN,GRC,.TMP)
|
|---|
| 199 | . . S:RC'<0 @NODE@(GRC)=TMP
|
|---|
| 200 | ;
|
|---|
| 201 | ;=== Defaults
|
|---|
| 202 | S TMP=$TR(FLAGS,"FNP") S:$L(FLAGS)-$L(TMP)=3 FLAGS=TMP
|
|---|
| 203 | S FLAGS=FLAGS_"DG"
|
|---|
| 204 | ;
|
|---|
| 205 | ;=== Success
|
|---|
| 206 | Q PARAMS
|
|---|
| 207 | ;
|
|---|
| 208 | ;***** GENERATES TABLE DEFINITION
|
|---|
| 209 | ;
|
|---|
| 210 | ; TBLREF Reference to the definition table in the source
|
|---|
| 211 | ; code (TAG^ROUTINE). See the HEADER^RORX013 for
|
|---|
| 212 | ; examples of table definitions.
|
|---|
| 213 | ;
|
|---|
| 214 | ; HEADER IEN of the HEADER element
|
|---|
| 215 | ;
|
|---|
| 216 | ; Return Values:
|
|---|
| 217 | ; <0 Error code
|
|---|
| 218 | ; 0 Ok
|
|---|
| 219 | ;
|
|---|
| 220 | TBLDEF(TBLREF,HEADER) ;
|
|---|
| 221 | N COND,IT,NAME,RC,RORSRC,TBLDEF,TERM,TGET
|
|---|
| 222 | S TGET="S RORSRC=$T("_$P(TBLREF,"^")_"+IT^"_$P(TBLREF,"^",2)_")"
|
|---|
| 223 | S RC=0
|
|---|
| 224 | F IT=1:1 X TGET S RORSRC=$P(RORSRC,";;",2) Q:RORSRC="" D Q:RC<0
|
|---|
| 225 | . S COND=$$TRIM^XLFSTR($P(RORSRC,U,2,999))
|
|---|
| 226 | . I COND'="" X COND E Q
|
|---|
| 227 | . S RORSRC=$$TRIM^XLFSTR($P(RORSRC,U))
|
|---|
| 228 | . S NAME=$$COLSCAN(.TERM) Q:(NAME="")!(TERM'="(")
|
|---|
| 229 | . S TBLDEF=$$ADDVAL^RORTSK11(RORTSK,"TBLDEF",,HEADER)
|
|---|
| 230 | . I TBLDEF<0 S RC=TBLDEF Q
|
|---|
| 231 | . D ADDATTR^RORTSK11(RORTSK,TBLDEF,"NAME",NAME)
|
|---|
| 232 | . D ADDATTR^RORTSK11(RORTSK,TBLDEF,"HEADER","1")
|
|---|
| 233 | . D ADDATTR^RORTSK11(RORTSK,TBLDEF,"FOOTER","1")
|
|---|
| 234 | . D TBLDEF1(TBLDEF)
|
|---|
| 235 | Q $S(RC<0:RC,1:0)
|
|---|
| 236 | ;
|
|---|
| 237 | ;***** GENERATES <COLUMN> ELEMENTS FROM TABLE DEFINITION (RORSRC)
|
|---|
| 238 | ;
|
|---|
| 239 | ; PTAG IEN of the parent element
|
|---|
| 240 | ;
|
|---|
| 241 | TBLDEF1(PTAG) ;
|
|---|
| 242 | N COLUMN,NAME,TERM
|
|---|
| 243 | F S NAME=$$COLSCAN(.TERM) Q:NAME="" D Q:")"[TERM
|
|---|
| 244 | . S COLUMN=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,PTAG)
|
|---|
| 245 | . D ADDATTR^RORTSK11(RORTSK,COLUMN,"NAME",NAME)
|
|---|
| 246 | . D:TERM="(" TBLDEF1(COLUMN)
|
|---|
| 247 | Q
|
|---|
