RORX005B ;HCIOFO/BH,SG - INPATIENT UTILIZATION (SORT) ; 04 Apr 2016  12:48 PM
 ;;1.5;CLINICAL CASE REGISTRIES;**28,31**;Feb 17, 2006;Build 62
 ;
 ; This routine uses the following IAs:
 ;
 ; #2056 GET1^DIQ
 ;
 ;**********************************************************************
 ;                       --- ROUTINE MODIFICATION LOG ---
 ;        
 ;PKG/PATCH    DATE        DEVELOPER    MODIFICATION
 ;-----------  ----------  -----------  --------------------------------
 ;ROR*1.5*28   APR 2016    T KOPP       Add ICN data if additional
 ;                                       identifier requested.
 ;ROR*1.5*31   MAY 2017    M FERRARESE  Adding PACT, PCP, and AGE/DOB as additional
 ;                                       identifiers.
 ;**********************************************************************
 ;
 Q
 ;
 ;***** CALCULATES MEDIAN LENGTHS OF STAY
 ;
 ; NODE          Closed root of the category section
 ;               in the temporary global
 ;
 ; FSUM          Update the summary data (0/1)
 ;
MLOS(NODE) ;
 N BSID,TMP,XREFNODE
 ;--- Median length of the whole stays
 S XREFNODE=$NA(@NODE@("IPMLOS",0))
 S TMP=$$XREFMDNV^RORXU004(XREFNODE,+$G(@NODE@("IPS")))
 S (@NODE@("IPMLOS"),@NODE@("IPMLOS",0))=TMP
 ;--- Median lengths of the bed section stays
 S BSID=""
 F  S BSID=$O(@NODE@("IPMLOS",BSID))  Q:BSID=""  D:BSID
 . S XREFNODE=$NA(@NODE@("IPMLOS",BSID))
 . S TMP=+$G(@NODE@("IPB",BSID,"S"))
 . S @NODE@("IPMLOS",BSID)=$$XREFMDNV^RORXU004(XREFNODE,TMP)
 Q
 ;
 ;***** SORTS THE RESULTS AND COMPILES THE TOTALS
 ;
 ; Return Values:
 ;       <0  Error code
 ;        0  Ok
 ;
SORT() ;
 N BSID,DIERR,FILE,IENS,NAME,NODE,RC,RORMSG,TMP
 S NODE=$NA(^TMP("RORX005",$J))  Q:$D(@NODE)<10 0
 ;--- Bed sections
 S RC=$$LOOP^RORTSK01(0)  Q:RC<0 RC
 S BSID=""
 F  S BSID=$O(@NODE@("IPB",BSID))  Q:'BSID  D
 . D:BSID>0
 . . S IENS=(+BSID)_",",FILE=+$P(BSID,";",2)
 . . S NAME=$$GET1^DIQ(FILE,IENS,.01,,,"RORMSG")
 . . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,FILE,IENS)
 . . S:NAME?." " NAME="Unknown ("_BSID_")"
 . . S @NODE@("IPB","B",NAME,BSID)=""
 ;--- Median length of stay
 S RC=$$LOOP^RORTSK01(0.5)  Q:RC<0 RC
 D MLOS(NODE)
 ;---
 Q 0
 ;
 ;***** CALCULATES THE INTERMEDIATE TOTALS
 ;
 ; PATIEN        Patient IEN (DFN)
 ;
 ; Return Values:
 ;       <0  Error code
 ;        0  Ok
 ;
