Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORX005B

RORX005B.m

Go to the documentation of this file.
  1. RORX005B ;HCIOFO/BH,SG - INPATIENT UTILIZATION (SORT) ; 04 Apr 2016 12:48 PM
  1. ;;1.5;CLINICAL CASE REGISTRIES;**28,31**;Feb 17, 2006;Build 62
  1. ;
  1. ; This routine uses the following IAs:
  1. ;
  1. ; #2056 GET1^DIQ
  1. ;
  1. ;**********************************************************************
  1. ; --- ROUTINE MODIFICATION LOG ---
  1. ;
  1. ;PKG/PATCH DATE DEVELOPER MODIFICATION
  1. ;----------- ---------- ----------- --------------------------------
  1. ;ROR*1.5*28 APR 2016 T KOPP Add ICN data if additional
  1. ; identifier requested.
  1. ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional
  1. ; identifiers.
  1. ;**********************************************************************
  1. ;
  1. Q
  1. ;
  1. ;***** CALCULATES MEDIAN LENGTHS OF STAY
  1. ;
  1. ; NODE Closed root of the category section
  1. ; in the temporary global
  1. ;
  1. ; FSUM Update the summary data (0/1)
  1. ;
  1. MLOS(NODE) ;
  1. N BSID,TMP,XREFNODE
  1. ;--- Median length of the whole stays
  1. S XREFNODE=$NA(@NODE@("IPMLOS",0))
  1. S TMP=$$XREFMDNV^RORXU004(XREFNODE,+$G(@NODE@("IPS")))
  1. S (@NODE@("IPMLOS"),@NODE@("IPMLOS",0))=TMP
  1. ;--- Median lengths of the bed section stays
  1. S BSID=""
  1. F S BSID=$O(@NODE@("IPMLOS",BSID)) Q:BSID="" D:BSID
  1. . S XREFNODE=$NA(@NODE@("IPMLOS",BSID))
  1. . S TMP=+$G(@NODE@("IPB",BSID,"S"))
  1. . S @NODE@("IPMLOS",BSID)=$$XREFMDNV^RORXU004(XREFNODE,TMP)
  1. Q
  1. ;
  1. ;***** SORTS THE RESULTS AND COMPILES THE TOTALS
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ;
  1. SORT() ;
  1. N BSID,DIERR,FILE,IENS,NAME,NODE,RC,RORMSG,TMP
  1. S NODE=$NA(^TMP("RORX005",$J)) Q:$D(@NODE)<10 0
  1. ;--- Bed sections
  1. S RC=$$LOOP^RORTSK01(0) Q:RC<0 RC
  1. S BSID=""
  1. F S BSID=$O(@NODE@("IPB",BSID)) Q:'BSID D
  1. . D:BSID>0
  1. . . S IENS=(+BSID)_",",FILE=+$P(BSID,";",2)
  1. . . S NAME=$$GET1^DIQ(FILE,IENS,.01,,,"RORMSG")
  1. . . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,FILE,IENS)
  1. . . S:NAME?." " NAME="Unknown ("_BSID_")"
  1. . . S @NODE@("IPB","B",NAME,BSID)=""
  1. ;--- Median length of stay
  1. S RC=$$LOOP^RORTSK01(0.5) Q:RC<0 RC
  1. D MLOS(NODE)
  1. ;---
  1. Q 0
  1. ;
  1. ;***** CALCULATES THE INTERMEDIATE TOTALS
  1. ;
  1. ; PATIEN Patient IEN (DFN)
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ;
  1. TOTALS(PATIEN) ;
  1. N NODE,TMP
  1. S NODE=$NA(^TMP("RORX005",$J))
  1. ;
  1. ;=== Inpatient data
  1. D:$D(@NODE@("IP",PATIEN))>1
  1. . N DAYS,STAYS,VISITS
  1. . S RORICN=$S($$PARAM^RORTSK01("PATIENTS","ICN"):$G(RORICN),1:"")
  1. . S RORPACT=$S($$PARAM^RORTSK01("PATIENTS","PACT"):$G(RORPACT),1:"")
  1. . S @NODE@("IP",PATIEN)=RORLAST4_U_RORICN_U_RORPACT_U_$S($$PARAM^RORTSK01("PATIENTS","PCP"):$G(RORPCP),1:"")_U_AGE
  1. . S @NODE@("IP")=$G(@NODE@("IP"))+1
  1. . S STAYS=+$G(@NODE@("IP",PATIEN,"S"))
  1. . S DAYS=+$G(@NODE@("IP",PATIEN,"D"))
  1. . S VISITS=+$G(@NODE@("IP",PATIEN,"V"))
  1. . ;--- Number of stays
  1. . D:(STAYS>0)!(VISITS>0)
  1. . . S @NODE@("IPS")=$G(@NODE@("IPS"))+STAYS
  1. . . S @NODE@("IPS",STAYS)=$G(@NODE@("IPS",STAYS))+1
  1. . . S @NODE@("IPS",STAYS,RORPNAME,PATIEN)=""
  1. . ;--- Number of days
  1. . D:(DAYS>0)!(VISITS>0)
  1. . . S @NODE@("IPD")=$G(@NODE@("IPD"))+DAYS
  1. . . S @NODE@("IPD",DAYS)=$G(@NODE@("IPD",DAYS))+1
  1. . . S @NODE@("IPD",DAYS,RORPNAME,PATIEN)=""
  1. . ;--- Number of short stays (visits)
  1. . D:VISITS>0
  1. . . S @NODE@("IPV")=$G(@NODE@("IPV"))+VISITS
  1. Q 0