Routine: RORX005A

RORX005A ;HOIFO/BH,SG - INPATIENT UTILIZATION (QUERY) ;4/21/09 2:20pm

 ;;1.5;CLINICAL CASE REGISTRIES;**1,8,10,13,19,21,31,39**;Feb 17, 2006;Build 4

 ; This routine uses the following IAs:

 ; #92           ^DGPT(  #45.7 (controlled)

 ; #417          .01 field and "C" x-ref of file #40.8 (controlled)

 ; #2056         $$GET1^DIQ (supported)

 ; #3545         ^DGPT("AAD" (private)

 ; #10061        IN5^VADPT (supported)

 ; #10103        FMADD^XLFDT, FMDIFF^XLFDT (supported)

 ;******************************************************************************

 ;******************************************************************************

 ;                 --- ROUTINE MODIFICATION LOG ---

 ;PKG/PATCH    DATE        DEVELOPER    MODIFICATION

 ;-----------  ----------  -----------  ----------------------------------------

 ;ROR*1.5*8    MAR  2010   V CARR       Modified to handle ICD9 filter for

 ;                                      'include' or 'exclude'.

 ;ROR*1.5*13   DEC  2010   A SAUNDERS   User can select specific patients.

 ;ROR*1.5*19   FEB  2012   K GUPTA      Support for ICD-10 Coding System

 ;ROR*1.5*31   MAY 2017    M FERRARESE  Adding PACT,PCP, and AGE/DOB as additional

 ;                                      identifiers.

 ;ROR*1.5*39   JUL 2021    M FERRARESE  Setting SSN and LAST4 to zeros

 ;******************************************************************************

 ;******************************************************************************

 ;***** ADDS THE INPATIENT STAY

 ; DFN           Patient IEN (in file #2)

 ; PTFIEN        IEN of the PTF record

 ; LOS           Length of stay

 ; BSID          Bed section ID

 ; DATE          Movement date/time (FileMan)

ADDSTAY(DFN,PTFIEN,LOS,BSID,DATE) ;

 N DST,I,TMP

 S:$G(BSID)="" BSID=0

 ;--- Number of patients for the bedsection

 I 'BSID  S DST=$NA(@RORDST@("IP",DFN))

 E  S DST=$NA(@RORDST@("IPB",BSID))  D:'$D(@DST@("P",DFN))

 . S @DST@("P")=$G(@DST@("P"))+1,@DST@("P",DFN)=""

 ;--- No bed section ID

 S:BSID<0 @RORDST@("IPNOBS",RORPNAME,DATE,PTFIEN,DFN)=""

 ;--- Short stays (visits)

 I LOS'>0  S @DST@("V")=$G(@DST@("V"))+1  Q

 ;--- Days and stays

 S @DST@("D")=$G(@DST@("D"))+LOS

 S @DST@("S")=$G(@DST@("S"))+1

 ;--- Lengths of stay for median value calculations

 S I=$O(@RORDST@("IPMLOS",BSID,LOS,""),-1)+1

 S @RORDST@("IPMLOS",BSID,LOS,I)=""

 ;***** LOADS AND PROCESSES THE INPATIENT DATA

 ; DFN           Patient IEN (in file #2)

 ; Return Values:

 ;       <0  Error code

 ;        0  Ok

 ;       >0  Number of non-fatal errors

IPDATA(DFN) ;

 N RORDST        ; Closed reference to the category node in ^TMP

 N BSID,DATE,DISDT,ENDT,FACILITY,LOS,PTFIEN,RC,RORMSG,STDT,SUFFIX,TMP,VAHOW,VAIP,VAROOT,XDATE

 S RORDST=$NA(^TMP("RORX005",$J))

 ;---

 S XDATE=RORSDT

 F  S RC=0  D  Q:RC<2  S XDATE=$O(^DGPT("AAD",DFN,XDATE))  Q:XDATE'>0

 . I XDATE'<ROREDT1  S RC=1  Q

 . K DATE,LOS,VAIP  S VAIP(16,1)=XDATE

 . F  D  Q:RC

 . . S VAIP("D")=+$G(VAIP(16,1))

 . . I VAIP("D")'>0  S RC=2  Q

 . . D IN5^VADPT

 . . I $G(VAIP(1))'>0  S RC=2  Q

 . . S DATE=+VAIP(3)

 . . Q:+$G(VAIP(4))=3

 . . ;--- Check the movement date

 . . I DATE'<ROREDT1  S RC=1  Q

 . . S:DATE<RORSDT DATE=RORSDT

 . . ;--- Check the PTF record - Task removed April 2009

 . . S PTFIEN=+$G(VAIP(12))  Q:PTFIEN'>0

 . . I '$D(PTFIEN(PTFIEN))  D  Q:RC

 . . . S PTFIEN(PTFIEN)=0

 . . . Q:$$PTF^RORXU001(PTFIEN,"FP",,,.SUFFIX,,.FACILITY)

 . . . ;--- Check the suffix

 . . . ;I SUFFIX'=""  Q:$$VSUFFIX(SUFFIX)  ; ROR 1.5

 . . . ;--- Check the division

 . . . S TMP=$$PARAM^RORTSK01("DIVISIONS","ALL")

 . . . I 'TMP  D  Q:'$D(RORTSK("PARAMS","DIVISIONS","C",DIVIEN))

 . . . . S TMP=FACILITY_SUFFIX

 . . . . S DIVIEN=$S(TMP'="":+$O(^DG(40.8,"C",TMP,"")),1:0)

 . . . K DIVIEN ;kill statement added

 . . . S PTFIEN(PTFIEN)=1

 . . ;--- Skip the PTF record if necessary

 . . Q:'PTFIEN(PTFIEN)

 . . ;--- Process the admission (only once)

 . . I '$D(LOS)  D  Q:RC

 . . . S LOS=$$LOS(+$G(VAIP(13,1)),+$G(VAIP(17,1)))

 . . . D ADDSTAY(DFN,PTFIEN,LOS)

 . . ;--- Process the movement

 . . S ENDT=$G(VAIP(16,1))\1

 . . S:(ENDT'>0)!(ENDT'<ROREDT1) ENDT=ROREDT,RC=2

 . . Q:ENDT<RORSDT

 . . S LOS=$$FMDIFF^XLFDT(ENDT,DATE\1,1)  S:LOS'>0 LOS=0

 . . ;--- Use the IEN in the SPECIALTY file (#42.4) as the Bedsection

 . . ;    ID if it is available (it should be). Otherwise, use the

 . . ;--- IEN in the FACILITY TREATING SPECIALTY file (#45.7).

 . . I $G(VAIP(8))>0  D

 . . . K RORMSG S TMP=$$GET1^DIQ(45.7,+VAIP(8),1,"I",,"RORMSG")

 . . . ;D:$G(DIERR) DBS^RORERR("RORMSG",-9,,DFN,45.7,+VAIP(8))

 . . . D:$G(RORMSG("DIERR")) DBS^RORERR("RORMSG",-9,,DFN,45.7,+VAIP(8))

 . . . S BSID=$S(TMP>0:TMP_";42.4",1:+VAIP(8)_";45.7")

 . . E  S BSID=-1

 . . D ADDSTAY(DFN,PTFIEN,LOS,BSID,+VAIP(3))

 . S:$G(DATE)>XDATE XDATE=DATE

 ;---

 Q $S(RC<0:RC,1:0)

 ;***** CALCULATES THE LENGTH OF STAY

LOS(STDT,ENDT) ;

 N DAYS

 S:STDT<RORSDT STDT=RORSDT

 S:(ENDT'>0)!(ENDT>ROREDT) ENDT=ROREDT

 S DAYS=$$FMDIFF^XLFDT(ENDT\1,STDT\1,1)

 Q $S(DAYS'<0:DAYS,1:0)

 ;***** QUERIES THE REGISTRY

 ; FLAGS         Flags for the $$SKIP^RORXU005

 ; Return Values:

 ;       <0  Error code

 ;        0  Ok

 ;       >0  Number of non-fatal errors

QUERY(FLAGS) ;

 N ROREDT1       ; Day after the end date

 N RORLAST4      ; Last 4 digits of the current patient's SSN

 N RORPNAME      ; Name of the current patient

 N RORICN        ; National ICN

 N RORPACT       ; Patient Care team

 N RORPCP        ; Primary care physician

 N RORPTN        ; Number of patients in the registry

 N AGE,AGETYPE

 N CNT,ECNT,IEN,IENS,PATIEN,RC,TMP,VA,VADM,XREFNODE

 N RCC,FLAG

 S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))

 S RORPTN=$$REGSIZE^RORUTL02(+RORREG)  S:RORPTN<0 RORPTN=0

 S ROREDT1=$$FMADD^XLFDT(ROREDT,1)

 S (CNT,ECNT,RC)=0

 ;--- Browse through the registry records

 S IEN=0

 S FLAG=$G(RORTSK("PARAMS","ICDFILT","A","FILTER"))

 F  S IEN=$O(@XREFNODE@(IEN))  Q:IEN'>0  D  Q:RC<0

 . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")

 . S RC=$$LOOP^RORTSK01(TMP)  Q:RC<0

 . S IENS=IEN_",",CNT=CNT+1

 . ;--- Get the patient DFN

 . S PATIEN=$$PTIEN^RORUTL01(IEN)  Q:PATIEN'>0

 . ;check for patient list and quit if not on list

 . I $D(RORTSK("PARAMS","PATIENTS","C")),'$D(RORTSK("PARAMS","PATIENTS","C",PATIEN)) Q

 . ;--- Check if the patient should be skipped

 . Q:$$SKIP^RORXU005(IEN,FLAGS,RORSDT,ROREDT)

 . ;--- Filter patient on ICD codes

 . S RCC=0

 . I FLAG'="ALL" D

 . . S RCC=$$ICD^RORXU010(PATIEN)

 . I (FLAG="INCLUDE")&(RCC=0) Q

 . I (FLAG="EXCLUDE")&(RCC=1) Q

 . ;--- End of filter

. ;

 . ;--- Get the patient's data

 . D VADEM^RORUTL05(PATIEN,1)

 . S RORPNAME=VADM(1),RORLAST4="0000"

 . S RORICN=$S($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PATIEN),1:"")

 . S RORPACT=$S($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PATIEN),1:"")

 . S RORPCP=$S($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PATIEN),1:"")

 . S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") D

 . . S AGE=$S(AGETYPE="AGE":$P(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($P(VADM(3),U)\1),1:"")

. ;

 . ;--- Get the inpatient data

 . S RC=$$IPDATA(PATIEN)

 . I RC  S ECNT=ECNT+1  Q:RC<0

. ;

 . ;--- Calculate intermediate totals

 . S RC=$$TOTALS^RORX005B(PATIEN)

 . I RC  S ECNT=ECNT+1  Q:RC<0

 ;---

 Q $S(RC<0:RC,1:ECNT)

 ;***** CHECKS THE SUFFIX FOR VALIDITY

 ; SUFFIX        Suffix

 ; Return Values:

 ;        0  Ok

 ;        1  Invalid suffix

VSUFFIX(SUFFIX) ;

 Q '("9AA,9AB,9AC,9AD,9AE,9BB,A0,A4,A5,BU,BV,PA"[SUFFIX)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX005A   7677     printed  Feb 18, 2025@23:10:44                                                                                                                                                                                                    Page 2

RORX005A  ;HOIFO/BH,SG - INPATIENT UTILIZATION (QUERY) ;4/21/09 2:20pm

 +1       ;;1.5;CLINICAL CASE REGISTRIES;**1,8,10,13,19,21,31,39**;Feb 17, 2006;Build 4

 +2       ;

 +3       ; This routine uses the following IAs:

 +4       ;

 +5       ; #92           ^DGPT(  #45.7 (controlled)

 +6       ; #417          .01 field and "C" x-ref of file #40.8 (controlled)

 +7       ; #2056         $$GET1^DIQ (supported)

 +8       ; #3545         ^DGPT("AAD" (private)

 +9       ; #10061        IN5^VADPT (supported)

 +10      ; #10103        FMADD^XLFDT, FMDIFF^XLFDT (supported)

 +11      ;

 +12      ;******************************************************************************

 +13      ;******************************************************************************

 +14      ;                 --- ROUTINE MODIFICATION LOG ---

 +15      ;

 +16      ;PKG/PATCH    DATE        DEVELOPER    MODIFICATION

 +17      ;-----------  ----------  -----------  ----------------------------------------

 +18      ;ROR*1.5*8    MAR  2010   V CARR       Modified to handle ICD9 filter for

 +19      ;                                      'include' or 'exclude'.

 +20      ;ROR*1.5*13   DEC  2010   A SAUNDERS   User can select specific patients.

 +21      ;ROR*1.5*19   FEB  2012   K GUPTA      Support for ICD-10 Coding System

 +22      ;ROR*1.5*31   MAY 2017    M FERRARESE  Adding PACT,PCP, and AGE/DOB as additional

 +23      ;                                      identifiers.

 +24      ;ROR*1.5*39   JUL 2021    M FERRARESE  Setting SSN and LAST4 to zeros

 +25      ;******************************************************************************

 +26      ;******************************************************************************

 +27       QUIT

 +28      ;

 +29      ;***** ADDS THE INPATIENT STAY

 +30      ;

 +31      ; DFN           Patient IEN (in file #2)

 +32      ; PTFIEN        IEN of the PTF record

 +33      ; LOS           Length of stay

 +34      ; BSID          Bed section ID

 +35      ; DATE          Movement date/time (FileMan)

 +36      ;

ADDSTAY(DFN,PTFIEN,LOS,BSID,DATE) ;

 +1        NEW DST,I,TMP

 +2        if $GET(BSID)=""

               SET BSID=0

 +3       ;--- Number of patients for the bedsection

 +4        IF 'BSID

               SET DST=$NAME(@RORDST@("IP",DFN))

 +5       IF '$TEST

               SET DST=$NAME(@RORDST@("IPB",BSID))

               if '$DATA(@DST@("P",DFN))

                   Begin DoDot:1

 +6                    SET @DST@("P")=$GET(@DST@("P"))+1

                       SET @DST@("P",DFN)=""

                   End DoDot:1

 +7       ;--- No bed section ID

 +8        if BSID<0

               SET @RORDST@("IPNOBS",RORPNAME,DATE,PTFIEN,DFN)=""

 +9       ;--- Short stays (visits)

 +10       IF LOS'>0

               SET @DST@("V")=$GET(@DST@("V"))+1

               QUIT

 +11      ;--- Days and stays

 +12       SET @DST@("D")=$GET(@DST@("D"))+LOS

 +13       SET @DST@("S")=$GET(@DST@("S"))+1

 +14      ;--- Lengths of stay for median value calculations

 +15       SET I=$ORDER(@RORDST@("IPMLOS",BSID,LOS,""),-1)+1

 +16       SET @RORDST@("IPMLOS",BSID,LOS,I)=""

 +17       QUIT

 +18      ;

 +19      ;***** LOADS AND PROCESSES THE INPATIENT DATA

 +20      ;

 +21      ; DFN           Patient IEN (in file #2)

 +22      ;

 +23      ; Return Values:

 +24      ;       <0  Error code

 +25      ;        0  Ok

 +26      ;       >0  Number of non-fatal errors

 +27      ;

IPDATA(DFN) ;

 +1       ; Closed reference to the category node in ^TMP

           NEW RORDST

 +2       ;

 +3        NEW BSID,DATE,DISDT,ENDT,FACILITY,LOS,PTFIEN,RC,RORMSG,STDT,SUFFIX,TMP,VAHOW,VAIP,VAROOT,XDATE

 +4        SET RORDST=$NAME(^TMP("RORX005",$JOB))

 +5       ;---

 +6        SET XDATE=RORSDT

 +7        FOR

               SET RC=0

               Begin DoDot:1

 +8                IF XDATE'<ROREDT1

                       SET RC=1

                       QUIT

 +9                KILL DATE,LOS,VAIP

                   SET VAIP(16,1)=XDATE

 +10               FOR

                       Begin DoDot:2

 +11                       SET VAIP("D")=+$GET(VAIP(16,1))

 +12                       IF VAIP("D")'>0

                               SET RC=2

                               QUIT

 +13                       DO IN5^VADPT

 +14                       IF $GET(VAIP(1))'>0

                               SET RC=2

                               QUIT

 +15                       SET DATE=+VAIP(3)

 +16                       if +$GET(VAIP(4))=3

                               QUIT

 +17      ;--- Check the movement date

 +18                       IF DATE'<ROREDT1

                               SET RC=1

                               QUIT

 +19                       if DATE<RORSDT

                               SET DATE=RORSDT

 +20      ;--- Check the PTF record - Task removed April 2009

 +21                       SET PTFIEN=+$GET(VAIP(12))

                           if PTFIEN'>0

                               QUIT

 +22                       IF '$DATA(PTFIEN(PTFIEN))

                               Begin DoDot:3

 +23                               SET PTFIEN(PTFIEN)=0

 +24                               if $$PTF^RORXU001(PTFIEN,"FP",,,.SUFFIX,,.FACILITY)

                                       QUIT

 +25      ;--- Check the suffix

 +26      ;I SUFFIX'=""  Q:$$VSUFFIX(SUFFIX)  ; ROR 1.5

 +27      ;--- Check the division

 +28                               SET TMP=$$PARAM^RORTSK01("DIVISIONS","ALL")

 +29                               IF 'TMP

                                       Begin DoDot:4

 +30                                       SET TMP=FACILITY_SUFFIX

 +31                                       SET DIVIEN=$SELECT(TMP'="":+$ORDER(^DG(40.8,"C",TMP,"")),1:0)

                                       End DoDot:4

                                       if '$DATA(RORTSK("PARAMS","DIVISIONS","C",DIVIEN))

                                           QUIT

 +32      ;kill statement added

                                   KILL DIVIEN

 +33                               SET PTFIEN(PTFIEN)=1

                               End DoDot:3

                               if RC

                                   QUIT

 +34      ;--- Skip the PTF record if necessary

 +35                       if 'PTFIEN(PTFIEN)

                               QUIT

 +36      ;--- Process the admission (only once)

 +37                       IF '$DATA(LOS)

                               Begin DoDot:3

 +38                               SET LOS=$$LOS(+$GET(VAIP(13,1)),+$GET(VAIP(17,1)))

 +39                               DO ADDSTAY(DFN,PTFIEN,LOS)

                               End DoDot:3

                               if RC

                                   QUIT

 +40      ;--- Process the movement

 +41                       SET ENDT=$GET(VAIP(16,1))\1

 +42                       if (ENDT'>0)!(ENDT'<ROREDT1)

                               SET ENDT=ROREDT

                               SET RC=2

 +43                       if ENDT<RORSDT

                               QUIT

 +44                       SET LOS=$$FMDIFF^XLFDT(ENDT,DATE\1,1)

                           if LOS'>0

                               SET LOS=0

 +45      ;--- Use the IEN in the SPECIALTY file (#42.4) as the Bedsection

 +46      ;    ID if it is available (it should be). Otherwise, use the

 +47      ;--- IEN in the FACILITY TREATING SPECIALTY file (#45.7).

 +48                       IF $GET(VAIP(8))>0

                               Begin DoDot:3

 +49                               KILL RORMSG

                                   SET TMP=$$GET1^DIQ(45.7,+VAIP(8),1,"I",,"RORMSG")

 +50      ;D:$G(DIERR) DBS^RORERR("RORMSG",-9,,DFN,45.7,+VAIP(8))

 +51                               if $GET(RORMSG("DIERR"))

                                       DO DBS^RORERR("RORMSG",-9,,DFN,45.7,+VAIP(8))

 +52                               SET BSID=$SELECT(TMP>0:TMP_";42.4",1:+VAIP(8)_";45.7")

                               End DoDot:3

 +53                      IF '$TEST

                               SET BSID=-1

 +54                       DO ADDSTAY(DFN,PTFIEN,LOS,BSID,+VAIP(3))

                       End DoDot:2

                       if RC

                           QUIT

 +55               if $GET(DATE)>XDATE

                       SET XDATE=DATE

               End DoDot:1

               if RC<2

                   QUIT

               SET XDATE=$ORDER(^DGPT("AAD",DFN,XDATE))

               if XDATE'>0

                   QUIT

 +56      ;---

 +57       QUIT $SELECT(RC<0:RC,1:0)

 +58      ;

 +59      ;***** CALCULATES THE LENGTH OF STAY

LOS(STDT,ENDT) ;

 +1        NEW DAYS

 +2        if STDT<RORSDT

               SET STDT=RORSDT

 +3        if (ENDT'>0)!(ENDT>ROREDT)

               SET ENDT=ROREDT

 +4        SET DAYS=$$FMDIFF^XLFDT(ENDT\1,STDT\1,1)

 +5        QUIT $SELECT(DAYS'<0:DAYS,1:0)

 +6       ;

 +7       ;***** QUERIES THE REGISTRY

 +8       ;

 +9       ; FLAGS         Flags for the $$SKIP^RORXU005

 +10      ;

 +11      ; Return Values:

 +12      ;       <0  Error code

 +13      ;        0  Ok

 +14      ;       >0  Number of non-fatal errors

 +15      ;

QUERY(FLAGS) ;

 +1       ; Day after the end date

           NEW ROREDT1

 +2       ; Last 4 digits of the current patient's SSN

           NEW RORLAST4

 +3       ; Name of the current patient

           NEW RORPNAME

 +4       ; National ICN

           NEW RORICN

 +5       ; Patient Care team

           NEW RORPACT

 +6       ; Primary care physician

           NEW RORPCP

 +7       ; Number of patients in the registry

           NEW RORPTN

 +8        NEW AGE,AGETYPE

 +9       ;

 +10       NEW CNT,ECNT,IEN,IENS,PATIEN,RC,TMP,VA,VADM,XREFNODE

 +11       NEW RCC,FLAG

 +12       SET XREFNODE=$NAME(^RORDATA(798,"AC",+RORREG))

 +13       SET RORPTN=$$REGSIZE^RORUTL02(+RORREG)

           if RORPTN<0

               SET RORPTN=0

 +14       SET ROREDT1=$$FMADD^XLFDT(ROREDT,1)

 +15       SET (CNT,ECNT,RC)=0

 +16      ;--- Browse through the registry records

 +17       SET IEN=0

 +18       SET FLAG=$GET(RORTSK("PARAMS","ICDFILT","A","FILTER"))

 +19       FOR

               SET IEN=$ORDER(@XREFNODE@(IEN))

               if IEN'>0

                   QUIT

               Begin DoDot:1

 +20               SET TMP=$SELECT(RORPTN>0:CNT/RORPTN,1:"")

 +21               SET RC=$$LOOP^RORTSK01(TMP)

                   if RC<0

                       QUIT

 +22               SET IENS=IEN_","

                   SET CNT=CNT+1

 +23      ;--- Get the patient DFN

 +24               SET PATIEN=$$PTIEN^RORUTL01(IEN)

                   if PATIEN'>0

                       QUIT

 +25      ;check for patient list and quit if not on list

 +26               IF $DATA(RORTSK("PARAMS","PATIENTS","C"))

                       IF '$DATA(RORTSK("PARAMS","PATIENTS","C",PATIEN))

                           QUIT

 +27      ;--- Check if the patient should be skipped

 +28               if $$SKIP^RORXU005(IEN,FLAGS,RORSDT,ROREDT)

                       QUIT

 +29      ;--- Filter patient on ICD codes

 +30               SET RCC=0

 +31               IF FLAG'="ALL"

                       Begin DoDot:2

 +32                       SET RCC=$$ICD^RORXU010(PATIEN)

                       End DoDot:2

 +33               IF (FLAG="INCLUDE")&(RCC=0)

                       QUIT

 +34               IF (FLAG="EXCLUDE")&(RCC=1)

                       QUIT

 +35      ;--- End of filter

 +36      ;

 +37      ;--- Get the patient's data

 +38               DO VADEM^RORUTL05(PATIEN,1)

 +39               SET RORPNAME=VADM(1)

                   SET RORLAST4="0000"

 +40               SET RORICN=$SELECT($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PATIEN),1:"")

 +41               SET RORPACT=$SELECT($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PATIEN),1:"")

 +42               SET RORPCP=$SELECT($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PATIEN),1:"")

 +43               SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")

                   Begin DoDot:2

 +44                   SET AGE=$SELECT(AGETYPE="AGE":$PIECE(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($PIECE(VADM(3),U)\1),1:"")

                   End DoDot:2

 +45      ;

 +46      ;--- Get the inpatient data

 +47               SET RC=$$IPDATA(PATIEN)

 +48               IF RC

                       SET ECNT=ECNT+1

                       if RC<0

                           QUIT

 +49      ;

 +50      ;--- Calculate intermediate totals

 +51               SET RC=$$TOTALS^RORX005B(PATIEN)

 +52               IF RC

                       SET ECNT=ECNT+1

                       if RC<0

                           QUIT

               End DoDot:1

               if RC<0

                   QUIT

 +53      ;---

 +54       QUIT $SELECT(RC<0:RC,1:ECNT)

 +55      ;

 +56      ;***** CHECKS THE SUFFIX FOR VALIDITY

 +57      ;

 +58      ; SUFFIX        Suffix

 +59      ;

 +60      ; Return Values:

 +61      ;        0  Ok

 +62      ;        1  Invalid suffix

VSUFFIX(SUFFIX) ;

 +1        QUIT '("9AA,9AB,9AC,9AD,9AE,9BB,A0,A4,A5,BU,BV,PA"[SUFFIX)

RORX005A.m