TOTALS(PATIEN) ;
 N NODE,TMP
 S NODE=$NA(^TMP("RORX005",$J))
 ;
 ;=== Inpatient data
 D:$D(@NODE@("IP",PATIEN))>1
 . N DAYS,STAYS,VISITS
 . S RORICN=$S($$PARAM^RORTSK01("PATIENTS","ICN"):$G(RORICN),1:"")
 . S RORPACT=$S($$PARAM^RORTSK01("PATIENTS","PACT"):$G(RORPACT),1:"")
 . S @NODE@("IP",PATIEN)=RORLAST4_U_RORICN_U_RORPACT_U_$S($$PARAM^RORTSK01("PATIENTS","PCP"):$G(RORPCP),1:"")_U_AGE
 . S @NODE@("IP")=$G(@NODE@("IP"))+1
 . S STAYS=+$G(@NODE@("IP",PATIEN,"S"))
 . S DAYS=+$G(@NODE@("IP",PATIEN,"D"))
 . S VISITS=+$G(@NODE@("IP",PATIEN,"V"))
 . ;--- Number of stays
 . D:(STAYS>0)!(VISITS>0)
 . . S @NODE@("IPS")=$G(@NODE@("IPS"))+STAYS
 . . S @NODE@("IPS",STAYS)=$G(@NODE@("IPS",STAYS))+1
 . . S @NODE@("IPS",STAYS,RORPNAME,PATIEN)=""
 . ;--- Number of days
 . D:(DAYS>0)!(VISITS>0)
 . . S @NODE@("IPD")=$G(@NODE@("IPD"))+DAYS
 . . S @NODE@("IPD",DAYS)=$G(@NODE@("IPD",DAYS))+1
 . . S @NODE@("IPD",DAYS,RORPNAME,PATIEN)=""
 . ;--- Number of short stays (visits)
 . D:VISITS>0
 . . S @NODE@("IPV")=$G(@NODE@("IPV"))+VISITS
 Q 0
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX005B   3434     printed  Sep 23, 2025@19:20:22                                                                                                                                                                                                    Page 2
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
 +2       ;
 +3       ; This routine uses the following IAs:
 +4       ;
 +5       ; #2056 GET1^DIQ
 +6       ;
 +7       ;**********************************************************************
 +8       ;                       --- ROUTINE MODIFICATION LOG ---
 +9       ;        
 +10      ;PKG/PATCH    DATE        DEVELOPER    MODIFICATION
 +11      ;-----------  ----------  -----------  --------------------------------
 +12      ;ROR*1.5*28   APR 2016    T KOPP       Add ICN data if additional
 +13      ;                                       identifier requested.
 +14      ;ROR*1.5*31   MAY 2017    M FERRARESE  Adding PACT, PCP, and AGE/DOB as additional
 +15      ;                                       identifiers.
 +16      ;**********************************************************************
 +17      ;
 +18       QUIT 
 +19      ;
 +20      ;***** CALCULATES MEDIAN LENGTHS OF STAY
 +21      ;
 +22      ; NODE          Closed root of the category section
 +23      ;               in the temporary global
 +24      ;
 +25      ; FSUM          Update the summary data (0/1)
 +26      ;
MLOS(NODE) ;
 +1        NEW BSID,TMP,XREFNODE
 +2       ;--- Median length of the whole stays
 +3        SET XREFNODE=$NAME(@NODE@("IPMLOS",0))
 +4        SET TMP=$$XREFMDNV^RORXU004(XREFNODE,+$GET(@NODE@("IPS")))
 +5        SET (@NODE@("IPMLOS"),@NODE@("IPMLOS",0))=TMP
 +6       ;--- Median lengths of the bed section stays
 +7        SET BSID=""
 +8        FOR 
               SET BSID=$ORDER(@NODE@("IPMLOS",BSID))
               if BSID=""
                   QUIT 
               if BSID
                   Begin DoDot:1
 +9                    SET XREFNODE=$NAME(@NODE@("IPMLOS",BSID))
 +10                   SET TMP=+$GET(@NODE@("IPB",BSID,"S"))
 +11                   SET @NODE@("IPMLOS",BSID)=$$XREFMDNV^RORXU004(XREFNODE,TMP)
                   End DoDot:1
 +12       QUIT 
 +13      ;
 +14      ;***** SORTS THE RESULTS AND COMPILES THE TOTALS
 +15      ;
 +16      ; Return Values:
 +17      ;       <0  Error code
 +18      ;        0  Ok
 +19      ;
