ECRDSSEC ;ALB/DAN - Event capture screen for DSS unit report ;1/25/16 12:02
;;2.0;EVENT CAPTURE;**112,131**;8 May 96;Build 13
;
STRPT ;Main entry point for report
N NODE,PRO,CNT,LOC,CAT,IEN,PX,PN,CATD,LOCDS,ECL,ECSYN,ACT,DEFCL
K ^TMP($J,"ECRPT")
S (CNT,LOC)=0
S CNT=CNT+1,^TMP($J,"ECRPT",CNT)="SYNONYM^PROCEDURE^LOCATION^DEFAULT ASSOCIATED CLINIC^CATEGORY^STATUS"
F S LOC=$O(^ECJ("AP",LOC)) Q:'LOC S CAT="" D
.I ECD'="" D:$D(^ECJ("AP",LOC,ECD)) GETSCN Q
I ECPTYP="E" Q ;Stop if exporting and not printing.
U IO
D HDR
S CNT=1
F S CNT=$O(^TMP($J,"ECRPT",CNT)) Q:'+CNT D
.S NODE=^TMP($J,"ECRPT",CNT)
.W $E($P(NODE,U),1,20),?22,$E($P(NODE,U,2),1,25),?49,$E($P(NODE,U,3),1,25),?76,$E($P(NODE,U,4),1,25),?103,$E($P(NODE,U,5),1,25),?123,$P(NODE,U,6),!
.I $Y>(IOSL-5) D HDR
Q
GETSCN F S CAT=$O(^ECJ("AP",LOC,ECD,CAT)) Q:CAT="" S PX="" D
.I CAT,'$P(^ECD(ECD,0),U,11) Q ;131 Don't show screen if it has a category and the DSS Unit is set to "no categories"
.F S PX=$O(^ECJ("AP",LOC,ECD,CAT,PX)) Q:PX="" S IEN=0 D
..F S IEN=$O(^ECJ("AP",LOC,ECD,CAT,PX,IEN)) Q:'IEN D
...S NODE=$G(^ECJ(IEN,0)) I NODE="" Q
...S ACT=$P(NODE,U,2)
...I $S(STAT="A"&(ACT'=""):1,STAT="I"&(ACT=""):1,1:0) Q ;filter by status
...S PRO=$G(^ECJ(IEN,"PRO")),ECSYN=$P(PRO,U,2),PN=$P($P(PRO,U),";"),DEFCL=$P(PRO,U,4)
...I PN="" Q
...I $P(PRO,U)["EC" S PN=$G(^EC(725,PN,0)),PRO=$P(PN,U,2)_" "_$P(PN,U)
...E S PN=$$CPT^ICPTCOD(PN) S PRO=$P(PN,U,2)_" "_$P(PN,U,3)
...S ACT=$S(ACT'="":"Inactive",1:"Active")
...S CATD=$S('CAT:"None",1:$P($G(^EC(726,CAT,0)),U))
...S LOCDS=$$GET1^DIQ(4,LOC,.01,"I"),CNT=CNT+1
...I DEFCL'="" S DEFCL=$$GET1^DIQ(44,DEFCL,".01")
...S ^TMP($J,"ECRPT",CNT)=ECSYN_U_PRO_U_LOCDS_U_DEFCL_U_CATD_U_ACT
Q
;
HDR ;
I $D(IOF) W @IOF
W !,"EVENT SCREENS FOR DSS UNIT:",$$GET1^DIQ(724,ECD,".01"),?$S($G(IOM):(IOM-18),1:62),$$FMTE^XLFDT($$NOW^XLFDT,"1M"),!!
W !,"SYNONYM",?22,"PROCEDURE",?49,"LOCATION",?76,"ASSOC. CLINIC",?103,"CATEGORY",?123,"STATUS",!,$$REPEAT^XLFSTR("-",$S($G(IOM):IOM,1:132)),!
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECRDSSEC 2064 printed Sep 23, 2025@19:34:36 Page 2
ECRDSSEC ;ALB/DAN - Event capture screen for DSS unit report ;1/25/16 12:02
+1 ;;2.0;EVENT CAPTURE;**112,131**;8 May 96;Build 13
+2 ;
STRPT ;Main entry point for report
+1 NEW NODE,PRO,CNT,LOC,CAT,IEN,PX,PN,CATD,LOCDS,ECL,ECSYN,ACT,DEFCL
+2 KILL ^TMP($JOB,"ECRPT")
+3 SET (CNT,LOC)=0
+4 SET CNT=CNT+1
SET ^TMP($JOB,"ECRPT",CNT)="SYNONYM^PROCEDURE^LOCATION^DEFAULT ASSOCIATED CLINIC^CATEGORY^STATUS"
+5 FOR
SET LOC=$ORDER(^ECJ("AP",LOC))
if 'LOC
QUIT
SET CAT=""
Begin DoDot:1
+6 IF ECD'=""
if $DATA(^ECJ("AP",LOC,ECD))
DO GETSCN
QUIT
End DoDot:1
+7 ;Stop if exporting and not printing.
IF ECPTYP="E"
QUIT
+8 USE IO
+9 DO HDR
+10 SET CNT=1
+11 FOR
SET CNT=$ORDER(^TMP($JOB,"ECRPT",CNT))
if '+CNT
QUIT
Begin DoDot:1
+12 SET NODE=^TMP($JOB,"ECRPT",CNT)
+13 WRITE $EXTRACT($PIECE(NODE,U),1,20),?22,$EXTRACT($PIECE(NODE,U,2),1,25),?49,$EXTRACT($PIECE(NODE,U,3),1,25),?76,$EXTRACT($PIECE(NODE,U,4),1,25),?103,$EXTRACT($PIECE(NODE,U,5),1,25),?123,$PIECE(NODE,U,6),!
+14 IF $Y>(IOSL-5)
DO HDR
End DoDot:1
+15 QUIT
GETSCN FOR
SET CAT=$ORDER(^ECJ("AP",LOC,ECD,CAT))
if CAT=""
QUIT
SET PX=""
Begin DoDot:1
+1 ;131 Don't show screen if it has a category and the DSS Unit is set to "no categories"
IF CAT
IF '$PIECE(^ECD(ECD,0),U,11)
QUIT
+2 FOR
SET PX=$ORDER(^ECJ("AP",LOC,ECD,CAT,PX))
if PX=""
QUIT
SET IEN=0
Begin DoDot:2
+3 FOR
SET IEN=$ORDER(^ECJ("AP",LOC,ECD,CAT,PX,IEN))
if 'IEN
QUIT
Begin DoDot:3
+4 SET NODE=$GET(^ECJ(IEN,0))
IF NODE=""
QUIT
+5 SET ACT=$PIECE(NODE,U,2)
+6 ;filter by status
IF $SELECT(STAT="A"&(ACT'=""):1,STAT="I"&(ACT=""):1,1:0)
QUIT
+7 SET PRO=$GET(^ECJ(IEN,"PRO"))
SET ECSYN=$PIECE(PRO,U,2)
SET PN=$PIECE($PIECE(PRO,U),";")
SET DEFCL=$PIECE(PRO,U,4)
+8 IF PN=""
QUIT
+9 IF $PIECE(PRO,U)["EC"
SET PN=$GET(^EC(725,PN,0))
SET PRO=$PIECE(PN,U,2)_" "_$PIECE(PN,U)
+10 IF '$TEST
SET PN=$$CPT^ICPTCOD(PN)
SET PRO=$PIECE(PN,U,2)_" "_$PIECE(PN,U,3)
+11 SET ACT=$SELECT(ACT'="":"Inactive",1:"Active")
+12 SET CATD=$SELECT('CAT:"None",1:$PIECE($GET(^EC(726,CAT,0)),U))
+13 SET LOCDS=$$GET1^DIQ(4,LOC,.01,"I")
SET CNT=CNT+1
+14 IF DEFCL'=""
SET DEFCL=$$GET1^DIQ(44,DEFCL,".01")
+15 SET ^TMP($JOB,"ECRPT",CNT)=ECSYN_U_PRO_U_LOCDS_U_DEFCL_U_CATD_U_ACT
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
HDR ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,"EVENT SCREENS FOR DSS UNIT:",$$GET1^DIQ(724,ECD,".01"),?$SELECT($GET(IOM):(IOM-18),1:62),$$FMTE^XLFDT($$NOW^XLFDT,"1M"),!!
+3 WRITE !,"SYNONYM",?22,"PROCEDURE",?49,"LOCATION",?76,"ASSOC. CLINIC",?103,"CATEGORY",?123,"STATUS",!,$$REPEAT^XLFSTR("-",$SELECT($GET(IOM):IOM,1:132)),!
