ECRDSSU2 ;ALB/DAN - DSS Unit Workload Summary Report (CONT) ;10/31/12 12:09
;;2.0;EVENT CAPTURE;**119**;8 May 96;Build 12
;Routine added in patch 119 to support exporting report
EXPORT ;
N CNT
K ^TMP("ECRPT",$J) ; delete temporary storage global
S CNT=1
S ^TMP($J,"ECRPT",CNT)="LOCATION^DSS UNIT^CATEGORY^CPT CODE^PROCEDURE CODE^PROCEDURE NAME^PROCEDURE VOLUME^SYNONYM^CPT MOD 1^MOD 1 VOL^CPT MOD 2^MOD 2 VOL^CPT MOD 3^MOD 3 VOL"
D GETINFO
D STORE
K ^TMP("ECRPT",$J)
Q
;
GETINFO ;Use "ADT" x-ref of file 721 to get information for report
;
N ECD,ECDFN,ECIEN,ECL,ECNT,I,J,ECREC,ECST
N ECTC,ECTP,ECMOD,ECMODS,ECMODF,SEQ
S ECNT=0
F I=0:0 S I=$O(ECLOC(I)) Q:'I S ECL=+$P(ECLOC(I),U) D
. S ECDFN=0
. F S ECDFN=+$O(^ECH("ADT",ECL,ECDFN)) Q:'ECDFN F J=0:0 S J=$O(ECDSSU(J)) Q:'J S ECD=+$P(ECDSSU(J),U) D
.. S ECIEN=0
.. S ECST=ECSTDT
.. F S ECST=+$O(^ECH("ADT",ECL,ECDFN,ECD,ECST)) Q:'ECST!(ECST>ECENDDT) F S ECIEN=+$O(^ECH("ADT",ECL,ECDFN,ECD,ECST,ECIEN)) Q:'ECIEN D
... S ECREC=$G(^ECH(ECIEN,0))
... I ECD=+$P(ECREC,"^",7) D CRETMP
Q
;
CRETMP ;- Create ^TMP("ECRPT" array w/format:
; ^TMP("ECRPT",$J,location,DSS Unit,category,count)=procedure^volume^
; CPT modifiers
;
S ECTC=$S(+$P(ECREC,"^",8)=0:-1,1:+$P(ECREC,"^",8)),ECTP=$P($G(ECREC),"^",9)
S ECNT=ECNT+1,ECTP=$P(ECTP,";")_";"_$E($P(ECTP,";",2),1)
S ECMODS="" I $O(^ECH(ECIEN,"MOD",0))'="" D
. K ECMOD S ECMODF=$$MOD^ECUTL(ECIEN,"I",.ECMOD) I 'ECMODF Q
. S SEQ="" F S SEQ=$O(ECMOD(SEQ)) Q:SEQ="" D
. . S ECMODS=ECMODS_$S(ECMODS="":"",1:";")_SEQ
S ^TMP("ECRPT",$J,+$P(ECREC,"^",4),+$P(ECREC,"^",7),ECTC,ECNT)=ECTP_"^"_+$P(ECREC,"^",10)_"^"_ECMODS
Q
;
STORE ;Put data into ^TMP($J,"ECRPT")
N ECCAT,ECNT,ECOCAT,ECDSS,ECLOCAT,ECPR,ECVOL,ECMOD,ECSYI,ECLOCNM,ECDSSNM,ECCNAM,ECPRCODE,ECPNAM,ECPRN
N MOD1,VOL1,MOD2,VOL2,MOD3,VOL3
S (ECNT,ECDSS,ECLOCAT)=0,(ECCAT,ECOCAT)=""
I '$D(^TMP("ECRPT",$J)) Q
F S ECLOCAT=$O(^TMP("ECRPT",$J,ECLOCAT)) Q:'ECLOCAT D
. F S ECDSS=$O(^TMP("ECRPT",$J,ECLOCAT,ECDSS)) Q:'ECDSS D
.. S ECOCAT=0
.. D LOCNAM,DSSUNAM
.. F S ECCAT=$O(^TMP("ECRPT",$J,ECLOCAT,ECDSS,ECCAT)) Q:ECCAT="" K ECTMP D
... F S ECNT=$O(^TMP("ECRPT",$J,ECLOCAT,ECDSS,ECCAT,ECNT)) Q:'ECNT D
.... S (ECPR,ECVOL)=0
.... S ECPR=$P($G(^TMP("ECRPT",$J,ECLOCAT,ECDSS,ECCAT,ECNT)),"^")
.... S ECVOL=$P($G(^TMP("ECRPT",$J,ECLOCAT,ECDSS,ECCAT,ECNT)),"^",2)
.... S ECMOD=$P($G(^TMP("ECRPT",$J,ECLOCAT,ECDSS,ECCAT,ECNT)),"^",3)
.... S ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR)=$G(ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR))+ECVOL D:ECMOD'="" SETMOD Q
... S ECPR="" F S ECPR=$O(ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR)) Q:ECPR="" D
.... S ECCNAM=$S($P($G(^EC(726,$S(ECCAT<1:0,1:+ECCAT),0)),"^")'="":$P($G(^EC(726,$S(ECCAT<1:0,1:+ECCAT),0)),"^"),1:"None")
.... S ECPRN=$S($P(ECPR,";",2)="E":ECPR_"C(725,",1:ECPR_"CPT(")
.... S ECSYI=+$O(^ECJ("AP",ECLOCAT,ECDSS,$S(ECCAT<1:0,1:+ECCAT),ECPRN,0)),ECSYN=$P($G(^ECJ(ECSYI,"PRO")),"^",2)
.... S ECPI="",ECPRCODE=""
.... S ECCPT=$S($P(ECPR,";",2)="I":+ECPR,1:$P($G(^EC(725,+ECPR,0)),"^",5))
.... I ECCPT'="" S ECPI=$$CPT^ICPTCOD(ECCPT,$P(ECENDDT,".")),ECCPT=$P(ECPI,"^",2)
.... S ECPNAM=$S($P(ECPR,";",2)="E":$G(^EC(725,+$P(ECPR,";"),0)),$P(ECPR,";",2)="I":$P(ECPI,"^",3),1:"") I $P(ECPR,";",2)="E" S ECPRCODE=$P(ECPNAM,U,2),ECPNAM=$P(ECPNAM,U)
.... S CNT=CNT+1 S ^TMP($J,"ECRPT",CNT)=ECLOCNM_U_ECDSSNM_U_ECCNAM_U_ECCPT_U_ECPRCODE_U_ECPNAM_U_$G(ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR))_U_ECSYN
.... D ORDMODS ;Get top 3 mods by volume
.... S ^TMP($J,"ECRPT",CNT)=^TMP($J,"ECRPT",CNT)_U_MOD1_U_VOL1_U_MOD2_U_VOL2_U_MOD3_U_VOL3
Q
;
SETMOD ;Set CPT modifiers in ECTMP array
N MOD,I
F I=1:1 S MOD=$P(ECMOD,";",I) Q:MOD="" D
. S ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR,MOD)=$G(ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR,MOD))+ECVOL
Q
LOCNAM ;- Get location name
;
N I
F I=0:0 S I=$O(ECLOC(I)) Q:'I I $P($G(ECLOC(I)),"^")=ECLOCAT S ECLOCNM=$P(ECLOC(I),"^",2)
Q
;
DSSUNAM ;- Get DSS Unit name
;
N I
F I=0:0 S I=$O(ECDSSU(I)) Q:'I I $P($G(ECDSSU(I)),"^")=ECDSS S ECDSSNM=$P(ECDSSU(I),"^",2)
Q
;
ORDMODS ;Find first three mods by volume
N MOD,ORD,VOL,NUM
S (MOD1,VOL1,MOD2,VOL2,MOD3,VOL3)="",NUM=0
S MOD="" F S MOD=$O(ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR,MOD)) Q:'+MOD S ORD(-ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR,MOD),MOD)=""
I $D(ORD) S VOL="" F S VOL=$O(ORD(VOL)) Q:VOL=""!(NUM=3) S MOD="" F S MOD=$O(ORD(VOL,MOD)) Q:MOD=""!(NUM=3) S NUM=NUM+1 S @("MOD"_NUM)=$$MODNM(MOD),@("VOL"_NUM)=-VOL
Q
;
MODNM(IEN) ;Get modifier name
N MOD,MODI,MODESC
S MODI=$$MOD^ICPTMOD(IEN,"I",$P(ECENDDT,"."))
S MOD=$P(MODI,U,2) I MOD="" Q MOD
S MODESC=$S($P(MODI,U,3)'="":$P(MODI,U,3),1:"Unknown")
Q MOD_" "_MODESC
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECRDSSU2 4715 printed Oct 16, 2024@17:59:17 Page 2
ECRDSSU2 ;ALB/DAN - DSS Unit Workload Summary Report (CONT) ;10/31/12 12:09
+1 ;;2.0;EVENT CAPTURE;**119**;8 May 96;Build 12
+2 ;Routine added in patch 119 to support exporting report
EXPORT ;
+1 NEW CNT
+2 ; delete temporary storage global
KILL ^TMP("ECRPT",$JOB)
+3 SET CNT=1
+4 SET ^TMP($JOB,"ECRPT",CNT)="LOCATION^DSS UNIT^CATEGORY^CPT CODE^PROCEDURE CODE^PROCEDURE NAME^PROCEDURE VOLUME^SYNONYM^CPT MOD 1^MOD 1 VOL^CPT MOD 2^MOD 2 VOL^CPT MOD 3^MOD 3 VOL"
+5 DO GETINFO
+6 DO STORE
+7 KILL ^TMP("ECRPT",$JOB)
+8 QUIT
+9 ;
GETINFO ;Use "ADT" x-ref of file 721 to get information for report
+1 ;
+2 NEW ECD,ECDFN,ECIEN,ECL,ECNT,I,J,ECREC,ECST
+3 NEW ECTC,ECTP,ECMOD,ECMODS,ECMODF,SEQ
+4 SET ECNT=0
+5 FOR I=0:0
SET I=$ORDER(ECLOC(I))
if 'I
QUIT
SET ECL=+$PIECE(ECLOC(I),U)
Begin DoDot:1
+6 SET ECDFN=0
+7 FOR
SET ECDFN=+$ORDER(^ECH("ADT",ECL,ECDFN))
if 'ECDFN
QUIT
FOR J=0:0
SET J=$ORDER(ECDSSU(J))
if 'J
QUIT
SET ECD=+$PIECE(ECDSSU(J),U)
Begin DoDot:2
+8 SET ECIEN=0
+9 SET ECST=ECSTDT
+10 FOR
SET ECST=+$ORDER(^ECH("ADT",ECL,ECDFN,ECD,ECST))
if 'ECST!(ECST>ECENDDT)
QUIT
FOR
SET ECIEN=+$ORDER(^ECH("ADT",ECL,ECDFN,ECD,ECST,ECIEN))
if 'ECIEN
QUIT
Begin DoDot:3
+11 SET ECREC=$GET(^ECH(ECIEN,0))
+12 IF ECD=+$PIECE(ECREC,"^",7)
DO CRETMP
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
CRETMP ;- Create ^TMP("ECRPT" array w/format:
+1 ; ^TMP("ECRPT",$J,location,DSS Unit,category,count)=procedure^volume^
+2 ; CPT modifiers
+3 ;
+4 SET ECTC=$SELECT(+$PIECE(ECREC,"^",8)=0:-1,1:+$PIECE(ECREC,"^",8))
SET ECTP=$PIECE($GET(ECREC),"^",9)
+5 SET ECNT=ECNT+1
SET ECTP=$PIECE(ECTP,";")_";"_$EXTRACT($PIECE(ECTP,";",2),1)
+6 SET ECMODS=""
IF $ORDER(^ECH(ECIEN,"MOD",0))'=""
Begin DoDot:1
+7 KILL ECMOD
SET ECMODF=$$MOD^ECUTL(ECIEN,"I",.ECMOD)
IF 'ECMODF
QUIT
+8 SET SEQ=""
FOR
SET SEQ=$ORDER(ECMOD(SEQ))
if SEQ=""
QUIT
Begin DoDot:2
+9 SET ECMODS=ECMODS_$SELECT(ECMODS="":"",1:";")_SEQ
End DoDot:2
End DoDot:1
+10 SET ^TMP("ECRPT",$JOB,+$PIECE(ECREC,"^",4),+$PIECE(ECREC,"^",7),ECTC,ECNT)=ECTP_"^"_+$PIECE(ECREC,"^",10)_"^"_ECMODS
+11 QUIT
+12 ;
STORE ;Put data into ^TMP($J,"ECRPT")
+1 NEW ECCAT,ECNT,ECOCAT,ECDSS,ECLOCAT,ECPR,ECVOL,ECMOD,ECSYI,ECLOCNM,ECDSSNM,ECCNAM,ECPRCODE,ECPNAM,ECPRN
+2 NEW MOD1,VOL1,MOD2,VOL2,MOD3,VOL3
+3 SET (ECNT,ECDSS,ECLOCAT)=0
SET (ECCAT,ECOCAT)=""
+4 IF '$DATA(^TMP("ECRPT",$JOB))
QUIT
+5 FOR
SET ECLOCAT=$ORDER(^TMP("ECRPT",$JOB,ECLOCAT))
if 'ECLOCAT
QUIT
Begin DoDot:1
+6 FOR
SET ECDSS=$ORDER(^TMP("ECRPT",$JOB,ECLOCAT,ECDSS))
if 'ECDSS
QUIT
Begin DoDot:2
+7 SET ECOCAT=0
+8 DO LOCNAM
DO DSSUNAM
+9 FOR
SET ECCAT=$ORDER(^TMP("ECRPT",$JOB,ECLOCAT,ECDSS,ECCAT))
if ECCAT=""
QUIT
KILL ECTMP
Begin DoDot:3
+10 FOR
SET ECNT=$ORDER(^TMP("ECRPT",$JOB,ECLOCAT,ECDSS,ECCAT,ECNT))
if 'ECNT
QUIT
Begin DoDot:4
+11 SET (ECPR,ECVOL)=0
+12 SET ECPR=$PIECE($GET(^TMP("ECRPT",$JOB,ECLOCAT,ECDSS,ECCAT,ECNT)),"^")
+13 SET ECVOL=$PIECE($GET(^TMP("ECRPT",$JOB,ECLOCAT,ECDSS,ECCAT,ECNT)),"^",2)
+14 SET ECMOD=$PIECE($GET(^TMP("ECRPT",$JOB,ECLOCAT,ECDSS,ECCAT,ECNT)),"^",3)
+15 SET ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR)=$GET(ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR))+ECVOL
if ECMOD'=""
DO SETMOD
QUIT
End DoDot:4
+16 SET ECPR=""
FOR
SET ECPR=$ORDER(ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR))
if ECPR=""
QUIT
Begin DoDot:4
+17 SET ECCNAM=$SELECT($PIECE($GET(^EC(726,$SELECT(ECCAT<1:0,1:+ECCAT),0)),"^")'="":$PIECE($GET(^EC(726,$SELECT(ECCAT<1:0,1:+ECCAT),0)),"^"),1:"None")
+18 SET ECPRN=$SELECT($PIECE(ECPR,";",2)="E":ECPR_"C(725,",1:ECPR_"CPT(")
+19 SET ECSYI=+$ORDER(^ECJ("AP",ECLOCAT,ECDSS,$SELECT(ECCAT<1:0,1:+ECCAT),ECPRN,0))
SET ECSYN=$PIECE($GET(^ECJ(ECSYI,"PRO")),"^",2)
+20 SET ECPI=""
SET ECPRCODE=""
+21 SET ECCPT=$SELECT($PIECE(ECPR,";",2)="I":+ECPR,1:$PIECE($GET(^EC(725,+ECPR,0)),"^",5))
+22 IF ECCPT'=""
SET ECPI=$$CPT^ICPTCOD(ECCPT,$PIECE(ECENDDT,"."))
SET ECCPT=$PIECE(ECPI,"^",2)
+23 SET ECPNAM=$SELECT($PIECE(ECPR,";",2)="E":$GET(^EC(725,+$PIECE(ECPR,";"),0)),$PIECE(ECPR,";",2)="I":$PIECE(ECPI,"^",3),1:"")
IF $PIECE(ECPR,";",2)="E"
SET ECPRCODE=$PIECE(ECPNAM,U,2)
SET ECPNAM=$PIECE(ECPNAM,U)
+24 SET CNT=CNT+1
SET ^TMP($JOB,"ECRPT",CNT)=ECLOCNM_U_ECDSSNM_U_ECCNAM_U_ECCPT_U_ECPRCODE_U_ECPNAM_U_$GET(ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR))_U_ECSYN
+25 ;Get top 3 mods by volume
DO ORDMODS
+26 SET ^TMP($JOB,"ECRPT",CNT)=^TMP($JOB,"ECRPT",CNT)_U_MOD1_U_VOL1_U_MOD2_U_VOL2_U_MOD3_U_VOL3
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+27 QUIT
+28 ;
SETMOD ;Set CPT modifiers in ECTMP array
+1 NEW MOD,I
+2 FOR I=1:1
SET MOD=$PIECE(ECMOD,";",I)
if MOD=""
QUIT
Begin DoDot:1
+3 SET ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR,MOD)=$GET(ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR,MOD))+ECVOL
End DoDot:1
+4 QUIT
LOCNAM ;- Get location name
+1 ;
+2 NEW I
+3 FOR I=0:0
SET I=$ORDER(ECLOC(I))
if 'I
QUIT
IF $PIECE($GET(ECLOC(I)),"^")=ECLOCAT
SET ECLOCNM=$PIECE(ECLOC(I),"^",2)
+4 QUIT
+5 ;
DSSUNAM ;- Get DSS Unit name
+1 ;
+2 NEW I
+3 FOR I=0:0
SET I=$ORDER(ECDSSU(I))
if 'I
QUIT
IF $PIECE($GET(ECDSSU(I)),"^")=ECDSS
SET ECDSSNM=$PIECE(ECDSSU(I),"^",2)
+4 QUIT
+5 ;
ORDMODS ;Find first three mods by volume
+1 NEW MOD,ORD,VOL,NUM
+2 SET (MOD1,VOL1,MOD2,VOL2,MOD3,VOL3)=""
SET NUM=0
+3 SET MOD=""
FOR
SET MOD=$ORDER(ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR,MOD))
if '+MOD
QUIT
SET ORD(-ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR,MOD),MOD)=""
+4 IF $DATA(ORD)
SET VOL=""
FOR
SET VOL=$ORDER(ORD(VOL))
if VOL=""!(NUM=3)
QUIT
SET MOD=""
FOR
SET MOD=$ORDER(ORD(VOL,MOD))
if MOD=""!(NUM=3)
QUIT
SET NUM=NUM+1
SET @("MOD"_NUM)=$$MODNM(MOD)
SET @("VOL"_NUM)=-VOL
+5 QUIT
+6 ;
MODNM(IEN) ;Get modifier name
+1 NEW MOD,MODI,MODESC
+2 SET MODI=$$MOD^ICPTMOD(IEN,"I",$PIECE(ECENDDT,"."))
+3 SET MOD=$PIECE(MODI,U,2)
IF MOD=""
QUIT MOD
+4 SET MODESC=$SELECT($PIECE(MODI,U,3)'="":$PIECE(MODI,U,3),1:"Unknown")
+5 QUIT MOD_" "_MODESC
