ECRDSSU ;ALB/ESD - DSS Unit Workload Summary Report ;11/7/12 12:00
;;2.0;EVENT CAPTURE;**5,8,10,14,18,47,63,72,95,119**;8 May 96;Build 12
;
EN ;- Get location(s), DSS Unit(s), start & end dates, device
;
N ECLOC,ECDSSU,ECSTDT,ECENDDT
I '$$ASKLOC^ECRUTL G ENQ
I '$$ASKDSS^ECRUTL G ENQ
I '$$STDT^ECRUTL G ENQ
I '$$ENDDT^ECRUTL(ECSTDT) G ENQ
I $$ASKDEV D STRPT^ECRDSSU
ENQ Q
;
;
STRPT ;- Main entry point
;
N ECCRT,ECDSSNM,ECDSSTOT,ECLOCNM,ECQUIT,ECPAGE,ECTMP ;119
S (ECDSSTOT,ECPAGE,ECQUIT)=0,(ECDSSNM,ECLOCNM)=""
I $G(ECPTYP)="E" D EXPORT^ECRDSSU2,^ECKILL Q ;119
; Determine if device is CRT
S ECCRT=$S($E(IOST,1,2)="C-":1,1:0)
U IO
D GETREC
D LOOP
I ECQUIT G STRPTQ
D PRTCAT
I ECQUIT G STRPTQ
D DSSCHG
I ECQUIT G STRPTQ
I $D(ECGUI) G STRPTQ
I $D(ZTQUEUED) S ZTREQ="@"
D ^%ZISC
STRPTQ K ^TMP("ECRPT") D ^ECKILL ;119
Q
;
;
GETREC ;- Loop thru "ADT" x-ref of EC Patient file (#721)
;
N ECD,ECDFN,ECIEN,ECL,ECNT,I,J,ECREC,ECST
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
;
N ECTC,ECTP,ECMOD,ECMODS,ECMODF,SEQ
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)
;ALB/JAM - Get Procedure CPT modifiers
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
;
LOOP ;- Loop through data
;
N ECCAT,ECNT,ECOCAT,ECDSS,ECLOCAT,ECPR,ECVOL,ECMOD
S (ECNT,ECDSS,ECLOCAT)=0,(ECCAT,ECOCAT)=""
I '$D(^TMP("ECRPT",$J)) G LOOPQ
F S ECLOCAT=$O(^TMP("ECRPT",$J,ECLOCAT)) Q:'ECLOCAT D
. F S ECDSS=$O(^TMP("ECRPT",$J,ECLOCAT,ECDSS)) Q:'ECDSS D
.. Q:ECQUIT
.. D PRTCAT Q:ECQUIT
.. D DSSCHG Q:ECQUIT
.. S ECOCAT=0
.. D HDR
.. D LOCNAM,DSSUNAM
.. W !!,"Location: ",$G(ECLOCNM),!,"DSS Unit: ",$G(ECDSSNM)
.. F S ECCAT=$O(^TMP("ECRPT",$J,ECLOCAT,ECDSS,ECCAT)) Q:ECCAT="" D
... D CATCHG
... Q:ECQUIT
... 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)
.... I '$D(ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR)) S ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR)=ECVOL D:ECMOD'="" SETMOD Q
.... S ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR)=ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR)+ECVOL D:ECMOD'="" SETMOD
LOOPQ Q
SETMOD ;ALB/JAM - 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
;
CATCHG ;- Category change
;
I ECCAT=""&(ECOCAT="") G CATCHGQ
I ECOCAT="" S ECOCAT=ECCAT G CATCHGQ
I $G(ECOCAT)'=$G(ECCAT) D
. D PRTCAT
. S ECOCAT=ECCAT
CATCHGQ Q
;
PRTCAT ;- Print category
;
Q:'$D(ECTMP)
N ECC,ECCATOT,ECDSS,ECFLG,ECLOC,ECPR,ECPRN,ECSYI,ECSYN,ECCNAM,ECPNAM
N ECCPT,ECPI
S (ECCATOT,ECDSS,ECFLG,ECLOC)=0,(ECC,ECCNAM,ECPR)=""
F S ECLOC=$O(ECTMP(ECLOC)) Q:'ECLOC F S ECDSS=$O(ECTMP(ECLOC,ECDSS)) Q:'ECDSS F S ECC=$O(ECTMP(ECLOC,ECDSS,ECC)) Q:ECC="" F S ECPR=$O(ECTMP(ECLOC,ECDSS,ECC,ECPR)) Q:ECPR="" D I ECQUIT Q
. S ECCNAM=$S($P($G(^EC(726,$S(ECC<1:0,1:+ECC),0)),"^")'="":$P($G(^EC(726,$S(ECC<1:0,1:+ECC),0)),"^"),1:"None")
. S ECPRN=$S($P(ECPR,";",2)="E":ECPR_"C(725,",1:ECPR_"CPT(")
. S ECSYI=+$O(^ECJ("AP",ECLOC,ECDSS,$S(ECC<1:0,1:+ECC),ECPRN,0)),ECSYN=$P($G(^ECJ(ECSYI,"PRO")),"^",2)
. S ECPI=""
. 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:"") S:$P(ECPR,";",2)="E" ECPNAM=$P(ECPNAM,"^",2)_" "_$P(ECPNAM,"^")
. Q:ECQUIT
. I $Y>(IOSL-11) D PAUSE Q:ECQUIT D HDR
. W:'ECFLG !!?1,"Category:",!?2,ECCNAM S ECFLG=1
. W !?3,ECCPT,?9,$E(ECPNAM,1,35),?46,$S(ECSYN]"":$E(ECSYN,1,21),1:""),?69,$J($P($G(ECTMP(ECLOC,ECDSS,ECC,ECPR)),"^"),6)
. S ECCATOT=ECCATOT+$P($G(ECTMP(ECLOC,ECDSS,ECC,ECPR)),"^")
. I $O(ECTMP(ECLOC,ECDSS,ECC,ECPR,""))'="" D PRTMOD I ECQUIT Q
G:ECQUIT PRTCATQ
I $Y>(IOSL-11) D PAUSE G:ECQUIT PRTCATQ D HDR
W !?69,"------"
W !?6,"Total Procedures for ",ECCNAM,?69,$J(ECCATOT,6),!
S ECDSSTOT=ECDSSTOT+ECCATOT
PRTCATQ K ECTMP
Q
;
PRTMOD ;ALB/JAM - Print CPT modifiers
N MOD,IEN,MODESC,MODI S IEN=""
F S IEN=$O(ECTMP(ECLOC,ECDSS,ECC,ECPR,IEN)) Q:IEN="" D
. I $Y>(IOSL-8) D PAUSE Q:ECQUIT D HDR
. S MODI=$$MOD^ICPTMOD(IEN,"I",$P(ECENDDT,"."))
. S MOD=$P(MODI,"^",2) I MOD="" Q
. S MODESC=$P(MODI,"^",3) I MODESC="" S MODESC="Unknown"
. W !?7,"- ",MOD," ",$E(MODESC,1,40)," ("
. W ECTMP(ECLOC,ECDSS,ECC,ECPR,IEN),")"
Q
;
DSSCHG ;- DSS Unit change
;
Q:'$G(ECDSSTOT)
I ECDSSTOT>0 D
. I $Y>(IOSL-11) D PAUSE Q:ECQUIT D HDR
. W !!?69,"======"
. W !?6,"Total Procedures for ",$G(ECDSSNM),?69,$J(ECDSSTOT,6)
. S ECDSSTOT=0,(ECLOCNM,ECDSSNM)=""
. D PAUSE
Q
;
HDR ;- Report header
;
I ECCRT!(ECPAGE) W @IOF
S ECPAGE=ECPAGE+1
W !,?((IOM-32)\2),"DSS UNIT WORKLOAD SUMMARY REPORT"
W !,?((IOM-40)\2),"Date Range: "_$$FMTE^XLFDT($P((ECSTDT+.0001),"."))_" to "_$$FMTE^XLFDT($P(ECENDDT,"."))
W !!,"Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT)
W ?65," Page: ",ECPAGE
W !!?3,"CPT Code",?13,"Description",?46,"Synonym",?69,"Volume"
W !?7,"CPT Modifier (volume of modifiers use)"
W !,$TR($J("",79)," ","-")
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
;
;
PAUSE ;- Pause for screen output
D FOOTER
Q:'ECCRT
N DIR,DIRUT,DUOUT
I IOSL<30 F W ! Q:$Y>(IOSL-4)
W ! S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S ECQUIT=1
Q
;
;
W !!?4,"Volume totals may represent days, minutes, numbers of procedures"
W !?4,"and/or a combination of these."
Q
;
;
ASKDEV() ;- Ask device for printing or queuing report
; Input: None
;
; Output: 1 if report is printed
; 0 if report is queued (or exited out)
;
N ECX,ZTDESC,ZTRTN,ZTSAVE
S ECX=1
K %ZIS S %ZIS="QMP"
D ^%ZIS
S:POP ECX=0
I ECX&($D(IO("Q"))) D
. S ZTRTN="STRPT^ECRDSSU",ZTDESC="DSS UNIT WORKLOAD SUMMARY REPORT"
. S (ZTSAVE("ECLOC("),ZTSAVE("ECDSSU("),ZTSAVE("ECSTDT"),ZTSAVE("ECENDDT"))=""
. D ^%ZTLOAD
. D HOME^%ZIS
. S ECX=0
Q ECX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECRDSSU 7441 printed Dec 13, 2024@01:58:32 Page 2
ECRDSSU ;ALB/ESD - DSS Unit Workload Summary Report ;11/7/12 12:00
+1 ;;2.0;EVENT CAPTURE;**5,8,10,14,18,47,63,72,95,119**;8 May 96;Build 12
+2 ;
EN ;- Get location(s), DSS Unit(s), start & end dates, device
+1 ;
+2 NEW ECLOC,ECDSSU,ECSTDT,ECENDDT
+3 IF '$$ASKLOC^ECRUTL
GOTO ENQ
+4 IF '$$ASKDSS^ECRUTL
GOTO ENQ
+5 IF '$$STDT^ECRUTL
GOTO ENQ
+6 IF '$$ENDDT^ECRUTL(ECSTDT)
GOTO ENQ
+7 IF $$ASKDEV
DO STRPT^ECRDSSU
ENQ QUIT
+1 ;
+2 ;
STRPT ;- Main entry point
+1 ;
+2 ;119
NEW ECCRT,ECDSSNM,ECDSSTOT,ECLOCNM,ECQUIT,ECPAGE,ECTMP
+3 SET (ECDSSTOT,ECPAGE,ECQUIT)=0
SET (ECDSSNM,ECLOCNM)=""
+4 ;119
IF $GET(ECPTYP)="E"
DO EXPORT^ECRDSSU2
DO ^ECKILL
QUIT
+5 ; Determine if device is CRT
+6 SET ECCRT=$SELECT($EXTRACT(IOST,1,2)="C-":1,1:0)
+7 USE IO
+8 DO GETREC
+9 DO LOOP
+10 IF ECQUIT
GOTO STRPTQ
+11 DO PRTCAT
+12 IF ECQUIT
GOTO STRPTQ
+13 DO DSSCHG
+14 IF ECQUIT
GOTO STRPTQ
+15 IF $DATA(ECGUI)
GOTO STRPTQ
+16 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+17 DO ^%ZISC
STRPTQ ;119
KILL ^TMP("ECRPT")
DO ^ECKILL
+1 QUIT
+2 ;
+3 ;
GETREC ;- Loop thru "ADT" x-ref of EC Patient file (#721)
+1 ;
+2 NEW ECD,ECDFN,ECIEN,ECL,ECNT,I,J,ECREC,ECST
+3 SET ECNT=0
+4 FOR I=0:0
SET I=$ORDER(ECLOC(I))
if 'I
QUIT
SET ECL=+$PIECE(ECLOC(I),U)
Begin DoDot:1
+5 SET ECDFN=0
+6 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
+7 SET ECIEN=0
+8 SET ECST=ECSTDT
+9 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
+10 SET ECREC=$GET(^ECH(ECIEN,0))
+11 IF ECD=+$PIECE(ECREC,"^",7)
DO CRETMP
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
+14 ;
CRETMP ;- Create ^TMP("ECRPT" array w/format:
+1 ; ^TMP("ECRPT",$J,location,DSS Unit,category,count)=procedure^volume^
+2 ; CPT modifiers
+3 ;
+4 NEW ECTC,ECTP,ECMOD,ECMODS,ECMODF,SEQ
+5 SET ECTC=$SELECT(+$PIECE(ECREC,"^",8)=0:-1,1:+$PIECE(ECREC,"^",8))
SET ECTP=$PIECE($GET(ECREC),"^",9)
+6 SET ECNT=ECNT+1
SET ECTP=$PIECE(ECTP,";")_";"_$EXTRACT($PIECE(ECTP,";",2),1)
+7 ;ALB/JAM - Get Procedure CPT modifiers
+8 SET ECMODS=""
IF $ORDER(^ECH(ECIEN,"MOD",0))'=""
Begin DoDot:1
+9 KILL ECMOD
SET ECMODF=$$MOD^ECUTL(ECIEN,"I",.ECMOD)
IF 'ECMODF
QUIT
+10 SET SEQ=""
FOR
SET SEQ=$ORDER(ECMOD(SEQ))
if SEQ=""
QUIT
Begin DoDot:2
+11 SET ECMODS=ECMODS_$SELECT(ECMODS="":"",1:";")_SEQ
End DoDot:2
End DoDot:1
+12 SET ^TMP("ECRPT",$JOB,+$PIECE(ECREC,"^",4),+$PIECE(ECREC,"^",7),ECTC,ECNT)=ECTP_"^"_+$PIECE(ECREC,"^",10)_"^"_ECMODS
+13 QUIT
+14 ;
LOOP ;- Loop through data
+1 ;
+2 NEW ECCAT,ECNT,ECOCAT,ECDSS,ECLOCAT,ECPR,ECVOL,ECMOD
+3 SET (ECNT,ECDSS,ECLOCAT)=0
SET (ECCAT,ECOCAT)=""
+4 IF '$DATA(^TMP("ECRPT",$JOB))
GOTO LOOPQ
+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 if ECQUIT
QUIT
+8 DO PRTCAT
if ECQUIT
QUIT
+9 DO DSSCHG
if ECQUIT
QUIT
+10 SET ECOCAT=0
+11 DO HDR
+12 DO LOCNAM
DO DSSUNAM
+13 WRITE !!,"Location: ",$GET(ECLOCNM),!,"DSS Unit: ",$GET(ECDSSNM)
+14 FOR
SET ECCAT=$ORDER(^TMP("ECRPT",$JOB,ECLOCAT,ECDSS,ECCAT))
if ECCAT=""
QUIT
Begin DoDot:3
+15 DO CATCHG
+16 if ECQUIT
QUIT
+17 FOR
SET ECNT=$ORDER(^TMP("ECRPT",$JOB,ECLOCAT,ECDSS,ECCAT,ECNT))
if 'ECNT
QUIT
Begin DoDot:4
+18 SET (ECPR,ECVOL)=0
+19 SET ECPR=$PIECE($GET(^TMP("ECRPT",$JOB,ECLOCAT,ECDSS,ECCAT,ECNT)),"^")
+20 SET ECVOL=$PIECE($GET(^TMP("ECRPT",$JOB,ECLOCAT,ECDSS,ECCAT,ECNT)),"^",2)
+21 SET ECMOD=$PIECE($GET(^TMP("ECRPT",$JOB,ECLOCAT,ECDSS,ECCAT,ECNT)),"^",3)
+22 IF '$DATA(ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR))
SET ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR)=ECVOL
if ECMOD'=""
DO SETMOD
QUIT
+23 SET ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR)=ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR)+ECVOL
if ECMOD'=""
DO SETMOD
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
LOOPQ QUIT
SETMOD ;ALB/JAM - 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
+5 ;
CATCHG ;- Category change
+1 ;
+2 IF ECCAT=""&(ECOCAT="")
GOTO CATCHGQ
+3 IF ECOCAT=""
SET ECOCAT=ECCAT
GOTO CATCHGQ
+4 IF $GET(ECOCAT)'=$GET(ECCAT)
Begin DoDot:1
+5 DO PRTCAT
+6 SET ECOCAT=ECCAT
End DoDot:1
CATCHGQ QUIT
+1 ;
PRTCAT ;- Print category
+1 ;
+2 if '$DATA(ECTMP)
QUIT
+3 NEW ECC,ECCATOT,ECDSS,ECFLG,ECLOC,ECPR,ECPRN,ECSYI,ECSYN,ECCNAM,ECPNAM
+4 NEW ECCPT,ECPI
+5 SET (ECCATOT,ECDSS,ECFLG,ECLOC)=0
SET (ECC,ECCNAM,ECPR)=""
+6 FOR
SET ECLOC=$ORDER(ECTMP(ECLOC))
if 'ECLOC
QUIT
FOR
SET ECDSS=$ORDER(ECTMP(ECLOC,ECDSS))
if 'ECDSS
QUIT
FOR
SET ECC=$ORDER(ECTMP(ECLOC,ECDSS,ECC))
if ECC=""
QUIT
FOR
SET ECPR=$ORDER(ECTMP(ECLOC,ECDSS,ECC,ECPR))
if ECPR=""
QUIT
Begin DoDot:1
+7 SET ECCNAM=$SELECT($PIECE($GET(^EC(726,$SELECT(ECC<1:0,1:+ECC),0)),"^")'="":$PIECE($GET(^EC(726,$SELECT(ECC<1:0,1:+ECC),0)),"^"),1:"None")
+8 SET ECPRN=$SELECT($PIECE(ECPR,";",2)="E":ECPR_"C(725,",1:ECPR_"CPT(")
+9 SET ECSYI=+$ORDER(^ECJ("AP",ECLOC,ECDSS,$SELECT(ECC<1:0,1:+ECC),ECPRN,0))
SET ECSYN=$PIECE($GET(^ECJ(ECSYI,"PRO")),"^",2)
+10 SET ECPI=""
+11 SET ECCPT=$SELECT($PIECE(ECPR,";",2)="I":+ECPR,1:$PIECE($GET(^EC(725,+ECPR,0)),"^",5))
+12 IF ECCPT'=""
SET ECPI=$$CPT^ICPTCOD(ECCPT,$PIECE(ECENDDT,"."))
SET ECCPT=$PIECE(ECPI,"^",2)
+13 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 ECPNAM=$PIECE(ECPNAM,"^",2)_" "_$PIECE(ECPNAM,"^")
+14 if ECQUIT
QUIT
+15 IF $Y>(IOSL-11)
DO PAUSE
if ECQUIT
QUIT
DO HDR
+16 if 'ECFLG
WRITE !!?1,"Category:",!?2,ECCNAM
SET ECFLG=1
+17 WRITE !?3,ECCPT,?9,$EXTRACT(ECPNAM,1,35),?46,$SELECT(ECSYN]"":$EXTRACT(ECSYN,1,21),1:""),?69,$JUSTIFY($PIECE($GET(ECTMP(ECLOC,ECDSS,ECC,ECPR)),"^"),6)
+18 SET ECCATOT=ECCATOT+$PIECE($GET(ECTMP(ECLOC,ECDSS,ECC,ECPR)),"^")
+19 IF $ORDER(ECTMP(ECLOC,ECDSS,ECC,ECPR,""))'=""
DO PRTMOD
IF ECQUIT
QUIT
End DoDot:1
IF ECQUIT
QUIT
+20 if ECQUIT
GOTO PRTCATQ
+21 IF $Y>(IOSL-11)
DO PAUSE
if ECQUIT
GOTO PRTCATQ
DO HDR
+22 WRITE !?69,"------"
+23 WRITE !?6,"Total Procedures for ",ECCNAM,?69,$JUSTIFY(ECCATOT,6),!
+24 SET ECDSSTOT=ECDSSTOT+ECCATOT
PRTCATQ KILL ECTMP
+1 QUIT
+2 ;
PRTMOD ;ALB/JAM - Print CPT modifiers
+1 NEW MOD,IEN,MODESC,MODI
SET IEN=""
+2 FOR
SET IEN=$ORDER(ECTMP(ECLOC,ECDSS,ECC,ECPR,IEN))
if IEN=""
QUIT
Begin DoDot:1
+3 IF $Y>(IOSL-8)
DO PAUSE
if ECQUIT
QUIT
DO HDR
+4 SET MODI=$$MOD^ICPTMOD(IEN,"I",$PIECE(ECENDDT,"."))
+5 SET MOD=$PIECE(MODI,"^",2)
IF MOD=""
QUIT
+6 SET MODESC=$PIECE(MODI,"^",3)
IF MODESC=""
SET MODESC="Unknown"
+7 WRITE !?7,"- ",MOD," ",$EXTRACT(MODESC,1,40)," ("
+8 WRITE ECTMP(ECLOC,ECDSS,ECC,ECPR,IEN),")"
End DoDot:1
+9 QUIT
+10 ;
DSSCHG ;- DSS Unit change
+1 ;
+2 if '$GET(ECDSSTOT)
QUIT
+3 IF ECDSSTOT>0
Begin DoDot:1
+4 IF $Y>(IOSL-11)
DO PAUSE
if ECQUIT
QUIT
DO HDR
+5 WRITE !!?69,"======"
+6 WRITE !?6,"Total Procedures for ",$GET(ECDSSNM),?69,$JUSTIFY(ECDSSTOT,6)
+7 SET ECDSSTOT=0
SET (ECLOCNM,ECDSSNM)=""
+8 DO PAUSE
End DoDot:1
+9 QUIT
+10 ;
HDR ;- Report header
+1 ;
+2 IF ECCRT!(ECPAGE)
WRITE @IOF
+3 SET ECPAGE=ECPAGE+1
+4 WRITE !,?((IOM-32)\2),"DSS UNIT WORKLOAD SUMMARY REPORT"
+5 WRITE !,?((IOM-40)\2),"Date Range: "_$$FMTE^XLFDT($PIECE((ECSTDT+.0001),"."))_" to "_$$FMTE^XLFDT($PIECE(ECENDDT,"."))
+6 WRITE !!,"Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT)
+7 WRITE ?65," Page: ",ECPAGE
+8 WRITE !!?3,"CPT Code",?13,"Description",?46,"Synonym",?69,"Volume"
+9 WRITE !?7,"CPT Modifier (volume of modifiers use)"
+10 WRITE !,$TRANSLATE($JUSTIFY("",79)," ","-")
+11 QUIT
+12 ;
+13 ;
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 ;
+6 ;
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 ;
+6 ;
PAUSE ;- Pause for screen output
+1 DO FOOTER
+2 if 'ECCRT
QUIT
+3 NEW DIR,DIRUT,DUOUT
+4 IF IOSL<30
FOR
WRITE !
if $Y>(IOSL-4)
QUIT
+5 WRITE !
SET DIR(0)="E"
DO ^DIR
IF $DATA(DIRUT)!($DATA(DUOUT))
SET ECQUIT=1
+6 QUIT
+7 ;
+8 ;
+1 WRITE !!?4,"Volume totals may represent days, minutes, numbers of procedures"
+2 WRITE !?4,"and/or a combination of these."
+3 QUIT
+4 ;
+5 ;
ASKDEV() ;- Ask device for printing or queuing report
+1 ; Input: None
+2 ;
+3 ; Output: 1 if report is printed
+4 ; 0 if report is queued (or exited out)
+5 ;
+6 NEW ECX,ZTDESC,ZTRTN,ZTSAVE
+7 SET ECX=1
+8 KILL %ZIS
SET %ZIS="QMP"
+9 DO ^%ZIS
+10 if POP
SET ECX=0
+11 IF ECX&($DATA(IO("Q")))
Begin DoDot:1
+12 SET ZTRTN="STRPT^ECRDSSU"
SET ZTDESC="DSS UNIT WORKLOAD SUMMARY REPORT"
+13 SET (ZTSAVE("ECLOC("),ZTSAVE("ECDSSU("),ZTSAVE("ECSTDT"),ZTSAVE("ECENDDT"))=""
+14 DO ^%ZTLOAD
+15 DO HOME^%ZIS
+16 SET ECX=0
End DoDot:1
+17 QUIT ECX
