268 lines
8.0 KiB
Mathematica
268 lines
8.0 KiB
Mathematica
RORX015A ;HCIOFO/SG - OUTPATIENT PROCEDURES (QUERY & SORT) ; 6/21/06 4:36pm
|
|
;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
|
|
;
|
|
; This routine uses the following IAs:
|
|
;
|
|
; #1995 $$CODEN^ICPTCOD and $$CPT^ICPTCOD (supported)
|
|
; #2548 SDQ routine (supported)
|
|
; #3990 $$CODEN^ICDCODE and $$ICDOP^ICDCODE (supported)
|
|
;
|
|
Q
|
|
;
|
|
;***** SEARCHES FOR INPATIENT PROCEDURES
|
|
;
|
|
; PTIEN Patient IEN (DFN)
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
; >0 Number of non-fatal errors
|
|
;
|
|
INPAT(PTIEN) ;
|
|
N DATE,ERRCNT,FLDLST,IEN,IEN45,IENS,NODE,RC,RORBUF,RORMSG,XREF
|
|
S (ERRCNT,RC)=0
|
|
S XREF=$$ROOT^DILFD(45,,1),XREF=$NA(@XREF@("B",PTIEN))
|
|
S IEN45=0
|
|
F S IEN45=$O(@XREF@(IEN45)) Q:IEN45'>0 D
|
|
. ;Q:$$GET1^DIQ(45,IEN45_",",6,"I",,"RORMSG")<1 ; Skip open records
|
|
. ;S IENS=IEN45_","
|
|
. ;S FLDLST="45.01;45.02;45.03;45.04;45.05"
|
|
. ;D GETS^DIQ(45,IENS,FLDLST,"I","RORBUF","RORMSG")
|
|
. ;I $G(DIERR) D S ERRCNT=ERRCNT+1
|
|
. ;. D DBS^RORERR("RORMSG",-99,,PTIEN,45,IENS)
|
|
. ;D INP(PTIEN,$NA(RORBUF(IENS)),FLDLST,???)
|
|
. ;--- Surgical procedures
|
|
. S NODE=$$ROOT^DILFD(45.01,","_IEN45_",",1)
|
|
. S IEN=0
|
|
. F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D
|
|
. . S IENS=IEN_","_IEN45_"," K RORBUF
|
|
. . S FLDLST="8;9;10;11;12"
|
|
. . ;--- Load the data
|
|
. . D GETS^DIQ(45.01,IENS,".01;"_FLDLST,"I","RORBUF","RORMSG")
|
|
. . I $G(DIERR) D S ERRCNT=ERRCNT+1
|
|
. . . D DBS^RORERR("RORMSG",-99,,PTIEN,45.01,IENS)
|
|
. . S DATE=$G(RORBUF(45.01,IENS,.01,"I"))
|
|
. . Q:(DATE<RORSDT)!(DATE'<ROREDT1)
|
|
. . ;--- Generate the output
|
|
. . D INP(PTIEN,$NA(RORBUF(45.01,IENS)),FLDLST,DATE)
|
|
. ;--- Other procedures
|
|
. S NODE=$$ROOT^DILFD(45.05,","_IEN45_",",1)
|
|
. S IEN=0
|
|
. F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D
|
|
. . S IENS=IEN_","_IEN45_"," K RORBUF
|
|
. . S FLDLST="4;5;6;7;8"
|
|
. . ;--- Load the data
|
|
. . D GETS^DIQ(45.05,IENS,".01;"_FLDLST,"I","RORBUF","RORMSG")
|
|
. . I $G(DIERR) D S ERRCNT=ERRCNT+1
|
|
. . . D DBS^RORERR("RORMSG",-99,,PTIEN,45.05,IENS)
|
|
. . S DATE=$G(RORBUF(45.05,IENS,.01,"I"))
|
|
. . Q:(DATE<RORSDT)!(DATE'<ROREDT1)
|
|
. . ;--- Generate the output
|
|
. . D INP(PTIEN,$NA(RORBUF(45.05,IENS)),FLDLST,DATE)
|
|
;---
|
|
Q $S(RC<0:RC,1:ERRCNT)
|
|
;
|
|
;****
|
|
INP(PTIEN,ROR8BUF,FLDLST,DATE) ;
|
|
N I,ICD9IEN,FLD
|
|
F I=1:1 S FLD=$P(FLDLST,";",I) Q:FLD="" D
|
|
. S ICD9IEN=+$G(@ROR8BUF@(FLD,"I"))
|
|
. D:ICD9IEN>0 PROCSET(PTIEN,"I",ICD9IEN,DATE)
|
|
Q
|
|
;
|
|
;***** CALL-BACK PROCEDURE FOR THE OUTPATIENT SEARCH
|
|
;
|
|
; PTIEN Patient IEN (DFN)
|
|
;
|
|
OPSCAN(PTIEN) ;
|
|
N CPTIEN,DATE,IEN,RORCPT,VDATE
|
|
D GETCPT^SDOE(Y,"RORCPT")
|
|
Q:$G(RORCPT)'>0
|
|
S VDATE=+$P(Y0,U)
|
|
;---
|
|
S IEN=0
|
|
F S IEN=$O(RORCPT(IEN)) Q:IEN'>0 D
|
|
. S CPTIEN=+$P(RORCPT(IEN),U),DATE=+$P($G(RORCPT(IEN,12)),U)
|
|
. D:CPTIEN>0 PROCSET(PTIEN,"O",CPTIEN,$S(DATE>0:DATE,1:VDATE))
|
|
Q
|
|
;
|
|
;***** SEARCHES FOR OUTPATIENT PROCEDURES
|
|
;
|
|
; PTIEN Patient IEN (DFN)
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
; >0 Number of non-fatal errors
|
|
;
|
|
OUTPAT(PTIEN) ;
|
|
N QUERY
|
|
D OPEN^SDQ(.QUERY)
|
|
D INDEX^SDQ(.QUERY,"PATIENT/DATE","SET")
|
|
D PAT^SDQ(.QUERY,PTIEN,"SET")
|
|
D DATE^SDQ(.QUERY,RORSDT,ROREDT1,"SET")
|
|
D SCANCB^SDQ(.QUERY,"D OPSCAN^RORX015A("_PTIEN_")","SET")
|
|
D ACTIVE^SDQ(.QUERY,"TRUE","SET")
|
|
D SCAN^SDQ(.QUERY,"FORWARD")
|
|
D CLOSE^SDQ(.QUERY)
|
|
Q 0
|
|
;
|
|
;**** STORES THE PROCEDURE CODE
|
|
;
|
|
; PTIEN Patient IEN (DFN)
|
|
; SOURCE CPT source code ("O" or "I")
|
|
; [IEN] IEN of the procedure descriptor (file #81 or #80.1)
|
|
; DATE Date when the code was entered
|
|
; [CODE] Procedure code (CPT or ICD-9)
|
|
;
|
|
; Either the IEN or the CODE parameter must be provided.
|
|
;
|
|
PROCSET(PTIEN,SOURCE,IEN,DATE,CODE) ;
|
|
Q:DATE'>0
|
|
N TMP
|
|
S IEN=+$G(IEN)
|
|
;---
|
|
I IEN'>0 Q:$G(CODE)="" D Q:IEN'>0
|
|
. I SOURCE="O" S IEN=+$$CODEN^ICPTCOD(CODE) Q
|
|
. I SOURCE="I" S IEN=+$$CODEN^ICDCODE(CODE,80.1) Q
|
|
;---
|
|
I SOURCE="O",'$$PARAM^RORTSK01("CPTLST","ALL") D Q:'TMP
|
|
. S TMP=$D(RORTSK("PARAMS","CPTLST","C",IEN))
|
|
I SOURCE="I" Q:$$ICDGRCHK^RORXU008(.RORPTGRP,IEN,RORICDL)
|
|
;---
|
|
S TMP=+$G(@RORTMP@("PAT",PTIEN,SOURCE,IEN))
|
|
S:'TMP!(DATE<TMP) @RORTMP@("PAT",PTIEN,SOURCE,IEN)=DATE
|
|
S ^("C")=$G(@RORTMP@("PAT",PTIEN,SOURCE,IEN,"C"))+1
|
|
Q
|
|
;
|
|
;***** QUERIES THE REGISTRY
|
|
;
|
|
; FLAGS Flags for the $$SKIP^RORXU005
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
; >0 Number of non-fatal errors
|
|
;
|
|
QUERY(FLAGS) ;
|
|
N ROREDT1 ; Day after the end date
|
|
N RORPTGRP ; Temporary list of ICD-9 groups
|
|
N RORPTN ; Number of patients in the registry
|
|
;
|
|
N CNT,ECNT,IEN,IENS,MODE,PTIEN,RC,SKIP,SKIPEDT,SKIPSDT,TMP,UTEDT,UTSDT,XREFNODE
|
|
S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
|
|
S ROREDT1=$$FMADD^XLFDT(ROREDT\1,1)
|
|
S (CNT,ECNT,RC)=0,SKIPEDT=ROREDT,SKIPSDT=RORSDT
|
|
S:$$PARAM^RORTSK01("PATIENTS","INPATIENT") MODE("I")=1
|
|
S:$$PARAM^RORTSK01("PATIENTS","OUTPATIENT") MODE("O")=1
|
|
;--- Utilization date range
|
|
D:$$PARAM^RORTSK01("PATIENTS","CAREONLY")
|
|
. S UTSDT=$$PARAM^RORTSK01("DATE_RANGE_3","START")\1
|
|
. S UTEDT=$$PARAM^RORTSK01("DATE_RANGE_3","END")\1
|
|
. ;--- Combined date range
|
|
. S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,UTSDT)
|
|
. S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,UTEDT)
|
|
;--- Number of patients in the registry
|
|
S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
|
|
;
|
|
;=== Browse through the registry records
|
|
S IEN=0
|
|
F S IEN=$O(@XREFNODE@(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,FLAGS,SKIPSDT,SKIPEDT)
|
|
. ;
|
|
. ;--- Get the patient IEN (DFN)
|
|
. S PTIEN=$$PTIEN^RORUTL01(IEN) Q:PTIEN'>0
|
|
. M RORPTGRP=RORIGRP("C")
|
|
. ;
|
|
. ;--- Inpatient codes (ICD-9)
|
|
. I $G(MODE("I")) D I RC Q:RC<0 S ECNT=ECNT+RC
|
|
. . S RC=$$INPAT(PTIEN)
|
|
. ;--- Outpatient codes (CPT)
|
|
. I $G(MODE("O")) D I RC Q:RC<0 S ECNT=ECNT+RC
|
|
. . S RC=$$OUTPAT(PTIEN)
|
|
. ;
|
|
. ;--- If ICD-9 codes from some groups have not been found,
|
|
. ;--- then do not consider inpatient procedures at all
|
|
. K:$D(RORPTGRP)>1 @RORTMP@("PAT",PTIEN,"I")
|
|
. ;---
|
|
. S SKIP=($D(@RORTMP@("PAT",PTIEN))<10)
|
|
. S:RORPROC<0 SKIP='SKIP
|
|
. ;
|
|
. ;--- Check for any utilization in the corresponding date range
|
|
. I 'SKIP D:$$PARAM^RORTSK01("PATIENTS","CAREONLY")
|
|
. . K TMP S TMP("ALL")=1
|
|
. . S UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,PTIEN,.TMP)
|
|
. . S:'UTIL SKIP=1
|
|
. ;
|
|
. ;--- Skip the patient if not all search criteria have been met
|
|
. I SKIP K @RORTMP@("PAT",PTIEN) Q
|
|
. ;
|
|
. ;--- Calculate the patient's totals
|
|
. S RC=$$TOTALS(PTIEN)
|
|
. I RC Q:RC<0 S ECNT=ECNT+RC
|
|
;---
|
|
Q $S(RC<0:RC,1:ECNT)
|
|
;
|
|
;***** SORTS THE RESULTS AND COMPILES THE TOTALS
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
; >0 Number of non-fatal errors
|
|
;
|
|
SORT() ;
|
|
N IEN,SRC,TMP,TNC,TNDC
|
|
;---
|
|
S (TNC,TNDC)=0
|
|
F SRC="I","O" D
|
|
. S IEN=0
|
|
. F S IEN=$O(@RORTMP@("PROC",SRC,IEN)) Q:IEN'>0 D
|
|
. . S TMP=$P($G(@RORTMP@("PROC",SRC,IEN)),U,2)
|
|
. . S:TMP'="" @RORTMP@("PROC","B",TMP,SRC,IEN)=""
|
|
. . S TNC=TNC+$G(@RORTMP@("PROC",SRC,IEN,"C"))
|
|
. . S TNDC=TNDC+1
|
|
S @RORTMP@("PROC")=TNC_U_TNDC
|
|
;---
|
|
Q 0
|
|
;
|
|
;***** CALCULATES INTERMEDIATE TOTALS
|
|
;
|
|
; PTIEN Patient IEN (DFN)
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
; >0 Number of non-fatal errors
|
|
;
|
|
TOTALS(PTIEN) ;
|
|
N CNT,CODE,IEN,NAME,PNODE,RC,SRC,TMP,VA,VADM
|
|
S PNODE=$NA(@RORTMP@("PAT",PTIEN))
|
|
;--- Get and store the patient's data
|
|
D VADEM^RORUTL05(PTIEN,1)
|
|
S @PNODE=VA("BID")_U_VADM(1)_U_$$DATE^RORXU002(VADM(6)\1)
|
|
S ^("PAT")=$G(@RORTMP@("PAT"))+1
|
|
;
|
|
F SRC="I","O" D
|
|
. S IEN=0
|
|
. F S IEN=$O(@PNODE@(SRC,IEN)) Q:IEN'>0 D
|
|
. . S CODE=$P($G(@RORTMP@("PROC",SRC,IEN)),U),NAME=""
|
|
. . D:CODE=""
|
|
. . . I SRC="O" D
|
|
. . . . S TMP=$$CPT^ICPTCOD(IEN)
|
|
. . . . S:TMP'<0 CODE=$P(TMP,U,2),NAME=$P(TMP,U,3)
|
|
. . . E D
|
|
. . . . S TMP=$$ICDOP^ICDCODE(IEN)
|
|
. . . . S:TMP'<0 CODE=$P(TMP,U,2),NAME=$P(TMP,U,5)
|
|
. . . S:CODE="" CODE="UNKN"
|
|
. . . S:NAME="" NAME="Unknown ("_IEN_")"
|
|
. . . S @RORTMP@("PROC",SRC,IEN)=CODE_U_NAME
|
|
. . ;---
|
|
. . S CNT=+$G(@PNODE@(SRC,IEN,"C"))
|
|
. . S ^("C")=$G(@RORTMP@("PROC",SRC,IEN,"C"))+CNT
|
|
. . S ^("P")=$G(@RORTMP@("PROC",SRC,IEN,"P"))+1
|
|
Q 0
|