SORT()    ;
 +1        NEW BSID,DIERR,FILE,IENS,NAME,NODE,RC,RORMSG,TMP
 +2        SET NODE=$NAME(^TMP("RORX005",$JOB))
           if $DATA(@NODE)<10
               QUIT 0
 +3       ;--- Bed sections
 +4        SET RC=$$LOOP^RORTSK01(0)
           if RC<0
               QUIT RC
 +5        SET BSID=""
 +6        FOR 
               SET BSID=$ORDER(@NODE@("IPB",BSID))
               if 'BSID
                   QUIT 
               Begin DoDot:1
 +7                if BSID>0
                       Begin DoDot:2
 +8                        SET IENS=(+BSID)_","
                           SET FILE=+$PIECE(BSID,";",2)
 +9                        SET NAME=$$GET1^DIQ(FILE,IENS,.01,,,"RORMSG")
 +10                       if $GET(DIERR)
                               DO DBS^RORERR("RORMSG",-9,,,FILE,IENS)
 +11                       if NAME?." "
                               SET NAME="Unknown ("_BSID_")"
 +12                       SET @NODE@("IPB","B",NAME,BSID)=""
                       End DoDot:2
               End DoDot:1
 +13      ;--- Median length of stay
 +14       SET RC=$$LOOP^RORTSK01(0.5)
           if RC<0
               QUIT RC
 +15       DO MLOS(NODE)
 +16      ;---
 +17       QUIT 0
 +18      ;
 +19      ;***** CALCULATES THE INTERMEDIATE TOTALS
 +20      ;
 +21      ; PATIEN        Patient IEN (DFN)
 +22      ;
 +23      ; Return Values:
 +24      ;       <0  Error code
 +25      ;        0  Ok
 +26      ;
TOTALS(PATIEN) ;
 +1        NEW NODE,TMP
 +2        SET NODE=$NAME(^TMP("RORX005",$JOB))
 +3       ;
 +4       ;=== Inpatient data
 +5        if $DATA(@NODE@("IP",PATIEN))>1
               Begin DoDot:1
 +6                NEW DAYS,STAYS,VISITS
 +7                SET RORICN=$SELECT($$PARAM^RORTSK01("PATIENTS","ICN"):$GET(RORICN),1:"")
 +8                SET RORPACT=$SELECT($$PARAM^RORTSK01("PATIENTS","PACT"):$GET(RORPACT),1:"")
 +9                SET @NODE@("IP",PATIEN)=RORLAST4_U_RORICN_U_RORPACT_U_$SELECT($$PARAM^RORTSK01("PATIENTS","PCP"):$GET(RORPCP),1:"")_U_AGE
 +10               SET @NODE@("IP")=$GET(@NODE@("IP"))+1
 +11               SET STAYS=+$GET(@NODE@("IP",PATIEN,"S"))
 +12               SET DAYS=+$GET(@NODE@("IP",PATIEN,"D"))
 +13               SET VISITS=+$GET(@NODE@("IP",PATIEN,"V"))
 +14      ;--- Number of stays
 +15               if (STAYS>0)!(VISITS>0)
                       Begin DoDot:2
 +16                       SET @NODE@("IPS")=$GET(@NODE@("IPS"))+STAYS
 +17                       SET @NODE@("IPS",STAYS)=$GET(@NODE@("IPS",STAYS))+1
 +18                       SET @NODE@("IPS",STAYS,RORPNAME,PATIEN)=""
                       End DoDot:2
 +19      ;--- Number of days
 +20               if (DAYS>0)!(VISITS>0)
                       Begin DoDot:2
 +21                       SET @NODE@("IPD")=$GET(@NODE@("IPD"))+DAYS
 +22                       SET @NODE@("IPD",DAYS)=$GET(@NODE@("IPD",DAYS))+1
 +23                       SET @NODE@("IPD",DAYS,RORPNAME,PATIEN)=""
                       End DoDot:2
 +24      ;--- Number of short stays (visits)
 +25               if VISITS>0
                       Begin DoDot:2
 +26                       SET @NODE@("IPV")=$GET(@NODE@("IPV"))+VISITS
                       End DoDot:2
               End DoDot:1
 +27       QUIT 0