RORX006C ;HCIOFO/BH,SG - LAB UTILIZATION (STORE) ;9/19/05 9:39am
;;1.5;CLINICAL CASE REGISTRIES;**21,31,39**;Feb 17, 2006;Build 4
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*21 SEP 2013 T KOPP Add ICN column if Additional Identifier
; requested.
;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, AGE/DOB as additional
; identifiers.
;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
;******************************************************************************
Q
;
;***** PATIENTS WITH HIGHEST UTILIZATION
;
; PRNTELMT IEN of the parent element
;
; NODE Closed root of the category section
; in the temporary global
;
; Return Values:
; <0 Error code
; 0 Ok
;
PATIENTS(PRNTELMT,NODE) ;
Q:$D(@NODE@("PAT"))<10 0
N COUNT,DFN,ITEM,MAXUTNUM,NAME,NUM,RC,TMP,AGETYPE
S MAXUTNUM=$$PARAM^RORTSK01("MAXUTNUM")
Q:MAXUTNUM'>0 0
S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,PRNTELMT)
Q:TABLE<0 TABLE
D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PATIENTS")
;---
S NUM="",(COUNT,RC)=0
S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
F S NUM=$O(@NODE@("RES1",NUM),-1) Q:NUM="" D Q:RC
. S NAME=""
. F S NAME=$O(@NODE@("RES1",NUM,NAME)) Q:NAME="" D Q:RC
. . S DFN=""
. . F S DFN=$O(@NODE@("RES1",NUM,NAME,DFN)) Q:DFN="" D Q:RC
. . . S COUNT=COUNT+1 I COUNT>MAXUTNUM S RC=1 Q
. . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
. . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
. . . S TMP="0000" ;S TMP=$G(@NODE@("PAT",DFN))
. . . D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(TMP,U),ITEM,2)
. . . I AGETYPE'="ALL" D ADDVAL^RORTSK11(RORTSK,AGETYPE,$P(TMP,U,6),ITEM,1)
. . . D ADDVAL^RORTSK11(RORTSK,"DOD",$P(TMP,U,2),ITEM,1)
. . . S TMP=+$G(@NODE@("PAT",DFN,"O"))
. . . D ADDVAL^RORTSK11(RORTSK,"NO",TMP,ITEM,3)
. . . D ADDVAL^RORTSK11(RORTSK,"NR",NUM,ITEM,3)
. . . S TMP=+$P($G(@NODE@("PAT",DFN,"R")),U,2)
. . . D ADDVAL^RORTSK11(RORTSK,"NDT",TMP,ITEM,3)
. . . S TMP=$G(@NODE@("PAT",DFN))
. . . I $$PARAM^RORTSK01("PATIENTS","ICN") D
. . . . D ADDVAL^RORTSK11(RORTSK,"ICN",$P(TMP,U,3),ITEM,1)
. . . I $$PARAM^RORTSK01("PATIENTS","PACT") D
. . . . D ADDVAL^RORTSK11(RORTSK,"PACT",$P(TMP,U,4),ITEM,1)
. . . I $$PARAM^RORTSK01("PATIENTS","PCP") D
. . . . D ADDVAL^RORTSK11(RORTSK,"PCP",$P(TMP,U,5),ITEM,1)
Q $S(RC<0:RC,1:0)
;
;***** NUMBERS OF PATIENTS AND RESULTS
;
; PRNTELMT IEN of the parent element
;
; NODE Closed root of the category section
; in the temporary global
;
; Return Values:
; <0 Error code
; 0 Ok
;
RESULTS(PRNTELMT,NODE) ;
Q:$D(@NODE@("RES1"))<10 0
N ITEM,NUM,RC,TABLE
S TABLE=$$ADDVAL^RORTSK11(RORTSK,"RESULTS",,PRNTELMT)
Q:TABLE<0 TABLE
D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","RESULTS")
S NUM="",RC=0
F S NUM=$O(@NODE@("RES1",NUM),-1) Q:NUM="" D Q:RC
. S ITEM=$$ADDVAL^RORTSK11(RORTSK,"ITEM",,TABLE)
. S TMP=+$G(@NODE@("RES1",NUM))
. D ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
. D ADDVAL^RORTSK11(RORTSK,"NR",NUM,ITEM,3)
Q $S(RC<0:RC,1: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,RORI,SUBLST,TMP
S RORSONLY=$$SMRYONLY^RORXU006()
S (ECNT,RC)=0
;---
S NODE=$NA(^TMP("RORX006",$J))
Q:$D(@NODE)<10 0
;--- Tables
S RC=$$LOOP^RORTSK01(0) Q:RC<0 RC
S RC=$$RESULTS(REPORT,NODE)
I RC Q:RC<0 RC S ECNT=ECNT+RC
;---
S RC=$$LOOP^RORTSK01(1/3) Q:RC<0 RC
S RC=$$TESTS(REPORT,NODE)
I RC Q:RC<0 RC S ECNT=ECNT+RC
;---
S RC=$$LOOP^RORTSK01(2/3) Q:RC<0 RC
S RC=$$PATIENTS(REPORT,NODE)
I RC Q:RC<0 RC S ECNT=ECNT+RC
;--- Summary
D ADDVAL^RORTSK11(RORTSK,"NO",+$G(@NODE@("ORD")),REPORT)
S TMP=$G(@NODE@("RES"))
D ADDVAL^RORTSK11(RORTSK,"NR",+$P(TMP,U),REPORT)
D ADDVAL^RORTSK11(RORTSK,"NDT",+$P(TMP,U,2),REPORT)
D ADDVAL^RORTSK11(RORTSK,"NP",+$G(@NODE@("PAT")),REPORT)
;---
Q $S(RC<0:RC,1:ECNT)
;
;***** LAB TESTS
;
; PRNTELMT IEN of the parent element
;
; NODE Closed root of the category section
; in the temporary global
;
; Return Values:
; <0 Error code
; 0 Ok
;
TESTS(PRNTELMT,NODE) ;
Q:$D(@NODE@("RES"))<10 0
N IEN,ITEM,MINRPNUM,NAME,NUM,RC,TMP
S MINRPNUM=$$PARAM^RORTSK01("MINRPNUM")
Q:MINRPNUM'>0 0
S TABLE=$$ADDVAL^RORTSK11(RORTSK,"LABTESTS",,PRNTELMT)
Q:TABLE<0 TABLE
D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","LABTESTS")
;---
S NUM="",RC=0
F S NUM=$O(@NODE@("RES","B",NUM),-1) Q:NUM<MINRPNUM D Q:RC
. S NAME=""
. F S NAME=$O(@NODE@("RES","B",NUM,NAME)) Q:NAME="" D Q:RC
. . S IEN=""
. . F S IEN=$O(@NODE@("RES","B",NUM,NAME,IEN)) Q:IEN="" D Q:RC
. . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"LT",,TABLE)
. . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
. . . S TMP=+$G(@NODE@("RES",IEN,"P"))
. . . D ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
. . . D ADDVAL^RORTSK11(RORTSK,"NR",NUM,ITEM,3)
. . . S TMP=$G(@NODE@("RES",IEN,"M"))
. . . D ADDVAL^RORTSK11(RORTSK,"MAXNRPP",+$P(TMP,U),ITEM,3)
. . . D ADDVAL^RORTSK11(RORTSK,"MAXNP",+$P(TMP,U,2),ITEM,3)
Q $S(RC<0:RC,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX006C 5781 printed Dec 13, 2024@01:44:26 Page 2
RORX006C ;HCIOFO/BH,SG - LAB UTILIZATION (STORE) ;9/19/05 9:39am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**21,31,39**;Feb 17, 2006;Build 4
+2 ;
+3 ;******************************************************************************
+4 ;******************************************************************************
+5 ; --- ROUTINE MODIFICATION LOG ---
+6 ;
+7 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+8 ;----------- ---------- ----------- ----------------------------------------
+9 ;ROR*1.5*21 SEP 2013 T KOPP Add ICN column if Additional Identifier
+10 ; requested.
+11 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, AGE/DOB as additional
+12 ; identifiers.
+13 ;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
+14 ;******************************************************************************
+15 QUIT
+16 ;
+17 ;***** PATIENTS WITH HIGHEST UTILIZATION
+18 ;
+19 ; PRNTELMT IEN of the parent element
+20 ;
+21 ; NODE Closed root of the category section
+22 ; in the temporary global
+23 ;
+24 ; Return Values:
+25 ; <0 Error code
+26 ; 0 Ok
+27 ;
PATIENTS(PRNTELMT,NODE) ;
+1 if $DATA(@NODE@("PAT"))<10
QUIT 0
+2 NEW COUNT,DFN,ITEM,MAXUTNUM,NAME,NUM,RC,TMP,AGETYPE
+3 SET MAXUTNUM=$$PARAM^RORTSK01("MAXUTNUM")
+4 if MAXUTNUM'>0
QUIT 0
+5 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,PRNTELMT)
+6 if TABLE<0
QUIT TABLE
+7 DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PATIENTS")
+8 ;---
+9 SET NUM=""
SET (COUNT,RC)=0
+10 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
+11 FOR
SET NUM=$ORDER(@NODE@("RES1",NUM),-1)
if NUM=""
QUIT
Begin DoDot:1
+12 SET NAME=""
+13 FOR
SET NAME=$ORDER(@NODE@("RES1",NUM,NAME))
if NAME=""
QUIT
Begin DoDot:2
+14 SET DFN=""
+15 FOR
SET DFN=$ORDER(@NODE@("RES1",NUM,NAME,DFN))
if DFN=""
QUIT
Begin DoDot:3
+16 SET COUNT=COUNT+1
IF COUNT>MAXUTNUM
SET RC=1
QUIT
+17 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
+18 DO ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
+19 ;S TMP=$G(@NODE@("PAT",DFN))
SET TMP="0000"
+20 DO ADDVAL^RORTSK11(RORTSK,"LAST4",$PIECE(TMP,U),ITEM,2)
+21 IF AGETYPE'="ALL"
DO ADDVAL^RORTSK11(RORTSK,AGETYPE,$PIECE(TMP,U,6),ITEM,1)
+22 DO ADDVAL^RORTSK11(RORTSK,"DOD",$PIECE(TMP,U,2),ITEM,1)
+23 SET TMP=+$GET(@NODE@("PAT",DFN,"O"))
+24 DO ADDVAL^RORTSK11(RORTSK,"NO",TMP,ITEM,3)
+25 DO ADDVAL^RORTSK11(RORTSK,"NR",NUM,ITEM,3)
+26 SET TMP=+$PIECE($GET(@NODE@("PAT",DFN,"R")),U,2)
+27 DO ADDVAL^RORTSK11(RORTSK,"NDT",TMP,ITEM,3)
+28 SET TMP=$GET(@NODE@("PAT",DFN))
+29 IF $$PARAM^RORTSK01("PATIENTS","ICN")
Begin DoDot:4
+30 DO ADDVAL^RORTSK11(RORTSK,"ICN",$PIECE(TMP,U,3),ITEM,1)
End DoDot:4
+31 IF $$PARAM^RORTSK01("PATIENTS","PACT")
Begin DoDot:4
+32 DO ADDVAL^RORTSK11(RORTSK,"PACT",$PIECE(TMP,U,4),ITEM,1)
End DoDot:4
+33 IF $$PARAM^RORTSK01("PATIENTS","PCP")
Begin DoDot:4
+34 DO ADDVAL^RORTSK11(RORTSK,"PCP",$PIECE(TMP,U,5),ITEM,1)
End DoDot:4
End DoDot:3
if RC
QUIT
End DoDot:2
if RC
QUIT
End DoDot:1
if RC
QUIT
+35 QUIT $SELECT(RC<0:RC,1:0)
+36 ;
+37 ;***** NUMBERS OF PATIENTS AND RESULTS
+38 ;
+39 ; PRNTELMT IEN of the parent element
+40 ;
+41 ; NODE Closed root of the category section
+42 ; in the temporary global
+43 ;
+44 ; Return Values:
+45 ; <0 Error code
+46 ; 0 Ok
+47 ;
RESULTS(PRNTELMT,NODE) ;
+1 if $DATA(@NODE@("RES1"))<10
QUIT 0
+2 NEW ITEM,NUM,RC,TABLE
+3 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"RESULTS",,PRNTELMT)
+4 if TABLE<0
QUIT TABLE
+5 DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","RESULTS")
+6 SET NUM=""
SET RC=0
+7 FOR
SET NUM=$ORDER(@NODE@("RES1",NUM),-1)
if NUM=""
QUIT
Begin DoDot:1
+8 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"ITEM",,TABLE)
+9 SET TMP=+$GET(@NODE@("RES1",NUM))
+10 DO ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
+11 DO ADDVAL^RORTSK11(RORTSK,"NR",NUM,ITEM,3)
End DoDot:1
if RC
QUIT
+12 QUIT $SELECT(RC<0:RC,1:0)
+13 ;
+14 ;***** STORES THE REPORT DATA
+15 ;
+16 ; REPORT IEN of the REPORT element
+17 ;
+18 ; Return Values:
+19 ; <0 Error code
+20 ; 0 Ok
+21 ; >0 Number of non-fatal errors
+22 ;
STORE(REPORT) ;
+1 ; Output summary only
NEW RORSONLY
+2 ;
+3 NEW ECNT,NODE,RC,RORI,SUBLST,TMP
+4 SET RORSONLY=$$SMRYONLY^RORXU006()
+5 SET (ECNT,RC)=0
+6 ;---
+7 SET NODE=$NAME(^TMP("RORX006",$JOB))
+8 if $DATA(@NODE)<10
QUIT 0
+9 ;--- Tables
+10 SET RC=$$LOOP^RORTSK01(0)
if RC<0
QUIT RC
+11 SET RC=$$RESULTS(REPORT,NODE)
+12 IF RC
if RC<0
QUIT RC
SET ECNT=ECNT+RC
+13 ;---
+14 SET RC=$$LOOP^RORTSK01(1/3)
if RC<0
QUIT RC
+15 SET RC=$$TESTS(REPORT,NODE)
+16 IF RC
if RC<0
QUIT RC
SET ECNT=ECNT+RC
+17 ;---
+18 SET RC=$$LOOP^RORTSK01(2/3)
if RC<0
QUIT RC
+19 SET RC=$$PATIENTS(REPORT,NODE)
+20 IF RC
if RC<0
QUIT RC
SET ECNT=ECNT+RC
+21 ;--- Summary
+22 DO ADDVAL^RORTSK11(RORTSK,"NO",+$GET(@NODE@("ORD")),REPORT)
+23 SET TMP=$GET(@NODE@("RES"))
+24 DO ADDVAL^RORTSK11(RORTSK,"NR",+$PIECE(TMP,U),REPORT)
+25 DO ADDVAL^RORTSK11(RORTSK,"NDT",+$PIECE(TMP,U,2),REPORT)
+26 DO ADDVAL^RORTSK11(RORTSK,"NP",+$GET(@NODE@("PAT")),REPORT)
+27 ;---
+28 QUIT $SELECT(RC<0:RC,1:ECNT)
+29 ;
+30 ;***** LAB TESTS
+31 ;
+32 ; PRNTELMT IEN of the parent element
+33 ;
+34 ; NODE Closed root of the category section
+35 ; in the temporary global
+36 ;
+37 ; Return Values:
+38 ; <0 Error code
+39 ; 0 Ok
+40 ;
TESTS(PRNTELMT,NODE) ;
+1 if $DATA(@NODE@("RES"))<10
QUIT 0
+2 NEW IEN,ITEM,MINRPNUM,NAME,NUM,RC,TMP
+3 SET MINRPNUM=$$PARAM^RORTSK01("MINRPNUM")
+4 if MINRPNUM'>0
QUIT 0
+5 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"LABTESTS",,PRNTELMT)
+6 if TABLE<0
QUIT TABLE
+7 DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","LABTESTS")
+8 ;---
+9 SET NUM=""
SET RC=0
+10 FOR
SET NUM=$ORDER(@NODE@("RES","B",NUM),-1)
if NUM<MINRPNUM
QUIT
Begin DoDot:1
+11 SET NAME=""
+12 FOR
SET NAME=$ORDER(@NODE@("RES","B",NUM,NAME))
if NAME=""
QUIT
Begin DoDot:2
+13 SET IEN=""
+14 FOR
SET IEN=$ORDER(@NODE@("RES","B",NUM,NAME,IEN))
if IEN=""
QUIT
Begin DoDot:3
+15 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"LT",,TABLE)
+16 DO ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
+17 SET TMP=+$GET(@NODE@("RES",IEN,"P"))
+18 DO ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
+19 DO ADDVAL^RORTSK11(RORTSK,"NR",NUM,ITEM,3)
+20 SET TMP=$GET(@NODE@("RES",IEN,"M"))
+21 DO ADDVAL^RORTSK11(RORTSK,"MAXNRPP",+$PIECE(TMP,U),ITEM,3)
+22 DO ADDVAL^RORTSK11(RORTSK,"MAXNP",+$PIECE(TMP,U,2),ITEM,3)
End DoDot:3
if RC
QUIT
End DoDot:2
if RC
QUIT
End DoDot:1
if RC
QUIT
+23 QUIT $SELECT(RC<0:RC,1:0)
