ECRECSIC ;ALB/DAN - Event Capture Screens w/ Inactive Clinics ;12/14/11 16:09
;;2.0;EVENT CAPTURE;**112**;8 May 96;Build 18
;
STRPT ;
D GETREC
I ECPTYP="E" D EXPORT Q
U IO
D PRINT
Q
;
GETREC ;Find screens with inactive clinics
N STAT,IEN,ACT,FL,V,EI,ECSCR,CLN,LOC,UNT,CAT,PX,NODE,DSSIEN,EC4,EC4N,ECPCL
K ^TMP("ECRECSIC",$J)
S STAT="A",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 $S(STAT="A"&(ACT'=""):1,STAT="I"&(ACT=""):1,1:0) Q
.I '$D(ECLOC1(+$P(ECSCR,U))) Q ;Not a location we're looking for
.I '$D(ECDSSU(+$P(ECSCR,U,2))) Q ;Not a DSS Unit we're looking for
.S EC4=$P($G(^ECJ(IEN,"PRO")),U,4) I '+EC4 Q ;No associated clinic
.D CLIN^ECPCEU I ECPCL Q ;Clinic is active, not what we're looking for
.S EC4N=$$GET1^DIQ(44,EC4,.01) ;Get clinic name
.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)
.E S PRO=$$CPT^ICPTCOD($P(ECSCR,U,4)) S PX=$P(PRO,U,2)
.S ^TMP("ECRECSIC",$J,UNT,LOC,IEN)=CAT_U_PX_U_EC4_U_EC4N
Q
;
PRINT ;
N PAGE,UNT,LOC,IEN,DATA
D HDR
S UNT="" F S UNT=$O(^TMP("ECRECSIC",$J,UNT)) Q:UNT="" D W !
.S LOC="" F S LOC=$O(^TMP("ECRECSIC",$J,UNT,LOC)) Q:LOC="" S IEN=0 F S IEN=$O(^TMP("ECRECSIC",$J,UNT,LOC,IEN)) Q:'+IEN D
..S DATA=^TMP("ECRECSIC",$J,UNT,LOC,IEN)
..W !,UNT,?32,LOC,?64,$E($P(DATA,U),1,20),?86,$P(DATA,U,2),?93,$P(DATA,U,3),?99,$P(DATA,U,4)
..I $Y>(IOSL-4) D HDR
Q
;
HDR ;
W @IOF
S PAGE=$G(PAGE)+1
W !,?56,"EVENT CAPTURE REPORT",?123,"PAGE: ",PAGE
W !,?37,"EVENT CODE SCREENS WITH INACTIVE DEFAULT ASSOCIATED CLINICS",?104,"RUN DATE: ",$$FMTE^XLFDT($$NOW^XLFDT,"M"),!
W !,?86,"PROC",?91,"CLINIC",?99,"CLINIC",!,"DSS UNIT",?32,"LOCATION",?64,"CATEGORY",?86,"CODE",?93,"IEN",?99,"NAME"
W !,$$REPEAT^XLFSTR("-",132)
Q
EXPORT ;
N CNT,UNT,LOC,IEN
K ^TMP($J,"ECRPT")
S CNT=1,^TMP($J,"ECRPT",CNT)="DSS UNIT^LOCATION^CATEGORY^PROCEDURE CODE^INACTIVE CLINIC IEN^INACTIVE CLINIC NAME"
S UNT="" F S UNT=$O(^TMP("ECRECSIC",$J,UNT)) Q:UNT="" S LOC="" F S LOC=$O(^TMP("ECRECSIC",$J,UNT,LOC)) Q:LOC="" S IEN=0 F S IEN=$O(^TMP("ECRECSIC",$J,UNT,LOC,IEN)) Q:'+IEN D
.S CNT=CNT+1,^TMP($J,"ECRPT",CNT)=UNT_U_LOC_U_^TMP("ECRECSIC",$J,UNT,LOC,IEN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECRECSIC 2411 printed Oct 16, 2024@17:59:20 Page 2
ECRECSIC ;ALB/DAN - Event Capture Screens w/ Inactive Clinics ;12/14/11 16:09
+1 ;;2.0;EVENT CAPTURE;**112**;8 May 96;Build 18
+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 inactive clinics
+1 NEW STAT,IEN,ACT,FL,V,EI,ECSCR,CLN,LOC,UNT,CAT,PX,NODE,DSSIEN,EC4,EC4N,ECPCL
+2 KILL ^TMP("ECRECSIC",$JOB)
+3 SET STAT="A"
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 IF $SELECT(STAT="A"&(ACT'=""):1,STAT="I"&(ACT=""):1,1:0)
QUIT
+8 ;Not a location we're looking for
IF '$DATA(ECLOC1(+$PIECE(ECSCR,U)))
QUIT
+9 ;Not a DSS Unit we're looking for
IF '$DATA(ECDSSU(+$PIECE(ECSCR,U,2)))
QUIT
+10 ;No associated clinic
SET EC4=$PIECE($GET(^ECJ(IEN,"PRO")),U,4)
IF '+EC4
QUIT
+11 ;Clinic is active, not what we're looking for
DO CLIN^ECPCEU
IF ECPCL
QUIT
+12 ;Get clinic name
SET EC4N=$$GET1^DIQ(44,EC4,.01)
+13 FOR EI=1:1:3
Begin DoDot:2
+14 SET @$PIECE(V,",",EI)=$$GET1^DIQ($PIECE(FL,",",EI),$PIECE(ECSCR,U,EI),.01,"E")
SET PX=""
End DoDot:2
+15 IF $PIECE(ECSCR,U,5)["EC"
Begin DoDot:2
+16 SET PRO=$GET(^EC(725,$PIECE(ECSCR,U,4),0))
SET PX=$PIECE(PRO,U,2)
End DoDot:2
+17 IF '$TEST
SET PRO=$$CPT^ICPTCOD($PIECE(ECSCR,U,4))
SET PX=$PIECE(PRO,U,2)
+18 SET ^TMP("ECRECSIC",$JOB,UNT,LOC,IEN)=CAT_U_PX_U_EC4_U_EC4N
End DoDot:1
+19 QUIT
+20 ;
PRINT ;
+1 NEW PAGE,UNT,LOC,IEN,DATA
+2 DO HDR
+3 SET UNT=""
FOR
SET UNT=$ORDER(^TMP("ECRECSIC",$JOB,UNT))
if UNT=""
QUIT
Begin DoDot:1
+4 SET LOC=""
FOR
SET LOC=$ORDER(^TMP("ECRECSIC",$JOB,UNT,LOC))
if LOC=""
QUIT
SET IEN=0
FOR
SET IEN=$ORDER(^TMP("ECRECSIC",$JOB,UNT,LOC,IEN))
if '+IEN
QUIT
Begin DoDot:2
+5 SET DATA=^TMP("ECRECSIC",$JOB,UNT,LOC,IEN)
+6 WRITE !,UNT,?32,LOC,?64,$EXTRACT($PIECE(DATA,U),1,20),?86,$PIECE(DATA,U,2),?93,$PIECE(DATA,U,3),?99,$PIECE(DATA,U,4)
+7 IF $Y>(IOSL-4)
DO HDR
End DoDot:2
End DoDot:1
WRITE !
+8 QUIT
+9 ;
HDR ;
+1 WRITE @IOF
+2 SET PAGE=$GET(PAGE)+1
+3 WRITE !,?56,"EVENT CAPTURE REPORT",?123,"PAGE: ",PAGE
+4 WRITE !,?37,"EVENT CODE SCREENS WITH INACTIVE DEFAULT ASSOCIATED CLINICS",?104,"RUN DATE: ",$$FMTE^XLFDT($$NOW^XLFDT,"M"),!
+5 WRITE !,?86,"PROC",?91,"CLINIC",?99,"CLINIC",!,"DSS UNIT",?32,"LOCATION",?64,"CATEGORY",?86,"CODE",?93,"IEN",?99,"NAME"
+6 WRITE !,$$REPEAT^XLFSTR("-",132)
+7 QUIT
EXPORT ;
+1 NEW CNT,UNT,LOC,IEN
+2 KILL ^TMP($JOB,"ECRPT")
+3 SET CNT=1
SET ^TMP($JOB,"ECRPT",CNT)="DSS UNIT^LOCATION^CATEGORY^PROCEDURE CODE^INACTIVE CLINIC IEN^INACTIVE CLINIC NAME"
+4 SET UNT=""
FOR
SET UNT=$ORDER(^TMP("ECRECSIC",$JOB,UNT))
if UNT=""
QUIT
SET LOC=""
FOR
SET LOC=$ORDER(^TMP("ECRECSIC",$JOB,UNT,LOC))
if LOC=""
QUIT
SET IEN=0
FOR
SET IEN=$ORDER(^TMP("ECRECSIC",$JOB,UNT,LOC,IEN))
if '+IEN
QUIT
Begin DoDot:1
+5 SET CNT=CNT+1
SET ^TMP($JOB,"ECRPT",CNT)=UNT_U_LOC_U_^TMP("ECRECSIC",$JOB,UNT,LOC,IEN)
End DoDot:1
+6 QUIT
