| [613] | 1 | RORX005A ;HCIOFO/BH,SG - INPATIENT UTILIZATION (QUERY) ; 3/13/06 9:25am
|
|---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine uses the following IAs:
|
|---|
| 5 | ;
|
|---|
| 6 | ; #92 Read access to the file #45 (controlled)
|
|---|
| 7 | ; #557 Read access to the file #40.7 (controlled)
|
|---|
| 8 | ; #2438 .01 field and "C" x-ref of file #40.8 (controlled)
|
|---|
| 9 | ; #10035 Read access to the file #2 (supported)
|
|---|
| 10 | ;
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | ;***** ADDS THE INPATIENT STAY
|
|---|
| 14 | ;
|
|---|
| 15 | ; DFN Patient IEN (in file #2)
|
|---|
| 16 | ; PTFIEN IEN of the PTF record
|
|---|
| 17 | ; LOS Length of stay
|
|---|
| 18 | ; BSID Bed section ID
|
|---|
| 19 | ; DATE Movement date/time (FileMan)
|
|---|
| 20 | ;
|
|---|
| 21 | ADDSTAY(DFN,PTFIEN,LOS,BSID,DATE) ;
|
|---|
| 22 | N DST,I,TMP
|
|---|
| 23 | S:$G(BSID)="" BSID=0
|
|---|
| 24 | ;--- Number of patients for the bedsection
|
|---|
| 25 | I 'BSID S DST=$NA(@RORDST@("IP",DFN))
|
|---|
| 26 | E S DST=$NA(@RORDST@("IPB",BSID)) D:'$D(@DST@("P",DFN))
|
|---|
| 27 | . S @DST@("P")=$G(@DST@("P"))+1,@DST@("P",DFN)=""
|
|---|
| 28 | ;--- No bed section ID
|
|---|
| 29 | S:BSID<0 @RORDST@("IPNOBS",RORPNAME,DATE,PTFIEN,DFN)=""
|
|---|
| 30 | ;--- Short stays (visits)
|
|---|
| 31 | I LOS'>0 S @DST@("V")=$G(@DST@("V"))+1 Q
|
|---|
| 32 | ;--- Days and stays
|
|---|
| 33 | S @DST@("D")=$G(@DST@("D"))+LOS
|
|---|
| 34 | S @DST@("S")=$G(@DST@("S"))+1
|
|---|
| 35 | ;--- Lengths of stay for median value calculations
|
|---|
| 36 | S I=$O(@RORDST@("IPMLOS",BSID,LOS,""),-1)+1
|
|---|
| 37 | S @RORDST@("IPMLOS",BSID,LOS,I)=""
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | ;***** LOADS AND PROCESSES THE INPATIENT DATA
|
|---|
| 41 | ;
|
|---|
| 42 | ; DFN Patient IEN (in file #2)
|
|---|
| 43 | ;
|
|---|
| 44 | ; Return Values:
|
|---|
| 45 | ; <0 Error code
|
|---|
| 46 | ; 0 Ok
|
|---|
| 47 | ; >0 Number of non-fatal errors
|
|---|
| 48 | ;
|
|---|
| 49 | IPDATA(DFN) ;
|
|---|
| 50 | N RORDST ; Closed reference to the category node in ^TMP
|
|---|
| 51 | ;
|
|---|
| 52 | N BSID,DATE,DISDT,ENDT,FACILITY,LOS,PTFIEN,RC,RORMSG,STDT,SUFFIX,TMP,VAHOW,VAIP,VAROOT,XDATE
|
|---|
| 53 | S RORDST=$NA(^TMP("RORX005",$J))
|
|---|
| 54 | ;---
|
|---|
| 55 | S XDATE=RORSDT
|
|---|
| 56 | F S RC=0 D Q:RC<2 S XDATE=$O(^DGPT("AAD",DFN,XDATE)) Q:XDATE'>0
|
|---|
| 57 | . I XDATE'<ROREDT1 S RC=1 Q
|
|---|
| 58 | . K DATE,LOS,VAIP S VAIP(16,1)=XDATE
|
|---|
| 59 | . F D Q:RC
|
|---|
| 60 | . . S VAIP("D")=+$G(VAIP(16,1))
|
|---|
| 61 | . . I VAIP("D")'>0 S RC=2 Q
|
|---|
| 62 | . . D IN5^VADPT
|
|---|
| 63 | . . I $G(VAIP(1))'>0 S RC=2 Q
|
|---|
| 64 | . . S DATE=+VAIP(3)
|
|---|
| 65 | . . Q:+$G(VAIP(4))=3
|
|---|
| 66 | . . ;--- Check the movement date
|
|---|
| 67 | . . I DATE'<ROREDT1 S RC=1 Q
|
|---|
| 68 | . . S:DATE<RORSDT DATE=RORSDT
|
|---|
| 69 | . . ;--- Check the PTF record
|
|---|
| 70 | . . S PTFIEN=+$G(VAIP(12)) Q:PTFIEN'>0
|
|---|
| 71 | . . I '$D(PTFIEN(PTFIEN)) D Q:RC
|
|---|
| 72 | . . . S PTFIEN(PTFIEN)=0
|
|---|
| 73 | . . . Q:$$PTF^RORXU001(PTFIEN,"FP",,,.SUFFIX,,.FACILITY)
|
|---|
| 74 | . . . ;--- Check the suffix
|
|---|
| 75 | . . . ;I SUFFIX'="" Q:$$VSUFFIX(SUFFIX) ; ROR 1.5
|
|---|
| 76 | . . . ;--- Check the division
|
|---|
| 77 | . . . S TMP=$$PARAM^RORTSK01("DIVISIONS","ALL")
|
|---|
| 78 | . . . I 'TMP D Q:'$D(RORTSK("PARAMS","DIVISIONS","C",DIVIEN))
|
|---|
| 79 | . . . . S TMP=FACILITY_SUFFIX
|
|---|
| 80 | . . . . S DIVIEN=$S(TMP'="":+$O(^DG(40.8,"C",TMP,"")),1:0)
|
|---|
| 81 | . . . S PTFIEN(PTFIEN)=1
|
|---|
| 82 | . . ;--- Skip the PTF record if necessary
|
|---|
| 83 | . . Q:'PTFIEN(PTFIEN)
|
|---|
| 84 | . . ;--- Process the admission (only once)
|
|---|
| 85 | . . I '$D(LOS) D Q:RC
|
|---|
| 86 | . . . S LOS=$$LOS(+$G(VAIP(13,1)),+$G(VAIP(17,1)))
|
|---|
| 87 | . . . D ADDSTAY(DFN,PTFIEN,LOS)
|
|---|
| 88 | . . ;--- Process the movement
|
|---|
| 89 | . . S ENDT=$G(VAIP(16,1))\1
|
|---|
| 90 | . . S:(ENDT'>0)!(ENDT'<ROREDT1) ENDT=ROREDT,RC=2
|
|---|
| 91 | . . Q:ENDT<RORSDT
|
|---|
| 92 | . . S LOS=$$FMDIFF^XLFDT(ENDT,DATE\1,1) S:LOS'>0 LOS=0
|
|---|
| 93 | . . ;--- Use the IEN in the SPECIALTY file (#42.4) as the Bedsection
|
|---|
| 94 | . . ; ID if it is available (it should be). Otherwise, use the
|
|---|
| 95 | . . ;--- IEN in the FACILITY TREATING SPECIALTY file (#45.7).
|
|---|
| 96 | . . I $G(VAIP(8))>0 D
|
|---|
| 97 | . . . S TMP=$$GET1^DIQ(45.7,+VAIP(8),1,"I",,"RORMSG")
|
|---|
| 98 | . . . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,DFN,45.7,+VAIP(8))
|
|---|
| 99 | . . . S BSID=$S(TMP>0:TMP_";42.4",1:+VAIP(8)_";45.7")
|
|---|
| 100 | . . E S BSID=-1
|
|---|
| 101 | . . D ADDSTAY(DFN,PTFIEN,LOS,BSID,+VAIP(3))
|
|---|
| 102 | . S:$G(DATE)>XDATE XDATE=DATE
|
|---|
| 103 | ;---
|
|---|
| 104 | Q $S(RC<0:RC,1:0)
|
|---|
| 105 | ;
|
|---|
| 106 | ;***** CALCULATES THE LENGTH OF STAY
|
|---|
| 107 | LOS(STDT,ENDT) ;
|
|---|
| 108 | N DAYS
|
|---|
| 109 | S:STDT<RORSDT STDT=RORSDT
|
|---|
| 110 | S:(ENDT'>0)!(ENDT>ROREDT) ENDT=ROREDT
|
|---|
| 111 | S DAYS=$$FMDIFF^XLFDT(ENDT\1,STDT\1,1)
|
|---|
| 112 | Q $S(DAYS'<0:DAYS,1:0)
|
|---|
| 113 | ;
|
|---|
| 114 | ;***** QUERIES THE REGISTRY
|
|---|
| 115 | ;
|
|---|
| 116 | ; FLAGS Flags for the $$SKIP^RORXU005
|
|---|
| 117 | ;
|
|---|
| 118 | ; Return Values:
|
|---|
| 119 | ; <0 Error code
|
|---|
| 120 | ; 0 Ok
|
|---|
| 121 | ; >0 Number of non-fatal errors
|
|---|
| 122 | ;
|
|---|
| 123 | QUERY(FLAGS) ;
|
|---|
| 124 | N ROREDT1 ; Day after the end date
|
|---|
| 125 | N RORLAST4 ; Last 4 digits of the current patient's SSN
|
|---|
| 126 | N RORPNAME ; Name of the current patient
|
|---|
| 127 | N RORPTN ; Number of patients in the registry
|
|---|
| 128 | ;
|
|---|
| 129 | N CNT,ECNT,IEN,IENS,PATIEN,RC,TMP,VA,VADM,XREFNODE
|
|---|
| 130 | S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
|
|---|
| 131 | S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
|
|---|
| 132 | S ROREDT1=$$FMADD^XLFDT(ROREDT,1)
|
|---|
| 133 | S (CNT,ECNT,RC)=0
|
|---|
| 134 | ;--- Browse through the registry records
|
|---|
| 135 | S IEN=0
|
|---|
| 136 | F S IEN=$O(@XREFNODE@(IEN)) Q:IEN'>0 D Q:RC<0
|
|---|
| 137 | . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
|
|---|
| 138 | . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
|
|---|
| 139 | . S IENS=IEN_",",CNT=CNT+1
|
|---|
| 140 | . ;--- Check if the patient should be skipped
|
|---|
| 141 | . Q:$$SKIP^RORXU005(IEN,FLAGS,RORSDT,ROREDT)
|
|---|
| 142 | . ;
|
|---|
| 143 | . ;--- Get the patient IEN (DFN)
|
|---|
| 144 | . S PATIEN=$$PTIEN^RORUTL01(IEN) Q:PATIEN'>0
|
|---|
| 145 | . ;
|
|---|
| 146 | . ;--- Get the patient's data
|
|---|
| 147 | . D VADEM^RORUTL05(PATIEN,1)
|
|---|
| 148 | . S RORPNAME=VADM(1),RORLAST4=VA("BID")
|
|---|
| 149 | . ;
|
|---|
| 150 | . ;--- Get the inpatient data
|
|---|
| 151 | . S RC=$$IPDATA(PATIEN)
|
|---|
| 152 | . I RC S ECNT=ECNT+1 Q:RC<0
|
|---|
| 153 | . ;
|
|---|
| 154 | . ;--- Calculate intermediate totals
|
|---|
| 155 | . S RC=$$TOTALS^RORX005B(PATIEN)
|
|---|
| 156 | . I RC S ECNT=ECNT+1 Q:RC<0
|
|---|
| 157 | ;---
|
|---|
| 158 | Q $S(RC<0:RC,1:ECNT)
|
|---|
| 159 | ;
|
|---|
| 160 | ;***** CHECKS THE SUFFIX FOR VALIDITY
|
|---|
| 161 | ;
|
|---|
| 162 | ; SUFFIX Suffix
|
|---|
| 163 | ;
|
|---|
| 164 | ; Return Values:
|
|---|
| 165 | ; 0 Ok
|
|---|
| 166 | ; 1 Invalid suffix
|
|---|
| 167 | VSUFFIX(SUFFIX) ;
|
|---|
| 168 | Q '("9AA,9AB,9AC,9AD,9AE,9BB,A0,A4,A5,BU,BV,PA"[SUFFIX)
|
|---|
