| 1 | RORX015A ;HCIOFO/SG - OUTPATIENT PROCEDURES (QUERY & SORT) ; 6/21/06 4:36pm
|
|---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine uses the following IAs:
|
|---|
| 5 | ;
|
|---|
| 6 | ; #1995 $$CODEN^ICPTCOD and $$CPT^ICPTCOD (supported)
|
|---|
| 7 | ; #2548 SDQ routine (supported)
|
|---|
| 8 | ; #3990 $$CODEN^ICDCODE and $$ICDOP^ICDCODE (supported)
|
|---|
| 9 | ;
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | ;***** SEARCHES FOR INPATIENT PROCEDURES
|
|---|
| 13 | ;
|
|---|
| 14 | ; PTIEN Patient IEN (DFN)
|
|---|
| 15 | ;
|
|---|
| 16 | ; Return Values:
|
|---|
| 17 | ; <0 Error code
|
|---|
| 18 | ; 0 Ok
|
|---|
| 19 | ; >0 Number of non-fatal errors
|
|---|
| 20 | ;
|
|---|
| 21 | INPAT(PTIEN) ;
|
|---|
| 22 | N DATE,ERRCNT,FLDLST,IEN,IEN45,IENS,NODE,RC,RORBUF,RORMSG,XREF
|
|---|
| 23 | S (ERRCNT,RC)=0
|
|---|
| 24 | S XREF=$$ROOT^DILFD(45,,1),XREF=$NA(@XREF@("B",PTIEN))
|
|---|
| 25 | S IEN45=0
|
|---|
| 26 | F S IEN45=$O(@XREF@(IEN45)) Q:IEN45'>0 D
|
|---|
| 27 | . ;Q:$$GET1^DIQ(45,IEN45_",",6,"I",,"RORMSG")<1 ; Skip open records
|
|---|
| 28 | . ;S IENS=IEN45_","
|
|---|
| 29 | . ;S FLDLST="45.01;45.02;45.03;45.04;45.05"
|
|---|
| 30 | . ;D GETS^DIQ(45,IENS,FLDLST,"I","RORBUF","RORMSG")
|
|---|
| 31 | . ;I $G(DIERR) D S ERRCNT=ERRCNT+1
|
|---|
| 32 | . ;. D DBS^RORERR("RORMSG",-99,,PTIEN,45,IENS)
|
|---|
| 33 | . ;D INP(PTIEN,$NA(RORBUF(IENS)),FLDLST,???)
|
|---|
| 34 | . ;--- Surgical procedures
|
|---|
| 35 | . S NODE=$$ROOT^DILFD(45.01,","_IEN45_",",1)
|
|---|
| 36 | . S IEN=0
|
|---|
| 37 | . F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D
|
|---|
| 38 | . . S IENS=IEN_","_IEN45_"," K RORBUF
|
|---|
| 39 | . . S FLDLST="8;9;10;11;12"
|
|---|
| 40 | . . ;--- Load the data
|
|---|
| 41 | . . D GETS^DIQ(45.01,IENS,".01;"_FLDLST,"I","RORBUF","RORMSG")
|
|---|
| 42 | . . I $G(DIERR) D S ERRCNT=ERRCNT+1
|
|---|
| 43 | . . . D DBS^RORERR("RORMSG",-99,,PTIEN,45.01,IENS)
|
|---|
| 44 | . . S DATE=$G(RORBUF(45.01,IENS,.01,"I"))
|
|---|
| 45 | . . Q:(DATE<RORSDT)!(DATE'<ROREDT1)
|
|---|
| 46 | . . ;--- Generate the output
|
|---|
| 47 | . . D INP(PTIEN,$NA(RORBUF(45.01,IENS)),FLDLST,DATE)
|
|---|
| 48 | . ;--- Other procedures
|
|---|
| 49 | . S NODE=$$ROOT^DILFD(45.05,","_IEN45_",",1)
|
|---|
| 50 | . S IEN=0
|
|---|
| 51 | . F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D
|
|---|
| 52 | . . S IENS=IEN_","_IEN45_"," K RORBUF
|
|---|
| 53 | . . S FLDLST="4;5;6;7;8"
|
|---|
| 54 | . . ;--- Load the data
|
|---|
| 55 | . . D GETS^DIQ(45.05,IENS,".01;"_FLDLST,"I","RORBUF","RORMSG")
|
|---|
| 56 | . . I $G(DIERR) D S ERRCNT=ERRCNT+1
|
|---|
| 57 | . . . D DBS^RORERR("RORMSG",-99,,PTIEN,45.05,IENS)
|
|---|
| 58 | . . S DATE=$G(RORBUF(45.05,IENS,.01,"I"))
|
|---|
| 59 | . . Q:(DATE<RORSDT)!(DATE'<ROREDT1)
|
|---|
| 60 | . . ;--- Generate the output
|
|---|
| 61 | . . D INP(PTIEN,$NA(RORBUF(45.05,IENS)),FLDLST,DATE)
|
|---|
| 62 | ;---
|
|---|
| 63 | Q $S(RC<0:RC,1:ERRCNT)
|
|---|
| 64 | ;
|
|---|
| 65 | ;****
|
|---|
| 66 | INP(PTIEN,ROR8BUF,FLDLST,DATE) ;
|
|---|
| 67 | N I,ICD9IEN,FLD
|
|---|
| 68 | F I=1:1 S FLD=$P(FLDLST,";",I) Q:FLD="" D
|
|---|
| 69 | . S ICD9IEN=+$G(@ROR8BUF@(FLD,"I"))
|
|---|
| 70 | . D:ICD9IEN>0 PROCSET(PTIEN,"I",ICD9IEN,DATE)
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
| 73 | ;***** CALL-BACK PROCEDURE FOR THE OUTPATIENT SEARCH
|
|---|
| 74 | ;
|
|---|
| 75 | ; PTIEN Patient IEN (DFN)
|
|---|
| 76 | ;
|
|---|
| 77 | OPSCAN(PTIEN) ;
|
|---|
| 78 | N CPTIEN,DATE,IEN,RORCPT,VDATE
|
|---|
| 79 | D GETCPT^SDOE(Y,"RORCPT")
|
|---|
| 80 | Q:$G(RORCPT)'>0
|
|---|
| 81 | S VDATE=+$P(Y0,U)
|
|---|
| 82 | ;---
|
|---|
| 83 | S IEN=0
|
|---|
| 84 | F S IEN=$O(RORCPT(IEN)) Q:IEN'>0 D
|
|---|
| 85 | . S CPTIEN=+$P(RORCPT(IEN),U),DATE=+$P($G(RORCPT(IEN,12)),U)
|
|---|
| 86 | . D:CPTIEN>0 PROCSET(PTIEN,"O",CPTIEN,$S(DATE>0:DATE,1:VDATE))
|
|---|
| 87 | Q
|
|---|
| 88 | ;
|
|---|
| 89 | ;***** SEARCHES FOR OUTPATIENT PROCEDURES
|
|---|
| 90 | ;
|
|---|
| 91 | ; PTIEN Patient IEN (DFN)
|
|---|
| 92 | ;
|
|---|
| 93 | ; Return Values:
|
|---|
| 94 | ; <0 Error code
|
|---|
| 95 | ; 0 Ok
|
|---|
| 96 | ; >0 Number of non-fatal errors
|
|---|
| 97 | ;
|
|---|
| 98 | OUTPAT(PTIEN) ;
|
|---|
| 99 | N QUERY
|
|---|
| 100 | D OPEN^SDQ(.QUERY)
|
|---|
| 101 | D INDEX^SDQ(.QUERY,"PATIENT/DATE","SET")
|
|---|
| 102 | D PAT^SDQ(.QUERY,PTIEN,"SET")
|
|---|
| 103 | D DATE^SDQ(.QUERY,RORSDT,ROREDT1,"SET")
|
|---|
| 104 | D SCANCB^SDQ(.QUERY,"D OPSCAN^RORX015A("_PTIEN_")","SET")
|
|---|
| 105 | D ACTIVE^SDQ(.QUERY,"TRUE","SET")
|
|---|
| 106 | D SCAN^SDQ(.QUERY,"FORWARD")
|
|---|
| 107 | D CLOSE^SDQ(.QUERY)
|
|---|
| 108 | Q 0
|
|---|
| 109 | ;
|
|---|
| 110 | ;**** STORES THE PROCEDURE CODE
|
|---|
| 111 | ;
|
|---|
| 112 | ; PTIEN Patient IEN (DFN)
|
|---|
| 113 | ; SOURCE CPT source code ("O" or "I")
|
|---|
| 114 | ; [IEN] IEN of the procedure descriptor (file #81 or #80.1)
|
|---|
| 115 | ; DATE Date when the code was entered
|
|---|
| 116 | ; [CODE] Procedure code (CPT or ICD-9)
|
|---|
| 117 | ;
|
|---|
| 118 | ; Either the IEN or the CODE parameter must be provided.
|
|---|
| 119 | ;
|
|---|
| 120 | PROCSET(PTIEN,SOURCE,IEN,DATE,CODE) ;
|
|---|
| 121 | Q:DATE'>0
|
|---|
| 122 | N TMP
|
|---|
| 123 | S IEN=+$G(IEN)
|
|---|
| 124 | ;---
|
|---|
| 125 | I IEN'>0 Q:$G(CODE)="" D Q:IEN'>0
|
|---|
| 126 | . I SOURCE="O" S IEN=+$$CODEN^ICPTCOD(CODE) Q
|
|---|
| 127 | . I SOURCE="I" S IEN=+$$CODEN^ICDCODE(CODE,80.1) Q
|
|---|
| 128 | ;---
|
|---|
| 129 | I SOURCE="O",'$$PARAM^RORTSK01("CPTLST","ALL") D Q:'TMP
|
|---|
| 130 | . S TMP=$D(RORTSK("PARAMS","CPTLST","C",IEN))
|
|---|
| 131 | I SOURCE="I" Q:$$ICDGRCHK^RORXU008(.RORPTGRP,IEN,RORICDL)
|
|---|
| 132 | ;---
|
|---|
| 133 | S TMP=+$G(@RORTMP@("PAT",PTIEN,SOURCE,IEN))
|
|---|
| 134 | S:'TMP!(DATE<TMP) @RORTMP@("PAT",PTIEN,SOURCE,IEN)=DATE
|
|---|
| 135 | S ^("C")=$G(@RORTMP@("PAT",PTIEN,SOURCE,IEN,"C"))+1
|
|---|
| 136 | Q
|
|---|
| 137 | ;
|
|---|
| 138 | ;***** QUERIES THE REGISTRY
|
|---|
| 139 | ;
|
|---|
| 140 | ; FLAGS Flags for the $$SKIP^RORXU005
|
|---|
| 141 | ;
|
|---|
| 142 | ; Return Values:
|
|---|
| 143 | ; <0 Error code
|
|---|
| 144 | ; 0 Ok
|
|---|
| 145 | ; >0 Number of non-fatal errors
|
|---|
| 146 | ;
|
|---|
| 147 | QUERY(FLAGS) ;
|
|---|
| 148 | N ROREDT1 ; Day after the end date
|
|---|
| 149 | N RORPTGRP ; Temporary list of ICD-9 groups
|
|---|
| 150 | N RORPTN ; Number of patients in the registry
|
|---|
| 151 | ;
|
|---|
| 152 | N CNT,ECNT,IEN,IENS,MODE,PTIEN,RC,SKIP,SKIPEDT,SKIPSDT,TMP,UTEDT,UTSDT,XREFNODE
|
|---|
| 153 | S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
|
|---|
| 154 | S ROREDT1=$$FMADD^XLFDT(ROREDT\1,1)
|
|---|
| 155 | S (CNT,ECNT,RC)=0,SKIPEDT=ROREDT,SKIPSDT=RORSDT
|
|---|
| 156 | S:$$PARAM^RORTSK01("PATIENTS","INPATIENT") MODE("I")=1
|
|---|
| 157 | S:$$PARAM^RORTSK01("PATIENTS","OUTPATIENT") MODE("O")=1
|
|---|
| 158 | ;--- Utilization date range
|
|---|
| 159 | D:$$PARAM^RORTSK01("PATIENTS","CAREONLY")
|
|---|
| 160 | . S UTSDT=$$PARAM^RORTSK01("DATE_RANGE_3","START")\1
|
|---|
| 161 | . S UTEDT=$$PARAM^RORTSK01("DATE_RANGE_3","END")\1
|
|---|
| 162 | . ;--- Combined date range
|
|---|
| 163 | . S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,UTSDT)
|
|---|
| 164 | . S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,UTEDT)
|
|---|
| 165 | ;--- Number of patients in the registry
|
|---|
| 166 | S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
|
|---|
| 167 | ;
|
|---|
| 168 | ;=== Browse through the registry records
|
|---|
| 169 | S IEN=0
|
|---|
| 170 | F S IEN=$O(@XREFNODE@(IEN)) Q:IEN'>0 D Q:RC<0
|
|---|
| 171 | . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
|
|---|
| 172 | . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
|
|---|
| 173 | . S IENS=IEN_",",CNT=CNT+1
|
|---|
| 174 | . ;--- Check if the patient should be skipped
|
|---|
| 175 | . Q:$$SKIP^RORXU005(IEN,FLAGS,SKIPSDT,SKIPEDT)
|
|---|
| 176 | . ;
|
|---|
| 177 | . ;--- Get the patient IEN (DFN)
|
|---|
| 178 | . S PTIEN=$$PTIEN^RORUTL01(IEN) Q:PTIEN'>0
|
|---|
| 179 | . M RORPTGRP=RORIGRP("C")
|
|---|
| 180 | . ;
|
|---|
| 181 | . ;--- Inpatient codes (ICD-9)
|
|---|
| 182 | . I $G(MODE("I")) D I RC Q:RC<0 S ECNT=ECNT+RC
|
|---|
| 183 | . . S RC=$$INPAT(PTIEN)
|
|---|
| 184 | . ;--- Outpatient codes (CPT)
|
|---|
| 185 | . I $G(MODE("O")) D I RC Q:RC<0 S ECNT=ECNT+RC
|
|---|
| 186 | . . S RC=$$OUTPAT(PTIEN)
|
|---|
| 187 | . ;
|
|---|
| 188 | . ;--- If ICD-9 codes from some groups have not been found,
|
|---|
| 189 | . ;--- then do not consider inpatient procedures at all
|
|---|
| 190 | . K:$D(RORPTGRP)>1 @RORTMP@("PAT",PTIEN,"I")
|
|---|
| 191 | . ;---
|
|---|
| 192 | . S SKIP=($D(@RORTMP@("PAT",PTIEN))<10)
|
|---|
| 193 | . S:RORPROC<0 SKIP='SKIP
|
|---|
| 194 | . ;
|
|---|
| 195 | . ;--- Check for any utilization in the corresponding date range
|
|---|
| 196 | . I 'SKIP D:$$PARAM^RORTSK01("PATIENTS","CAREONLY")
|
|---|
| 197 | . . K TMP S TMP("ALL")=1
|
|---|
| 198 | . . S UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,PTIEN,.TMP)
|
|---|
| 199 | . . S:'UTIL SKIP=1
|
|---|
| 200 | . ;
|
|---|
| 201 | . ;--- Skip the patient if not all search criteria have been met
|
|---|
| 202 | . I SKIP K @RORTMP@("PAT",PTIEN) Q
|
|---|
| 203 | . ;
|
|---|
| 204 | . ;--- Calculate the patient's totals
|
|---|
| 205 | . S RC=$$TOTALS(PTIEN)
|
|---|
| 206 | . I RC Q:RC<0 S ECNT=ECNT+RC
|
|---|
| 207 | ;---
|
|---|
| 208 | Q $S(RC<0:RC,1:ECNT)
|
|---|
| 209 | ;
|
|---|
| 210 | ;***** SORTS THE RESULTS AND COMPILES THE TOTALS
|
|---|
| 211 | ;
|
|---|
| 212 | ; Return Values:
|
|---|
| 213 | ; <0 Error code
|
|---|
| 214 | ; 0 Ok
|
|---|
| 215 | ; >0 Number of non-fatal errors
|
|---|
| 216 | ;
|
|---|
| 217 | SORT() ;
|
|---|
| 218 | N IEN,SRC,TMP,TNC,TNDC
|
|---|
| 219 | ;---
|
|---|
| 220 | S (TNC,TNDC)=0
|
|---|
| 221 | F SRC="I","O" D
|
|---|
| 222 | . S IEN=0
|
|---|
| 223 | . F S IEN=$O(@RORTMP@("PROC",SRC,IEN)) Q:IEN'>0 D
|
|---|
| 224 | . . S TMP=$P($G(@RORTMP@("PROC",SRC,IEN)),U,2)
|
|---|
| 225 | . . S:TMP'="" @RORTMP@("PROC","B",TMP,SRC,IEN)=""
|
|---|
| 226 | . . S TNC=TNC+$G(@RORTMP@("PROC",SRC,IEN,"C"))
|
|---|
| 227 | . . S TNDC=TNDC+1
|
|---|
| 228 | S @RORTMP@("PROC")=TNC_U_TNDC
|
|---|
| 229 | ;---
|
|---|
| 230 | Q 0
|
|---|
| 231 | ;
|
|---|
| 232 | ;***** CALCULATES INTERMEDIATE TOTALS
|
|---|
| 233 | ;
|
|---|
| 234 | ; PTIEN Patient IEN (DFN)
|
|---|
| 235 | ;
|
|---|
| 236 | ; Return Values:
|
|---|
| 237 | ; <0 Error code
|
|---|
| 238 | ; 0 Ok
|
|---|
| 239 | ; >0 Number of non-fatal errors
|
|---|
| 240 | ;
|
|---|
| 241 | TOTALS(PTIEN) ;
|
|---|
| 242 | N CNT,CODE,IEN,NAME,PNODE,RC,SRC,TMP,VA,VADM
|
|---|
| 243 | S PNODE=$NA(@RORTMP@("PAT",PTIEN))
|
|---|
| 244 | ;--- Get and store the patient's data
|
|---|
| 245 | D VADEM^RORUTL05(PTIEN,1)
|
|---|
| 246 | S @PNODE=VA("BID")_U_VADM(1)_U_$$DATE^RORXU002(VADM(6)\1)
|
|---|
| 247 | S ^("PAT")=$G(@RORTMP@("PAT"))+1
|
|---|
| 248 | ;
|
|---|
| 249 | F SRC="I","O" D
|
|---|
| 250 | . S IEN=0
|
|---|
| 251 | . F S IEN=$O(@PNODE@(SRC,IEN)) Q:IEN'>0 D
|
|---|
| 252 | . . S CODE=$P($G(@RORTMP@("PROC",SRC,IEN)),U),NAME=""
|
|---|
| 253 | . . D:CODE=""
|
|---|
| 254 | . . . I SRC="O" D
|
|---|
| 255 | . . . . S TMP=$$CPT^ICPTCOD(IEN)
|
|---|
| 256 | . . . . S:TMP'<0 CODE=$P(TMP,U,2),NAME=$P(TMP,U,3)
|
|---|
| 257 | . . . E D
|
|---|
| 258 | . . . . S TMP=$$ICDOP^ICDCODE(IEN)
|
|---|
| 259 | . . . . S:TMP'<0 CODE=$P(TMP,U,2),NAME=$P(TMP,U,5)
|
|---|
| 260 | . . . S:CODE="" CODE="UNKN"
|
|---|
| 261 | . . . S:NAME="" NAME="Unknown ("_IEN_")"
|
|---|
| 262 | . . . S @RORTMP@("PROC",SRC,IEN)=CODE_U_NAME
|
|---|
| 263 | . . ;---
|
|---|
| 264 | . . S CNT=+$G(@PNODE@(SRC,IEN,"C"))
|
|---|
| 265 | . . S ^("C")=$G(@RORTMP@("PROC",SRC,IEN,"C"))+CNT
|
|---|
| 266 | . . S ^("P")=$G(@RORTMP@("PROC",SRC,IEN,"P"))+1
|
|---|
| 267 | Q 0
|
|---|
