ECRECSPC ;ALB/DAN - Event Capture Screens w/ selected procedure codes ;1/26/16 16:34
;;2.0;EVENT CAPTURE;**112,131**;8 May 96;Build 13
;
STRPT ;
D GETREC
I ECPTYP="E" D EXPORT Q
U IO
D PRINT
Q
;
GETREC ;Find screens with selected procedure codes
N IEN,ACT,FL,V,EI,ECSCR,LOC,UNT,CAT,PX,NODE
K ^TMP("ECRECSPC",$J)
S FL="4,724,726"
S V="LOC,UNT,CAT",IEN=0
F S IEN=$O(^ECJ(IEN)) Q:'IEN S NODE=$G(^ECJ(IEN,0)) I NODE'="" D
.S ACT=$P(NODE,U,2),ECSCR=$TR($P(NODE,U),"-;,","^^")
.I '$D(ECLOC1(+$P(ECSCR,U))) Q ;Not a location we're looking for
.F EI=1:1:3 D
..S @$P(V,",",EI)=$$GET1^DIQ($P(FL,",",EI),$P(ECSCR,U,EI),.01,"E"),PX=""
.I $P(ECSCR,U,5)["EC" D
..S PRO=$G(^EC(725,$P(ECSCR,U,4),0)),PX=$P(PRO,U,2)_"~"_$P(PRO,U)
.E S PRO=$$CPT^ICPTCOD($P(ECSCR,U,4)) S PX=$P(PRO,U,2)_"~"_$P(PRO,U,3)
.I ECLPC0'="ALL" I '$D(ECPROC($P(PX,"~"))) Q ;not procedure code we're looking for
.I $P(ECSCR,U,3),'$P(^ECD($P(ECSCR,U,2),0),U,11) Q ;131 Don't show info if it has a category and DSS unit is set to no categories
.S ^TMP("ECRECSPC",$J,PX,UNT,LOC,IEN)=CAT_U_$S(ACT="":"ACTIVE",1:"INACTIVE")_U_+$P(ECSCR,U,2)
Q
;
PRINT ;
N PAGE,UNT,LOC,IEN,DATA,PX,DONE
D HDR
S PX="" F S PX=$O(^TMP("ECRECSPC",$J,PX)) Q:PX="" D
.W !,?3,"PROCEDURE CODE: ",$P(PX,"~"),!,?3,"PROCEDURE NAME: ",$P(PX,"~",2),!
.S UNT="" F S UNT=$O(^TMP("ECRECSPC",$J,PX,UNT)) Q:UNT="" D W !
..S DONE=0
..S LOC="" F S LOC=$O(^TMP("ECRECSPC",$J,PX,UNT,LOC)) Q:LOC="" S IEN=0 F S IEN=$O(^TMP("ECRECSPC",$J,PX,UNT,LOC,IEN)) Q:'+IEN D
...S DATA=^TMP("ECRECSPC",$J,PX,UNT,LOC,IEN)
...W ! I 'DONE W $P(DATA,U,3),?11,UNT S DONE=1
...W ?43,LOC,?75,$P(DATA,U),?112,$P(DATA,U,2)
...I $Y>(IOSL-4) D HDR
Q
;
HDR ;
W @IOF
S PAGE=$G(PAGE)+1
W !,?56,"EVENT CAPTURE REPORT",?123,"PAGE: ",PAGE
W !,?35,"DSS UNITS/EVENT CODE (EC) SCREENS FOR SELECTED PROCEDURE CODE",?104,"RUN DATE: ",$$FMTE^XLFDT($$NOW^XLFDT,"M"),!
W !,?110,"EC SCREEN",!,"DSS IEN",?11,"DSS UNIT NAME",?43,"LOCATION",?75,"CATEGORY",?112,"STATUS"
W !,$$REPEAT^XLFSTR("-",132)
Q
EXPORT ;
N CNT,UNT,LOC,IEN,PX,DATA
K ^TMP($J,"ECRPT")
S CNT=1,^TMP($J,"ECRPT",CNT)="PROCEDURE CODE^PROCEDURE NAME^DSS UNIT IEN^DSS UNIT^LOCATION^CATEGORY^EC SCREEN STATUS"
S PX="" F S PX=$O(^TMP("ECRECSPC",$J,PX)) Q:PX="" D
.S UNT="" F S UNT=$O(^TMP("ECRECSPC",$J,PX,UNT)) Q:UNT="" S LOC="" F S LOC=$O(^TMP("ECRECSPC",$J,PX,UNT,LOC)) Q:LOC="" S IEN=0 F S IEN=$O(^TMP("ECRECSPC",$J,PX,UNT,LOC,IEN)) Q:'+IEN D
..S DATA=$G(^TMP("ECRECSPC",$J,PX,UNT,LOC,IEN))
..S CNT=CNT+1,^TMP($J,"ECRPT",CNT)=$P(PX,"~")_U_$P(PX,"~",2)_U_$P(DATA,U,3)_U_UNT_U_LOC_U_$P(DATA,U)_U_$P(DATA,U,2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECRECSPC 2679 printed Dec 13, 2024@01:58:37 Page 2
ECRECSPC ;ALB/DAN - Event Capture Screens w/ selected procedure codes ;1/26/16 16:34
+1 ;;2.0;EVENT CAPTURE;**112,131**;8 May 96;Build 13
+2 ;
STRPT ;
+1 DO GETREC
+2 IF ECPTYP="E"
DO EXPORT
QUIT
+3 USE IO
+4 DO PRINT
+5 QUIT
+6 ;
GETREC ;Find screens with selected procedure codes
+1 NEW IEN,ACT,FL,V,EI,ECSCR,LOC,UNT,CAT,PX,NODE
+2 KILL ^TMP("ECRECSPC",$JOB)
+3 SET FL="4,724,726"
+4 SET V="LOC,UNT,CAT"
SET IEN=0
+5 FOR
SET IEN=$ORDER(^ECJ(IEN))
if 'IEN
QUIT
SET NODE=$GET(^ECJ(IEN,0))
IF NODE'=""
Begin DoDot:1
+6 SET ACT=$PIECE(NODE,U,2)
SET ECSCR=$TRANSLATE($PIECE(NODE,U),"-;,","^^")
+7 ;Not a location we're looking for
IF '$DATA(ECLOC1(+$PIECE(ECSCR,U)))
QUIT
+8 FOR EI=1:1:3
Begin DoDot:2
+9 SET @$PIECE(V,",",EI)=$$GET1^DIQ($PIECE(FL,",",EI),$PIECE(ECSCR,U,EI),.01,"E")
SET PX=""
End DoDot:2
+10 IF $PIECE(ECSCR,U,5)["EC"
Begin DoDot:2
+11 SET PRO=$GET(^EC(725,$PIECE(ECSCR,U,4),0))
SET PX=$PIECE(PRO,U,2)_"~"_$PIECE(PRO,U)
End DoDot:2
+12 IF '$TEST
SET PRO=$$CPT^ICPTCOD($PIECE(ECSCR,U,4))
SET PX=$PIECE(PRO,U,2)_"~"_$PIECE(PRO,U,3)
+13 ;not procedure code we're looking for
IF ECLPC0'="ALL"
IF '$DATA(ECPROC($PIECE(PX,"~")))
QUIT
+14 ;131 Don't show info if it has a category and DSS unit is set to no categories
IF $PIECE(ECSCR,U,3)
IF '$PIECE(^ECD($PIECE(ECSCR,U,2),0),U,11)
QUIT
+15 SET ^TMP("ECRECSPC",$JOB,PX,UNT,LOC,IEN)=CAT_U_$SELECT(ACT="":"ACTIVE",1:"INACTIVE")_U_+$PIECE(ECSCR,U,2)
End DoDot:1
+16 QUIT
+17 ;
PRINT ;
+1 NEW PAGE,UNT,LOC,IEN,DATA,PX,DONE
+2 DO HDR
+3 SET PX=""
FOR
SET PX=$ORDER(^TMP("ECRECSPC",$JOB,PX))
if PX=""
QUIT
Begin DoDot:1
+4 WRITE !,?3,"PROCEDURE CODE: ",$PIECE(PX,"~"),!,?3,"PROCEDURE NAME: ",$PIECE(PX,"~",2),!
+5 SET UNT=""
FOR
SET UNT=$ORDER(^TMP("ECRECSPC",$JOB,PX,UNT))
if UNT=""
QUIT
Begin DoDot:2
+6 SET DONE=0
+7 SET LOC=""
FOR
SET LOC=$ORDER(^TMP("ECRECSPC",$JOB,PX,UNT,LOC))
if LOC=""
QUIT
SET IEN=0
FOR
SET IEN=$ORDER(^TMP("ECRECSPC",$JOB,PX,UNT,LOC,IEN))
if '+IEN
QUIT
Begin DoDot:3
+8 SET DATA=^TMP("ECRECSPC",$JOB,PX,UNT,LOC,IEN)
+9 WRITE !
IF 'DONE
WRITE $PIECE(DATA,U,3),?11,UNT
SET DONE=1
+10 WRITE ?43,LOC,?75,$PIECE(DATA,U),?112,$PIECE(DATA,U,2)
+11 IF $Y>(IOSL-4)
DO HDR
End DoDot:3
End DoDot:2
WRITE !
End DoDot:1
+12 QUIT
+13 ;
HDR ;
+1 WRITE @IOF
+2 SET PAGE=$GET(PAGE)+1
+3 WRITE !,?56,"EVENT CAPTURE REPORT",?123,"PAGE: ",PAGE
+4 WRITE !,?35,"DSS UNITS/EVENT CODE (EC) SCREENS FOR SELECTED PROCEDURE CODE",?104,"RUN DATE: ",$$FMTE^XLFDT($$NOW^XLFDT,"M"),!
+5 WRITE !,?110,"EC SCREEN",!,"DSS IEN",?11,"DSS UNIT NAME",?43,"LOCATION",?75,"CATEGORY",?112,"STATUS"
+6 WRITE !,$$REPEAT^XLFSTR("-",132)
+7 QUIT
EXPORT ;
+1 NEW CNT,UNT,LOC,IEN,PX,DATA
+2 KILL ^TMP($JOB,"ECRPT")
+3 SET CNT=1
SET ^TMP($JOB,"ECRPT",CNT)="PROCEDURE CODE^PROCEDURE NAME^DSS UNIT IEN^DSS UNIT^LOCATION^CATEGORY^EC SCREEN STATUS"
+4 SET PX=""
FOR
SET PX=$ORDER(^TMP("ECRECSPC",$JOB,PX))
if PX=""
QUIT
Begin DoDot:1
+5 SET UNT=""
FOR
SET UNT=$ORDER(^TMP("ECRECSPC",$JOB,PX,UNT))
if UNT=""
QUIT
SET LOC=""
FOR
SET LOC=$ORDER(^TMP("ECRECSPC",$JOB,PX,UNT,LOC))
if LOC=""
QUIT
SET IEN=0
FOR
SET IEN=$ORDER(^TMP("ECRECSPC",$JOB,PX,UNT,LOC,IEN))
if '+IEN
QUIT
Begin DoDot:2
+6 SET DATA=$GET(^TMP("ECRECSPC",$JOB,PX,UNT,LOC,IEN))
+7 SET CNT=CNT+1
SET ^TMP($JOB,"ECRPT",CNT)=$PIECE(PX,"~")_U_$PIECE(PX,"~",2)_U_$PIECE(DATA,U,3)_U_UNT_U_LOC_U_$PIECE(DATA,U)_U_$PIECE(DATA,U,2)
End DoDot:2
End DoDot:1
+8 QUIT
