176 lines
5.6 KiB
Mathematica
176 lines
5.6 KiB
Mathematica
RORX005C ;HCIOFO/BH,SG - INPATIENT UTILIZATION (STORE) ; 9/14/05 9:17am
|
|
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|
;
|
|
Q
|
|
;
|
|
;***** HIGHEST UTILIZATION
|
|
;
|
|
; PRNTELMT IEN of the parent element
|
|
;
|
|
; RORNODE Closed root of the section in the temporary global
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
;
|
|
HIGHUTIL(PRNTELMT,RORNODE) ;
|
|
N RC,RORMAXUT,RORTCNT,SECTION,TMP
|
|
S RORMAXUT=$$PARAM^RORTSK01("MAXUTNUM")
|
|
Q:RORMAXUT'>0 0
|
|
S SECTION=$$ADDVAL^RORTSK11(RORTSK,"HIGHUTIL",,PRNTELMT)
|
|
Q:SECTION<0 SECTION
|
|
S (RC,RORTCNT)=0
|
|
;--- Stays
|
|
S RC=$$HIGHUTSD(SECTION,"IPS","HU_STAYS") Q:RC<0 RC
|
|
;--- Days
|
|
S RC=$$HIGHUTSD(SECTION,"IPD","HU_DAYS") Q:RC<0 RC
|
|
;--- Disable the empty section
|
|
D:RORTCNT'>0 UPDVAL^RORTSK11(RORTSK,SECTION,"",,1)
|
|
Q 0
|
|
;
|
|
;*****
|
|
;
|
|
; SECTION IEN of the parent element
|
|
;
|
|
; SUBS Utilization subscript in the temporary global
|
|
;
|
|
; TBLNAME Name of the table element
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
;
|
|
HIGHUTSD(SECTION,SUBS,TBLNAME) ;
|
|
Q:$D(@RORNODE@(SUBS))<10 0
|
|
N COUNT,DFN,ITEM,NAME,NUM,RC,TABLE,TMP
|
|
S TABLE=$$ADDVAL^RORTSK11(RORTSK,TBLNAME,,SECTION)
|
|
Q:TABLE<0 TABLE
|
|
D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE",TBLNAME)
|
|
S RORTCNT=RORTCNT+1
|
|
;---
|
|
S NUM="",(COUNT,RC)=0
|
|
F S NUM=$O(@RORNODE@(SUBS,NUM),-1) Q:NUM="" D Q:RC
|
|
. S NAME=""
|
|
. F S NAME=$O(@RORNODE@(SUBS,NUM,NAME)) Q:NAME="" D Q:RC
|
|
. . S DFN=""
|
|
. . F S DFN=$O(@RORNODE@(SUBS,NUM,NAME,DFN)) Q:DFN="" D Q:RC
|
|
. . . S COUNT=COUNT+1 I COUNT>RORMAXUT S RC=1 Q
|
|
. . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
|
|
. . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
|
|
. . . S TMP=$G(@RORNODE@("IP",DFN))
|
|
. . . D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(TMP,U),ITEM,2)
|
|
. . . S TMP=+$G(@RORNODE@("IP",DFN,"S"))
|
|
. . . D ADDVAL^RORTSK11(RORTSK,"NST",TMP,ITEM,3)
|
|
. . . S TMP=+$G(@RORNODE@("IP",DFN,"D"))
|
|
. . . D ADDVAL^RORTSK11(RORTSK,"ND",TMP,ITEM,3)
|
|
. . . S TMP=$G(@RORNODE@("IP",DFN,"V"))
|
|
. . . D ADDVAL^RORTSK11(RORTSK,"NSS",TMP,ITEM,3)
|
|
Q 0
|
|
;
|
|
;***** STORES THE REPORT DATA
|
|
;
|
|
; REPORT IEN of the REPORT element
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
; >0 Number of non-fatal errors
|
|
;
|
|
STORE(REPORT) ;
|
|
N RORSONLY ; Output summary only
|
|
;
|
|
N ECNT,NODE,RC,TMP
|
|
S NODE=$NA(^TMP("RORX005",$J))
|
|
Q:$D(@NODE)<10 0
|
|
S RORSONLY=$$SMRYONLY^RORXU006(),(ECNT,RC)=0
|
|
;--- Inpatients
|
|
S RC=$$LOOP^RORTSK01(0) Q:RC<0 RC
|
|
S RC=$$STOREIP(REPORT,NODE)
|
|
I RC Q:RC<0 RC S ECNT=ECNT+1
|
|
;--- Highest utilization
|
|
S RC=$$LOOP^RORTSK01(0.5) Q:RC<0 RC
|
|
S RC=$$HIGHUTIL(REPORT,NODE)
|
|
I RC Q:RC<0 RC S ECNT=ECNT+1
|
|
;---
|
|
Q ECNT
|
|
;
|
|
;***** INPATIENT DATA
|
|
;
|
|
; PRNTELMT IEN of the parent element
|
|
;
|
|
; NODE Closed root of the category section
|
|
; in the temporary global
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
;
|
|
STOREIP(PRNTELMT,NODE) ;
|
|
Q:$D(@NODE@("IP"))<10 0
|
|
N BSID,DATE,ITEM,NAME,NS,PATIEN,PTF,RC,SECTION,TABLE,TMP
|
|
S SECTION=$$ADDVAL^RORTSK11(RORTSK,"INPATIENTS",,PRNTELMT)
|
|
Q:SECTION<0 SECTION
|
|
S RC=0
|
|
;--- Stays
|
|
I $D(@NODE@("IPS"))>1 D Q:RC<0 RC
|
|
. S TABLE=$$ADDVAL^RORTSK11(RORTSK,"STAYS",,SECTION)
|
|
. I TABLE<0 S RC=TABLE Q
|
|
. D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","STAYS")
|
|
. S NS=""
|
|
. F S NS=$O(@NODE@("IPS",NS)) Q:NS="" D
|
|
. . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"ITEM",,TABLE)
|
|
. . D ADDVAL^RORTSK11(RORTSK,"NP",$P(@NODE@("IPS",NS),U),ITEM,3)
|
|
. . D ADDVAL^RORTSK11(RORTSK,"NST",NS,ITEM,3)
|
|
;--- Bed sections (clinics)
|
|
I $D(@NODE@("IPB"))>1 D Q:RC<0 RC
|
|
. S TABLE=$$ADDVAL^RORTSK11(RORTSK,"BEDSECTIONS",,SECTION)
|
|
. I TABLE<0 S RC=TABLE Q
|
|
. D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","BEDSECTIONS")
|
|
. S NAME=""
|
|
. F S NAME=$O(@NODE@("IPB","B",NAME)) Q:NAME="" D
|
|
. . S BSID=""
|
|
. . F S BSID=$O(@NODE@("IPB","B",NAME,BSID)) Q:BSID="" D:BSID>0
|
|
. . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"BEDSECTION",,TABLE)
|
|
. . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
|
|
. . . S TMP=+$G(@NODE@("IPB",BSID,"P"))
|
|
. . . D ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
|
|
. . . S TMP=+$G(@NODE@("IPB",BSID,"S"))
|
|
. . . D ADDVAL^RORTSK11(RORTSK,"NST",TMP,ITEM,3)
|
|
. . . S TMP=+$G(@NODE@("IPB",BSID,"D"))
|
|
. . . D ADDVAL^RORTSK11(RORTSK,"ND",TMP,ITEM,3)
|
|
. . . S TMP=+$G(@NODE@("IPMLOS",BSID))
|
|
. . . D ADDVAL^RORTSK11(RORTSK,"MLOS",$J(TMP,0,1),ITEM,3)
|
|
. . . S TMP=$G(@NODE@("IPB",BSID,"V"))
|
|
. . . D ADDVAL^RORTSK11(RORTSK,"NSS",TMP,ITEM,3)
|
|
;--- No bed section
|
|
I 'RORSONLY,$D(@NODE@("IPNOBS"))>1 D Q:RC<0 RC
|
|
. S TABLE=$$ADDVAL^RORTSK11(RORTSK,"NOBS",,SECTION)
|
|
. I TABLE<0 S RC=TABLE Q
|
|
. D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","NOBS")
|
|
. S NAME=""
|
|
. F S NAME=$O(@NODE@("IPNOBS",NAME)) Q:NAME="" D
|
|
. . S DATE=""
|
|
. . F S DATE=$O(@NODE@("IPNOBS",NAME,DATE)) Q:DATE="" D
|
|
. . . S PTF=""
|
|
. . . F S PTF=$O(@NODE@("IPNOBS",NAME,DATE,PTF)) Q:PTF="" D
|
|
. . . . S DFN=""
|
|
. . . . F S DFN=$O(@NODE@("IPNOBS",NAME,DATE,PTF,DFN)) Q:DFN="" D
|
|
. . . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
|
|
. . . . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
|
|
. . . . . S TMP=$P($G(@NODE@("IP",DFN)),U)
|
|
. . . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",TMP,ITEM,2)
|
|
. . . . . D ADDVAL^RORTSK11(RORTSK,"DATE",DATE,ITEM,3)
|
|
. . . . . D ADDVAL^RORTSK11(RORTSK,"PTF",PTF,ITEM,1)
|
|
;--- Summary
|
|
D ADDVAL^RORTSK11(RORTSK,"NP",+$G(@NODE@("IP")),SECTION)
|
|
D ADDVAL^RORTSK11(RORTSK,"NST",+$G(@NODE@("IPS")),SECTION)
|
|
D ADDVAL^RORTSK11(RORTSK,"ND",+$G(@NODE@("IPD")),SECTION)
|
|
D ADDVAL^RORTSK11(RORTSK,"NSS",+$G(@NODE@("IPV")),SECTION)
|
|
S TMP=$G(@NODE@("IPMLOS",0))
|
|
D ADDVAL^RORTSK11(RORTSK,"MLOS",$J(TMP,0,1),SECTION)
|
|
I $G(@NODE@("IPS"))>0 D
|
|
. S TMP=$G(@NODE@("IPD"))/@NODE@("IPS")
|
|
E S TMP=0
|
|
D ADDVAL^RORTSK11(RORTSK,"ALOS",$J(TMP,0,1),SECTION)
|
|
Q 0
|