source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX005C.m

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