- 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 Apr 23, 2025@18:13:01 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
