RORX007 ;HCIOFO/BH,SG - RADIOLOGY UTILIZATION ;10/14/05 1:37pm
;;1.5;CLINICAL CASE REGISTRIES;**21,31,39**;Feb 17, 2006;Build 4
;
; This routine uses the following IAs:
;
; #10061 DEM^VADPT (supported)
;
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
; additional identifier option selected
;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
;
;***** COMPILES THE "RADIOLOGY UTILIZATION" REPORT
; REPORT CODE: 007
;
; .RORTSK Task number and task parameters
;
; The ^TMP("RORX007",$J) and ^TMP($J,"RAE1") global nodes are
; used by this function.
;
; ^TMP("RORX007",$J,
;
; "PAT",
; DFN,
; ProcName) Number of procedures
;
; "PATSORT",
; ProcQnty,
; Name,
; Last4) Patient data
; ^01: Number of different procedures
; ^02: Date of death
; ^03: National ICN
; ^04: Patient Care Team
; ^05: Primary Care Provider
; ^06: AGE/DOB
;
; "PROC",
; ProcName,
; DFN) Number of procedures
;
; "PROCSORT",
; ProcQnty,
; ProcName,
; CPT) Number of individual patients
;
; "TOTAL") Category Totals
; ^01: Total number of procedures
; ^02: Number of different procedures
; ^03: Total number of patients
; ^04: Number of individual patients
;
; Return Values:
; <0 Error code
; 0 Ok
;
RADUTL(RORTSK) ;
N ROREDT ; End date
N RORREG ; Registry IEN
N RORSDT ; Start date
;
N CNT,ECNT,RC,REPORT,RORPTN,SFLAGS,TMP
;--- Root node of the report
S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
Q:REPORT<0 REPORT
;
;--- Get and prepare the report parameters
S RORREG=$$PARAM^RORTSK01("REGIEN")
S RC=$$PARAMS^RORX007A(REPORT,.RORSDT,.ROREDT,.SFLAGS)
Q:RC<0 RC
;
;--- Initialize constants and variables
S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
S ECNT=0 K ^TMP("RORX007",$J)
;
;--- Report header
S RC=$$HEADER^RORX007A(REPORT) Q:RC<0 RC
;
D
. ;--- Query the registry
. D TPPSETUP^RORTSK01(75)
. S RC=$$QUERY^RORX007A(SFLAGS)
. I RC Q:RC<0 S ECNT=ECNT+RC
. ;--- Sort the data
. D TPPSETUP^RORTSK01(10)
. S RC=$$SORT()
. I RC Q:RC<0 S ECNT=ECNT+RC
. ;--- Store the results
. D TPPSETUP^RORTSK01(15)
. S RC=$$STORE(REPORT)
. I RC Q:RC<0 S ECNT=ECNT+RC
;
;--- Cleanup
K ^TMP("RORX007",$J),^TMP($J,"RAE1")
Q $S(RC<0:RC,ECNT>0:-43,1:0)
;
;***** SORTS THE RESULTS AND COMPILES THE TOTALS
;
; SPCNT Number of patients selected for the report
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
SORT(SPCNT) ;
N DFN,DOD,DPCNT,ECNT,ICN,NAME,NODE,PACT,PCP,PRCNT,PQ,PRN,RC,TMP,TOTAL,VA,VADM,VAHOW,VAROOT,AGETYPE,AGE
S (ECNT,RC)=0
S NODE=$NA(^TMP("RORX007",$J))
Q:$D(@NODE)<10 0
;--- Procedures
S RC=$$LOOP^RORTSK01(0) Q:RC<0 RC
S PRN=""
F S PRN=$O(@NODE@("PROC",PRN)) Q:PRN="" D
. S (DPCNT,PRCNT)=0
. S DFN=""
. F S DFN=$O(@NODE@("PROC",PRN,DFN)) Q:DFN="" D
. . S PQ=$G(@NODE@("PROC",PRN,DFN))
. . S DPCNT=DPCNT+1,PRCNT=PRCNT+PQ
. ;---
. S @NODE@("PROCSORT",PRCNT,$P(PRN,U),$P(PRN,U,2))=DPCNT
. S TOTAL("DPR")=$G(TOTAL("DPR"))+1 ; Different procedures
. S TOTAL("TPT")=$G(TOTAL("TPT"))+DPCNT ; Number of patients
K @NODE@("PROC")
;--- Patients
S RC=$$LOOP^RORTSK01(0.5) Q:RC<0 RC
S DFN=""
F S DFN=$O(@NODE@("PAT",DFN)) Q:DFN="" D
. S (DPCNT,PRCNT)=0
. D DEM^VADPT
. S NAME=$G(VADM(1)) Q:NAME=""
. S LAST4="0000" ;S LAST4=$G(VA("BID")) S:LAST4="" LAST4=" "
. S DOD=$$DATE^RORXU002($P(VADM(6),U)\1)
. S ICN=$$ICN^RORUTL02(DFN)
. S PACT=$$PACT^RORUTL02(DFN)
. S PCP=$$PCP^RORUTL02(DFN)
. 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:"")
. S PRN=""
. F S PRN=$O(@NODE@("PAT",DFN,PRN)) Q:PRN="" D
. . S PQ=$G(@NODE@("PAT",DFN,PRN))
. . S DPCNT=DPCNT+1,PRCNT=PRCNT+PQ
. ;---
. S PACT=$S($$PARAM^RORTSK01("PATIENTS","PACT"):PACT,1:"")
. S PCP=$S($$PARAM^RORTSK01("PATIENTS","PCP"):PCP,1:"")
. S @NODE@("PATSORT",PRCNT,NAME,LAST4)=DPCNT_U_DOD_U_$S($$PARAM^RORTSK01("PATIENTS","ICN"):ICN,1:"")_U_PACT_U_PCP_U_AGE
. S TOTAL("TPR")=$G(TOTAL("TPR"))+PRCNT ; Number of procedures
. S TOTAL("DPT")=$G(TOTAL("DPT"))+1 ; Different patients
K @NODE@("PAT")
;--- Totals
S TMP=$G(TOTAL("TPR"))_U_$G(TOTAL("DPR"))
S @NODE@("TOTAL")=TMP_U_$G(TOTAL("TPT"))_U_$G(TOTAL("DPT"))
;---
Q $S(RC<0:RC,1:ECNT)
;
;***** STORES THE RESULTS
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
STORE(PARTAG) ;
N RORSONLY ; Output summary only
;
N RC,TMP
S RORSONLY=$$SMRYONLY^RORXU006()
S RC=0
;--- Tables
Q:$D(^TMP("RORX007",$J))<10 0
;--- Procedures
S RC=$$LOOP^RORTSK01(0) Q:RC<0 RC
S RC=$$TBLPROC(PARTAG) Q:RC<0 RC
;--- Patients
S RC=$$LOOP^RORTSK01(0.5) Q:RC<0 RC
S RC=$$TBLPAT(PARTAG) Q:RC<0 RC
;--- Totals
S TMP=$G(^TMP("RORX007",$J,"TOTAL"))
D ADDVAL^RORTSK11(RORTSK,"NPR",$P(TMP,U,1),PARTAG)
D ADDVAL^RORTSK11(RORTSK,"NDP",$P(TMP,U,2),PARTAG)
D ADDVAL^RORTSK11(RORTSK,"NP",$P(TMP,U,4),PARTAG)
;---
Q $S(RC<0:RC,1:0)
;
;***** STORES THE TABLE OF PATIENTS
;
; PRNTELMT IEN of the parent tag
;
; Return Values:
; <0 Error code
; 0 Ok
;
TBLPAT(PRNTELMT) ;
N BUF,ITEM,LAST4,MAXUTNUM,NAME,NODE,PRCNT,RC,TABLE,TMP,UTNUM
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 NODE=$NA(^TMP("RORX007",$J,"PATSORT"))
;--- Table
S PRCNT="",(RC,UTNUM)=0
F S PRCNT=$O(@NODE@(PRCNT),-1) Q:PRCNT="" D Q:RC
. S NAME=""
. F S NAME=$O(@NODE@(PRCNT,NAME)) Q:NAME="" D Q:RC
. . S LAST4=""
. . F S LAST4=$O(@NODE@(PRCNT,NAME,LAST4)) Q:LAST4="" D Q:RC
. . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
. . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
. . . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,1)
. . . S BUF=@NODE@(PRCNT,NAME,LAST4)
. . . S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") I AGETYPE'="ALL" D
. . . . D ADDVAL^RORTSK11(RORTSK,AGETYPE,$P(BUF,U,6),ITEM,1)
. . . D ADDVAL^RORTSK11(RORTSK,"DOD",$P(BUF,U,2),ITEM,1)
. . . D ADDVAL^RORTSK11(RORTSK,"TOTAL",PRCNT,ITEM,1)
. . . D ADDVAL^RORTSK11(RORTSK,"UNIQUE",+BUF,ITEM,1)
. . . I $$PARAM^RORTSK01("PATIENTS","ICN") D
. . . . D ADDVAL^RORTSK11(RORTSK,"ICN",$P(BUF,U,3),ITEM,1)
. . . I $$PARAM^RORTSK01("PATIENTS","PACT") D
. . . . D ADDVAL^RORTSK11(RORTSK,"PACT",$P(BUF,U,4),ITEM,1)
. . . I $$PARAM^RORTSK01("PATIENTS","PCP") D
. . . . D ADDVAL^RORTSK11(RORTSK,"PCP",$P(BUF,U,5),ITEM,1)
. . . S UTNUM=UTNUM+1 S:UTNUM'<MAXUTNUM RC=1
Q:RC<0 RC
;---
Q $S(RC<0:RC,1:0)
;
;***** STORES THE TABLE OF PROCEDURES
;
; PRNTELMT IEN of the parent tag
;
; Return Values:
; <0 Error code
; 0 Ok
;
TBLPROC(PRNTELMT) ;
N CPT,ITEM,MINRPNUM,NODE,PRCNT,PRN,TABLE,TMP
S MINRPNUM=$$PARAM^RORTSK01("MINRPNUM")
Q:MINRPNUM'>0 0
S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PROCEDURES",,PRNTELMT)
Q:TABLE<0 TABLE
D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PROCEDURES")
S NODE=$NA(^TMP("RORX007",$J,"PROCSORT"))
;--- Table
S PRCNT="",RC=0
F S PRCNT=$O(@NODE@(PRCNT),-1) Q:PRCNT<MINRPNUM D Q:RC
. S PRN=""
. F S PRN=$O(@NODE@(PRCNT,PRN)) Q:PRN="" D Q:RC
. . S CPT=""
. . F S CPT=$O(@NODE@(PRCNT,PRN,CPT)) Q:CPT="" D Q:RC
. . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PROCEDURE",,TABLE)
. . . D ADDVAL^RORTSK11(RORTSK,"NAME",PRN,ITEM,1)
. . . D ADDVAL^RORTSK11(RORTSK,"CPT",CPT,ITEM,2)
. . . S TMP=+@NODE@(PRCNT,PRN,CPT)
. . . D ADDVAL^RORTSK11(RORTSK,"PATIENTS",TMP,ITEM,1)
. . . D ADDVAL^RORTSK11(RORTSK,"TOTAL",PRCNT,ITEM,1)
Q:RC<0 RC
;---
Q $S(RC<0:RC,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX007 8876 printed Apr 09, 2024@20:49:49 Page 2
RORX007 ;HCIOFO/BH,SG - RADIOLOGY UTILIZATION ;10/14/05 1:37pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**21,31,39**;Feb 17, 2006;Build 4
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #10061 DEM^VADPT (supported)
+6 ;
+7 ;******************************************************************************
+8 ; --- ROUTINE MODIFICATION LOG ---
+9 ;
+10 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+11 ;----------- ---------- ----------- ----------------------------------------
+12 ;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
+13 ; additional identifier option selected
+14 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional
+15 ; identifiers.
+16 ;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
+17 ;******************************************************************************
+18 QUIT
+19 ;
+20 ;***** COMPILES THE "RADIOLOGY UTILIZATION" REPORT
+21 ; REPORT CODE: 007
+22 ;
+23 ; .RORTSK Task number and task parameters
+24 ;
+25 ; The ^TMP("RORX007",$J) and ^TMP($J,"RAE1") global nodes are
+26 ; used by this function.
+27 ;
+28 ; ^TMP("RORX007",$J,
+29 ;
+30 ; "PAT",
+31 ; DFN,
+32 ; ProcName) Number of procedures
+33 ;
+34 ; "PATSORT",
+35 ; ProcQnty,
+36 ; Name,
+37 ; Last4) Patient data
+38 ; ^01: Number of different procedures
+39 ; ^02: Date of death
+40 ; ^03: National ICN
+41 ; ^04: Patient Care Team
+42 ; ^05: Primary Care Provider
+43 ; ^06: AGE/DOB
+44 ;
+45 ; "PROC",
+46 ; ProcName,
+47 ; DFN) Number of procedures
+48 ;
+49 ; "PROCSORT",
+50 ; ProcQnty,
+51 ; ProcName,
+52 ; CPT) Number of individual patients
+53 ;
+54 ; "TOTAL") Category Totals
+55 ; ^01: Total number of procedures
+56 ; ^02: Number of different procedures
+57 ; ^03: Total number of patients
+58 ; ^04: Number of individual patients
+59 ;
+60 ; Return Values:
+61 ; <0 Error code
+62 ; 0 Ok
+63 ;
RADUTL(RORTSK) ;
+1 ; End date
NEW ROREDT
+2 ; Registry IEN
NEW RORREG
+3 ; Start date
NEW RORSDT
+4 ;
+5 NEW CNT,ECNT,RC,REPORT,RORPTN,SFLAGS,TMP
+6 ;--- Root node of the report
+7 SET REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
+8 if REPORT<0
QUIT REPORT
+9 ;
+10 ;--- Get and prepare the report parameters
+11 SET RORREG=$$PARAM^RORTSK01("REGIEN")
+12 SET RC=$$PARAMS^RORX007A(REPORT,.RORSDT,.ROREDT,.SFLAGS)
+13 if RC<0
QUIT RC
+14 ;
+15 ;--- Initialize constants and variables
+16 SET RORPTN=$$REGSIZE^RORUTL02(+RORREG)
if RORPTN<0
SET RORPTN=0
+17 SET ECNT=0
KILL ^TMP("RORX007",$JOB)
+18 ;
+19 ;--- Report header
+20 SET RC=$$HEADER^RORX007A(REPORT)
if RC<0
QUIT RC
+21 ;
+22 Begin DoDot:1
+23 ;--- Query the registry
+24 DO TPPSETUP^RORTSK01(75)
+25 SET RC=$$QUERY^RORX007A(SFLAGS)
+26 IF RC
if RC<0
QUIT
SET ECNT=ECNT+RC
+27 ;--- Sort the data
+28 DO TPPSETUP^RORTSK01(10)
+29 SET RC=$$SORT()
+30 IF RC
if RC<0
QUIT
SET ECNT=ECNT+RC
+31 ;--- Store the results
+32 DO TPPSETUP^RORTSK01(15)
+33 SET RC=$$STORE(REPORT)
+34 IF RC
if RC<0
QUIT
SET ECNT=ECNT+RC
End DoDot:1
+35 ;
+36 ;--- Cleanup
+37 KILL ^TMP("RORX007",$JOB),^TMP($JOB,"RAE1")
+38 QUIT $SELECT(RC<0:RC,ECNT>0:-43,1:0)
+39 ;
+40 ;***** SORTS THE RESULTS AND COMPILES THE TOTALS
+41 ;
+42 ; SPCNT Number of patients selected for the report
+43 ;
+44 ; Return Values:
+45 ; <0 Error code
+46 ; 0 Ok
+47 ; >0 Number of non-fatal errors
+48 ;
SORT(SPCNT) ;
+1 NEW DFN,DOD,DPCNT,ECNT,ICN,NAME,NODE,PACT,PCP,PRCNT,PQ,PRN,RC,TMP,TOTAL,VA,VADM,VAHOW,VAROOT,AGETYPE,AGE
+2 SET (ECNT,RC)=0
+3 SET NODE=$NAME(^TMP("RORX007",$JOB))
+4 if $DATA(@NODE)<10
QUIT 0
+5 ;--- Procedures
+6 SET RC=$$LOOP^RORTSK01(0)
if RC<0
QUIT RC
+7 SET PRN=""
+8 FOR
SET PRN=$ORDER(@NODE@("PROC",PRN))
if PRN=""
QUIT
Begin DoDot:1
+9 SET (DPCNT,PRCNT)=0
+10 SET DFN=""
+11 FOR
SET DFN=$ORDER(@NODE@("PROC",PRN,DFN))
if DFN=""
QUIT
Begin DoDot:2
+12 SET PQ=$GET(@NODE@("PROC",PRN,DFN))
+13 SET DPCNT=DPCNT+1
SET PRCNT=PRCNT+PQ
End DoDot:2
+14 ;---
+15 SET @NODE@("PROCSORT",PRCNT,$PIECE(PRN,U),$PIECE(PRN,U,2))=DPCNT
+16 ; Different procedures
SET TOTAL("DPR")=$GET(TOTAL("DPR"))+1
+17 ; Number of patients
SET TOTAL("TPT")=$GET(TOTAL("TPT"))+DPCNT
End DoDot:1
+18 KILL @NODE@("PROC")
+19 ;--- Patients
+20 SET RC=$$LOOP^RORTSK01(0.5)
if RC<0
QUIT RC
+21 SET DFN=""
+22 FOR
SET DFN=$ORDER(@NODE@("PAT",DFN))
if DFN=""
QUIT
Begin DoDot:1
+23 SET (DPCNT,PRCNT)=0
+24 DO DEM^VADPT
+25 SET NAME=$GET(VADM(1))
if NAME=""
QUIT
+26 ;S LAST4=$G(VA("BID")) S:LAST4="" LAST4=" "
SET LAST4="0000"
+27 SET DOD=$$DATE^RORXU002($PIECE(VADM(6),U)\1)
+28 SET ICN=$$ICN^RORUTL02(DFN)
+29 SET PACT=$$PACT^RORUTL02(DFN)
+30 SET PCP=$$PCP^RORUTL02(DFN)
+31 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
Begin DoDot:2
+32 SET AGE=$SELECT(AGETYPE="AGE":$PIECE(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($PIECE(VADM(3),U)\1),1:"")
End DoDot:2
+33 SET PRN=""
+34 FOR
SET PRN=$ORDER(@NODE@("PAT",DFN,PRN))
if PRN=""
QUIT
Begin DoDot:2
+35 SET PQ=$GET(@NODE@("PAT",DFN,PRN))
+36 SET DPCNT=DPCNT+1
SET PRCNT=PRCNT+PQ
End DoDot:2
+37 ;---
+38 SET PACT=$SELECT($$PARAM^RORTSK01("PATIENTS","PACT"):PACT,1:"")
+39 SET PCP=$SELECT($$PARAM^RORTSK01("PATIENTS","PCP"):PCP,1:"")
+40 SET @NODE@("PATSORT",PRCNT,NAME,LAST4)=DPCNT_U_DOD_U_$SELECT($$PARAM^RORTSK01("PATIENTS","ICN"):ICN,1:"")_U_PACT_U_PCP_U_AGE
+41 ; Number of procedures
SET TOTAL("TPR")=$GET(TOTAL("TPR"))+PRCNT
+42 ; Different patients
SET TOTAL("DPT")=$GET(TOTAL("DPT"))+1
End DoDot:1
+43 KILL @NODE@("PAT")
+44 ;--- Totals
+45 SET TMP=$GET(TOTAL("TPR"))_U_$GET(TOTAL("DPR"))
+46 SET @NODE@("TOTAL")=TMP_U_$GET(TOTAL("TPT"))_U_$GET(TOTAL("DPT"))
+47 ;---
+48 QUIT $SELECT(RC<0:RC,1:ECNT)
+49 ;
+50 ;***** STORES THE RESULTS
+51 ;
+52 ; Return Values:
+53 ; <0 Error code
+54 ; 0 Ok
+55 ; >0 Number of non-fatal errors
+56 ;
STORE(PARTAG) ;
+1 ; Output summary only
NEW RORSONLY
+2 ;
+3 NEW RC,TMP
+4 SET RORSONLY=$$SMRYONLY^RORXU006()
+5 SET RC=0
+6 ;--- Tables
+7 if $DATA(^TMP("RORX007",$JOB))<10
QUIT 0
+8 ;--- Procedures
+9 SET RC=$$LOOP^RORTSK01(0)
if RC<0
QUIT RC
+10 SET RC=$$TBLPROC(PARTAG)
if RC<0
QUIT RC
+11 ;--- Patients
+12 SET RC=$$LOOP^RORTSK01(0.5)
if RC<0
QUIT RC
+13 SET RC=$$TBLPAT(PARTAG)
if RC<0
QUIT RC
+14 ;--- Totals
+15 SET TMP=$GET(^TMP("RORX007",$JOB,"TOTAL"))
+16 DO ADDVAL^RORTSK11(RORTSK,"NPR",$PIECE(TMP,U,1),PARTAG)
+17 DO ADDVAL^RORTSK11(RORTSK,"NDP",$PIECE(TMP,U,2),PARTAG)
+18 DO ADDVAL^RORTSK11(RORTSK,"NP",$PIECE(TMP,U,4),PARTAG)
+19 ;---
+20 QUIT $SELECT(RC<0:RC,1:0)
+21 ;
+22 ;***** STORES THE TABLE OF PATIENTS
+23 ;
+24 ; PRNTELMT IEN of the parent tag
+25 ;
+26 ; Return Values:
+27 ; <0 Error code
+28 ; 0 Ok
+29 ;
TBLPAT(PRNTELMT) ;
+1 NEW BUF,ITEM,LAST4,MAXUTNUM,NAME,NODE,PRCNT,RC,TABLE,TMP,UTNUM
+2 SET MAXUTNUM=$$PARAM^RORTSK01("MAXUTNUM")
+3 if MAXUTNUM'>0
QUIT 0
+4 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,PRNTELMT)
+5 if TABLE<0
QUIT TABLE
+6 DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PATIENTS")
+7 SET NODE=$NAME(^TMP("RORX007",$JOB,"PATSORT"))
+8 ;--- Table
+9 SET PRCNT=""
SET (RC,UTNUM)=0
+10 FOR
SET PRCNT=$ORDER(@NODE@(PRCNT),-1)
if PRCNT=""
QUIT
Begin DoDot:1
+11 SET NAME=""
+12 FOR
SET NAME=$ORDER(@NODE@(PRCNT,NAME))
if NAME=""
QUIT
Begin DoDot:2
+13 SET LAST4=""
+14 FOR
SET LAST4=$ORDER(@NODE@(PRCNT,NAME,LAST4))
if LAST4=""
QUIT
Begin DoDot:3
+15 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
+16 DO ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
+17 DO ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,1)
+18 SET BUF=@NODE@(PRCNT,NAME,LAST4)
+19 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
IF AGETYPE'="ALL"
Begin DoDot:4
+20 DO ADDVAL^RORTSK11(RORTSK,AGETYPE,$PIECE(BUF,U,6),ITEM,1)
End DoDot:4
+21 DO ADDVAL^RORTSK11(RORTSK,"DOD",$PIECE(BUF,U,2),ITEM,1)
+22 DO ADDVAL^RORTSK11(RORTSK,"TOTAL",PRCNT,ITEM,1)
+23 DO ADDVAL^RORTSK11(RORTSK,"UNIQUE",+BUF,ITEM,1)
+24 IF $$PARAM^RORTSK01("PATIENTS","ICN")
Begin DoDot:4
+25 DO ADDVAL^RORTSK11(RORTSK,"ICN",$PIECE(BUF,U,3),ITEM,1)
End DoDot:4
+26 IF $$PARAM^RORTSK01("PATIENTS","PACT")
Begin DoDot:4
+27 DO ADDVAL^RORTSK11(RORTSK,"PACT",$PIECE(BUF,U,4),ITEM,1)
End DoDot:4
+28 IF $$PARAM^RORTSK01("PATIENTS","PCP")
Begin DoDot:4
+29 DO ADDVAL^RORTSK11(RORTSK,"PCP",$PIECE(BUF,U,5),ITEM,1)
End DoDot:4
+30 SET UTNUM=UTNUM+1
if UTNUM'<MAXUTNUM
SET RC=1
End DoDot:3
if RC
QUIT
End DoDot:2
if RC
QUIT
End DoDot:1
if RC
QUIT
+31 if RC<0
QUIT RC
+32 ;---
+33 QUIT $SELECT(RC<0:RC,1:0)
+34 ;
+35 ;***** STORES THE TABLE OF PROCEDURES
+36 ;
+37 ; PRNTELMT IEN of the parent tag
+38 ;
+39 ; Return Values:
+40 ; <0 Error code
+41 ; 0 Ok
+42 ;
TBLPROC(PRNTELMT) ;
+1 NEW CPT,ITEM,MINRPNUM,NODE,PRCNT,PRN,TABLE,TMP
+2 SET MINRPNUM=$$PARAM^RORTSK01("MINRPNUM")
+3 if MINRPNUM'>0
QUIT 0
+4 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"PROCEDURES",,PRNTELMT)
+5 if TABLE<0
QUIT TABLE
+6 DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PROCEDURES")
+7 SET NODE=$NAME(^TMP("RORX007",$JOB,"PROCSORT"))
+8 ;--- Table
+9 SET PRCNT=""
SET RC=0
+10 FOR
SET PRCNT=$ORDER(@NODE@(PRCNT),-1)
if PRCNT<MINRPNUM
QUIT
Begin DoDot:1
+11 SET PRN=""
+12 FOR
SET PRN=$ORDER(@NODE@(PRCNT,PRN))
if PRN=""
QUIT
Begin DoDot:2
+13 SET CPT=""
+14 FOR
SET CPT=$ORDER(@NODE@(PRCNT,PRN,CPT))
if CPT=""
QUIT
Begin DoDot:3
+15 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"PROCEDURE",,TABLE)
+16 DO ADDVAL^RORTSK11(RORTSK,"NAME",PRN,ITEM,1)
+17 DO ADDVAL^RORTSK11(RORTSK,"CPT",CPT,ITEM,2)
+18 SET TMP=+@NODE@(PRCNT,PRN,CPT)
+19 DO ADDVAL^RORTSK11(RORTSK,"PATIENTS",TMP,ITEM,1)
+20 DO ADDVAL^RORTSK11(RORTSK,"TOTAL",PRCNT,ITEM,1)
End DoDot:3
if RC
QUIT
End DoDot:2
if RC
QUIT
End DoDot:1
if RC
QUIT
+21 if RC<0
QUIT RC
+22 ;---
+23 QUIT $SELECT(RC<0:RC,1:0)
