- RORX005C ;HCIOFO/BH,SG - INPATIENT UTILIZATION (STORE) ;9/14/05 9:17am
- ;;1.5;CLINICAL CASE REGISTRIES;**21,31,39**;Feb 17, 2006;Build 4
- ;
- ;**********************************************************************
- ; --- ROUTINE MODIFICATION LOG ---
- ;
- ;PKG/PATCH DATE DEVELOPER MODIFICATION
- ;----------- ---------- ----------- --------------------------------
- ;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
- ;**********************************************************************
- ;
- 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,IDNODE,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 IDNODE=$G(@RORNODE@("IP",DFN))
- . . . S TMP="0000" D ADDVAL^RORTSK11(RORTSK,"LAST4",TMP,ITEM,2)
- . . . S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") I AGETYPE'="ALL" D
- . . . . D ADDVAL^RORTSK11(RORTSK,AGETYPE,$P(IDNODE,U,5),ITEM,1)
- . . . 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)
- . . . I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",$P(IDNODE,U,2),ITEM,1)
- . . . I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",$P(IDNODE,U,3),ITEM,1)
- . . . I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",$P(IDNODE,U,4),ITEM,1)
- 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="0000" ;$P($G(@NODE@("IP",DFN)),U)
- . . . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",TMP,ITEM,2)
- . . . . . S TMP=$G(@NODE@("IP",DFN,"I"))
- . . . . . D ADDVAL^RORTSK11(RORTSK,"ICN",TMP,ITEM,1)
- . . . . . D ADDVAL^RORTSK11(RORTSK,"ICN",$P(TMP,U,2),ITEM,1)
- . . . . . D ADDVAL^RORTSK11(RORTSK,"PACT",$P(TMP,U,3),ITEM,1)
- . . . . . D ADDVAL^RORTSK11(RORTSK,"PCP",$P(TMP,U,4),ITEM,1)
- . . . . . S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") I AGETYPE'="ALL" D
- . . . . . . D ADDVAL^RORTSK11(RORTSK,AGETYPE,$P(TMP,U,5),ITEM,1)
- . . . . . 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX005C 7371 printed Mar 13, 2025@20:49:03 Page 2
- RORX005C ;HCIOFO/BH,SG - INPATIENT UTILIZATION (STORE) ;9/14/05 9:17am
- +1 ;;1.5;CLINICAL CASE REGISTRIES;**21,31,39**;Feb 17, 2006;Build 4
- +2 ;
- +3 ;**********************************************************************
- +4 ; --- ROUTINE MODIFICATION LOG ---
- +5 ;
- +6 ;PKG/PATCH DATE DEVELOPER MODIFICATION
- +7 ;----------- ---------- ----------- --------------------------------
- +8 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional
- +9 ; identifiers.
- +10 ;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
- +11 ;**********************************************************************
- +12 ;
- +13 QUIT
- +14 ;
- +15 ;***** HIGHEST UTILIZATION
- +16 ;
- +17 ; PRNTELMT IEN of the parent element
- +18 ;
- +19 ; RORNODE Closed root of the section in the temporary global
- +20 ;
- +21 ; Return Values:
- +22 ; <0 Error code
- +23 ; 0 Ok
- +24 ;
- HIGHUTIL(PRNTELMT,RORNODE) ;
- +1 NEW RC,RORMAXUT,RORTCNT,SECTION,TMP
- +2 SET RORMAXUT=$$PARAM^RORTSK01("MAXUTNUM")
- +3 if RORMAXUT'>0
- QUIT 0
- +4 SET SECTION=$$ADDVAL^RORTSK11(RORTSK,"HIGHUTIL",,PRNTELMT)
- +5 if SECTION<0
- QUIT SECTION
- +6 SET (RC,RORTCNT)=0
- +7 ;--- Stays
- +8 SET RC=$$HIGHUTSD(SECTION,"IPS","HU_STAYS")
- if RC<0
- QUIT RC
- +9 ;--- Days
- +10 SET RC=$$HIGHUTSD(SECTION,"IPD","HU_DAYS")
- if RC<0
- QUIT RC
- +11 ;--- Disable the empty section
- +12 if RORTCNT'>0
- DO UPDVAL^RORTSK11(RORTSK,SECTION,"",,1)
- +13 QUIT 0
- +14 ;
- +15 ;*****
- +16 ;
- +17 ; SECTION IEN of the parent element
- +18 ;
- +19 ; SUBS Utilization subscript in the temporary global
- +20 ;
- +21 ; TBLNAME Name of the table element
- +22 ;
- +23 ; Return Values:
- +24 ; <0 Error code
- +25 ; 0 Ok
- +26 ;
- HIGHUTSD(SECTION,SUBS,TBLNAME) ;
- +1 if $DATA(@RORNODE@(SUBS))<10
- QUIT 0
- +2 NEW COUNT,DFN,IDNODE,ITEM,NAME,NUM,RC,TABLE,TMP
- +3 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,TBLNAME,,SECTION)
- +4 if TABLE<0
- QUIT TABLE
- +5 DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE",TBLNAME)
- +6 SET RORTCNT=RORTCNT+1
- +7 ;---
- +8 SET NUM=""
- SET (COUNT,RC)=0
- +9 FOR
- SET NUM=$ORDER(@RORNODE@(SUBS,NUM),-1)
- if NUM=""
- QUIT
- Begin DoDot:1
- +10 SET NAME=""
- +11 FOR
- SET NAME=$ORDER(@RORNODE@(SUBS,NUM,NAME))
- if NAME=""
- QUIT
- Begin DoDot:2
- +12 SET DFN=""
- +13 FOR
- SET DFN=$ORDER(@RORNODE@(SUBS,NUM,NAME,DFN))
- if DFN=""
- QUIT
- Begin DoDot:3
- +14 SET COUNT=COUNT+1
- IF COUNT>RORMAXUT
- SET RC=1
- QUIT
- +15 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
- +16 DO ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
- +17 SET IDNODE=$GET(@RORNODE@("IP",DFN))
- +18 SET TMP="0000"
- DO ADDVAL^RORTSK11(RORTSK,"LAST4",TMP,ITEM,2)
- +19 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
- IF AGETYPE'="ALL"
- Begin DoDot:4
- +20 DO ADDVAL^RORTSK11(RORTSK,AGETYPE,$PIECE(IDNODE,U,5),ITEM,1)
- End DoDot:4
- +21 SET TMP=+$GET(@RORNODE@("IP",DFN,"S"))
- +22 DO ADDVAL^RORTSK11(RORTSK,"NST",TMP,ITEM,3)
- +23 SET TMP=+$GET(@RORNODE@("IP",DFN,"D"))
- +24 DO ADDVAL^RORTSK11(RORTSK,"ND",TMP,ITEM,3)
- +25 SET TMP=$GET(@RORNODE@("IP",DFN,"V"))
- +26 DO ADDVAL^RORTSK11(RORTSK,"NSS",TMP,ITEM,3)
- +27 IF $$PARAM^RORTSK01("PATIENTS","ICN")
- DO ADDVAL^RORTSK11(RORTSK,"ICN",$PIECE(IDNODE,U,2),ITEM,1)
- +28 IF $$PARAM^RORTSK01("PATIENTS","PACT")
- DO ADDVAL^RORTSK11(RORTSK,"PACT",$PIECE(IDNODE,U,3),ITEM,1)
- +29 IF $$PARAM^RORTSK01("PATIENTS","PCP")
- DO ADDVAL^RORTSK11(RORTSK,"PCP",$PIECE(IDNODE,U,4),ITEM,1)
- End DoDot:3
- if RC
- QUIT
- End DoDot:2
- if RC
- QUIT
- End DoDot:1
- if RC
- QUIT
- +30 QUIT 0
- +31 ;
- +32 ;***** STORES THE REPORT DATA
- +33 ;
- +34 ; REPORT IEN of the REPORT element
- +35 ;
- +36 ; Return Values:
- +37 ; <0 Error code
- +38 ; 0 Ok
- +39 ; >0 Number of non-fatal errors
- +40 ;
- STORE(REPORT) ;
- +1 ; Output summary only
- NEW RORSONLY
- +2 ;
- +3 NEW ECNT,NODE,RC,TMP
- +4 SET NODE=$NAME(^TMP("RORX005",$JOB))
- +5 if $DATA(@NODE)<10
- QUIT 0
- +6 SET RORSONLY=$$SMRYONLY^RORXU006()
- SET (ECNT,RC)=0
- +7 ;--- Inpatients
- +8 SET RC=$$LOOP^RORTSK01(0)
- if RC<0
- QUIT RC
- +9 SET RC=$$STOREIP(REPORT,NODE)
- +10 IF RC
- if RC<0
- QUIT RC
- SET ECNT=ECNT+1
- +11 ;--- Highest utilization
- +12 SET RC=$$LOOP^RORTSK01(0.5)
- if RC<0
- QUIT RC
- +13 SET RC=$$HIGHUTIL(REPORT,NODE)
- +14 IF RC
- if RC<0
- QUIT RC
- SET ECNT=ECNT+1
- +15 ;---
- +16 QUIT ECNT
- +17 ;
- +18 ;***** INPATIENT DATA
- +19 ;
- +20 ; PRNTELMT IEN of the parent element
- +21 ;
- +22 ; NODE Closed root of the category section
- +23 ; in the temporary global
- +24 ;
- +25 ; Return Values:
- +26 ; <0 Error code
- +27 ; 0 Ok
- +28 ;
- STOREIP(PRNTELMT,NODE) ;
- +1 if $DATA(@NODE@("IP"))<10
- QUIT 0
- +2 NEW BSID,DATE,ITEM,NAME,NS,PATIEN,PTF,RC,SECTION,TABLE,TMP
- +3 SET SECTION=$$ADDVAL^RORTSK11(RORTSK,"INPATIENTS",,PRNTELMT)
- +4 if SECTION<0
- QUIT SECTION
- +5 SET RC=0
- +6 ;--- Stays
- +7 IF $DATA(@NODE@("IPS"))>1
- Begin DoDot:1
- +8 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"STAYS",,SECTION)
- +9 IF TABLE<0
- SET RC=TABLE
- QUIT
- +10 DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","STAYS")
- +11 SET NS=""
- +12 FOR
- SET NS=$ORDER(@NODE@("IPS",NS))
- if NS=""
- QUIT
- Begin DoDot:2
- +13 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"ITEM",,TABLE)
- +14 DO ADDVAL^RORTSK11(RORTSK,"NP",$PIECE(@NODE@("IPS",NS),U),ITEM,3)
- +15 DO ADDVAL^RORTSK11(RORTSK,"NST",NS,ITEM,3)
- End DoDot:2
- End DoDot:1
- if RC<0
- QUIT RC
- +16 ;--- Bed sections (clinics)
- +17 IF $DATA(@NODE@("IPB"))>1
- Begin DoDot:1
- +18 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"BEDSECTIONS",,SECTION)
- +19 IF TABLE<0
- SET RC=TABLE
- QUIT
- +20 DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","BEDSECTIONS")
- +21 SET NAME=""
- +22 FOR
- SET NAME=$ORDER(@NODE@("IPB","B",NAME))
- if NAME=""
- QUIT
- Begin DoDot:2
- +23 SET BSID=""
- +24 FOR
- SET BSID=$ORDER(@NODE@("IPB","B",NAME,BSID))
- if BSID=""
- QUIT
- if BSID>0
- Begin DoDot:3
- +25 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"BEDSECTION",,TABLE)
- +26 DO ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
- +27 SET TMP=+$GET(@NODE@("IPB",BSID,"P"))
- +28 DO ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
- +29 SET TMP=+$GET(@NODE@("IPB",BSID,"S"))
- +30 DO ADDVAL^RORTSK11(RORTSK,"NST",TMP,ITEM,3)
- +31 SET TMP=+$GET(@NODE@("IPB",BSID,"D"))
- +32 DO ADDVAL^RORTSK11(RORTSK,"ND",TMP,ITEM,3)
- +33 SET TMP=+$GET(@NODE@("IPMLOS",BSID))
- +34 DO ADDVAL^RORTSK11(RORTSK,"MLOS",$JUSTIFY(TMP,0,1),ITEM,3)
- +35 SET TMP=$GET(@NODE@("IPB",BSID,"V"))
- +36 DO ADDVAL^RORTSK11(RORTSK,"NSS",TMP,ITEM,3)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- if RC<0
- QUIT RC
- +37 ;--- No bed section
- +38 IF 'RORSONLY
- IF $DATA(@NODE@("IPNOBS"))>1
- Begin DoDot:1
- +39 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"NOBS",,SECTION)
- +40 IF TABLE<0
- SET RC=TABLE
- QUIT
- +41 DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","NOBS")
- +42 SET NAME=""
- +43 FOR
- SET NAME=$ORDER(@NODE@("IPNOBS",NAME))
- if NAME=""
- QUIT
- Begin DoDot:2
- +44 SET DATE=""
- +45 FOR
- SET DATE=$ORDER(@NODE@("IPNOBS",NAME,DATE))
- if DATE=""
- QUIT
- Begin DoDot:3
- +46 SET PTF=""
- +47 FOR
- SET PTF=$ORDER(@NODE@("IPNOBS",NAME,DATE,PTF))
- if PTF=""
- QUIT
- Begin DoDot:4
- +48 SET DFN=""
- +49 FOR
- SET DFN=$ORDER(@NODE@("IPNOBS",NAME,DATE,PTF,DFN))
- if DFN=""
- QUIT
- Begin DoDot:5
- +50 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
- +51 DO ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
- +52 ;$P($G(@NODE@("IP",DFN)),U)
- SET TMP="0000"
- +53 DO ADDVAL^RORTSK11(RORTSK,"LAST4",TMP,ITEM,2)
- +54 SET TMP=$GET(@NODE@("IP",DFN,"I"))
- +55 DO ADDVAL^RORTSK11(RORTSK,"ICN",TMP,ITEM,1)
- +56 DO ADDVAL^RORTSK11(RORTSK,"ICN",$PIECE(TMP,U,2),ITEM,1)
- +57 DO ADDVAL^RORTSK11(RORTSK,"PACT",$PIECE(TMP,U,3),ITEM,1)
- +58 DO ADDVAL^RORTSK11(RORTSK,"PCP",$PIECE(TMP,U,4),ITEM,1)
- +59 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
- IF AGETYPE'="ALL"
- Begin DoDot:6
- +60 DO ADDVAL^RORTSK11(RORTSK,AGETYPE,$PIECE(TMP,U,5),ITEM,1)
- End DoDot:6
- +61 DO ADDVAL^RORTSK11(RORTSK,"DATE",DATE,ITEM,3)
- +62 DO ADDVAL^RORTSK11(RORTSK,"PTF",PTF,ITEM,1)
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- if RC<0
- QUIT RC
- +63 ;--- Summary
- +64 DO ADDVAL^RORTSK11(RORTSK,"NP",+$GET(@NODE@("IP")),SECTION)
- +65 DO ADDVAL^RORTSK11(RORTSK,"NST",+$GET(@NODE@("IPS")),SECTION)
- +66 DO ADDVAL^RORTSK11(RORTSK,"ND",+$GET(@NODE@("IPD")),SECTION)
- +67 DO ADDVAL^RORTSK11(RORTSK,"NSS",+$GET(@NODE@("IPV")),SECTION)
- +68 SET TMP=$GET(@NODE@("IPMLOS",0))
- +69 DO ADDVAL^RORTSK11(RORTSK,"MLOS",$JUSTIFY(TMP,0,1),SECTION)
- +70 IF $GET(@NODE@("IPS"))>0
- Begin DoDot:1
- +71 SET TMP=$GET(@NODE@("IPD"))/@NODE@("IPS")
- End DoDot:1
- +72 IF '$TEST
- SET TMP=0
- +73 DO ADDVAL^RORTSK11(RORTSK,"ALOS",$JUSTIFY(TMP,0,1),SECTION)
- +74 QUIT 0
