ECDSS3 ;BIR/RHK,JPW-Active/Inactive Category Report ;11/7/12 12:09
;;2.0;EVENT CAPTURE;**25,95,119**;8 May 96;Build 12
; Routine to report active and inactive procedures
START ; Routine execution
N ECRAS S ECRAS=1 ;roll and scroll flag
S DIR(0)="SO^A:Active Categories;I:Inactive Categories;B:Both"
S DIR("A")="Select Report"
S DIR("?",1)="Enter an A for Active Categories, I for Inactive Categories,"
S DIR("?")="B for a consolidated report of all categories, or ^ to quit."
S DIR("??")="ECDSS3^"
D ^DIR K DIR I $D(DIRUT) G END
S ECRTN=Y
ACT ;list active cats (LISTA)
INACT ;list inactive cats (LISTI)
ALL ;list all cats (LISTB)
W ! D PRINT W @IOF
Q
PRINT ;starts print for RPC
I $G(ECPTYP)="E" D EXPORT,^ECKILL Q ;119
I ECRTN="A" D LISTA
I ECRTN="I" D LISTI
I ECRTN="B" D LISTB
END ; Kill variables and exit
D ^ECKILL
Q
LISTA ;list active categories
K DIC S DIC="^EC(726,",FLDS=".01",BY=".01",(FR,TO)="",L=0,DHD="CATEGORY REPORT - ACTIVE",DIS(0)="I '$P(^EC(726,D0,0),""^"",3)" D EN1^DIP
I $D(ECRAS) W !!,"Press <RET> to continue " R X:DTIME
Q
LISTI ;list inactive categories
K DIC S DIC="^EC(726,",FLDS=".01,2;""INACTIVE DATE""",BY=".01",(FR,TO)="",L=0,DHD="CATEGORY REPORT - INACTIVE",DIS(0)="I +$P(^EC(726,D0,0),""^"",3)" D EN1^DIP
I $D(ECRAS) W !!,"Press <RET> to continue " R X:DTIME
Q
LISTB ;list all cats
K DIC S DIC="^EC(726,",FLDS=".01,2;""INACTIVE DATE""",BY=".01",(FR,TO)="",L=0,DHD="CATEGORY REPORT - BOTH ACTIVE AND INACTIVE" D EN1^DIP
I $D(ECRAS) W !!,"Press <RET> to continue " R X:DTIME
Q
;
EXPORT ;Section added in patch 119
N CNT,I,NM,NODE
S CNT=1
S ^TMP($J,"ECRPT",CNT)="NAME"_$S(ECRTN'="A":(U_"INACTIVE DATE"),1:"")
S NM="" F S NM=$O(^EC(726,"B",NM)) Q:NM="" S I=0 F S I=$O(^EC(726,"B",NM,I)) Q:'+I D
.S NODE=$G(^EC(726,I,0)) Q:NODE=""
.I ECRTN="A" I $P(NODE,U,3)="" S CNT=CNT+1,^TMP($J,"ECRPT",CNT)=$P(NODE,U) Q
.I ECRTN="B" S CNT=CNT+1,^TMP($J,"ECRPT",CNT)=$P(NODE,U)_U_$$FMTE^XLFDT($P(NODE,U,3)) Q
.I ECRTN="I" I $P(NODE,U,3)'="" S CNT=CNT+1,^TMP($J,"ECRPT",CNT)=$P(NODE,U)_U_$$FMTE^XLFDT($P(NODE,U,3))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECDSS3 2127 printed Nov 22, 2024@17:07:20 Page 2
ECDSS3 ;BIR/RHK,JPW-Active/Inactive Category Report ;11/7/12 12:09
+1 ;;2.0;EVENT CAPTURE;**25,95,119**;8 May 96;Build 12
+2 ; Routine to report active and inactive procedures
START ; Routine execution
+1 ;roll and scroll flag
NEW ECRAS
SET ECRAS=1
+2 SET DIR(0)="SO^A:Active Categories;I:Inactive Categories;B:Both"
+3 SET DIR("A")="Select Report"
+4 SET DIR("?",1)="Enter an A for Active Categories, I for Inactive Categories,"
+5 SET DIR("?")="B for a consolidated report of all categories, or ^ to quit."
+6 SET DIR("??")="ECDSS3^"
+7 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
GOTO END
+8 SET ECRTN=Y
ACT ;list active cats (LISTA)
INACT ;list inactive cats (LISTI)
ALL ;list all cats (LISTB)
+1 WRITE !
DO PRINT
WRITE @IOF
+2 QUIT
PRINT ;starts print for RPC
+1 ;119
IF $GET(ECPTYP)="E"
DO EXPORT
DO ^ECKILL
QUIT
+2 IF ECRTN="A"
DO LISTA
+3 IF ECRTN="I"
DO LISTI
+4 IF ECRTN="B"
DO LISTB
END ; Kill variables and exit
+1 DO ^ECKILL
+2 QUIT
LISTA ;list active categories
+1 KILL DIC
SET DIC="^EC(726,"
SET FLDS=".01"
SET BY=".01"
SET (FR,TO)=""
SET L=0
SET DHD="CATEGORY REPORT - ACTIVE"
SET DIS(0)="I '$P(^EC(726,D0,0),""^"",3)"
DO EN1^DIP
+2 IF $DATA(ECRAS)
WRITE !!,"Press <RET> to continue "
READ X:DTIME
+3 QUIT
LISTI ;list inactive categories
+1 KILL DIC
SET DIC="^EC(726,"
SET FLDS=".01,2;""INACTIVE DATE"""
SET BY=".01"
SET (FR,TO)=""
SET L=0
SET DHD="CATEGORY REPORT - INACTIVE"
SET DIS(0)="I +$P(^EC(726,D0,0),""^"",3)"
DO EN1^DIP
+2 IF $DATA(ECRAS)
WRITE !!,"Press <RET> to continue "
READ X:DTIME
+3 QUIT
LISTB ;list all cats
+1 KILL DIC
SET DIC="^EC(726,"
SET FLDS=".01,2;""INACTIVE DATE"""
SET BY=".01"
SET (FR,TO)=""
SET L=0
SET DHD="CATEGORY REPORT - BOTH ACTIVE AND INACTIVE"
DO EN1^DIP
+2 IF $DATA(ECRAS)
WRITE !!,"Press <RET> to continue "
READ X:DTIME
+3 QUIT
+4 ;
EXPORT ;Section added in patch 119
+1 NEW CNT,I,NM,NODE
+2 SET CNT=1
+3 SET ^TMP($JOB,"ECRPT",CNT)="NAME"_$SELECT(ECRTN'="A":(U_"INACTIVE DATE"),1:"")
+4 SET NM=""
FOR
SET NM=$ORDER(^EC(726,"B",NM))
if NM=""
QUIT
SET I=0
FOR
SET I=$ORDER(^EC(726,"B",NM,I))
if '+I
QUIT
Begin DoDot:1
+5 SET NODE=$GET(^EC(726,I,0))
if NODE=""
QUIT
+6 IF ECRTN="A"
IF $PIECE(NODE,U,3)=""
SET CNT=CNT+1
SET ^TMP($JOB,"ECRPT",CNT)=$PIECE(NODE,U)
QUIT
+7 IF ECRTN="B"
SET CNT=CNT+1
SET ^TMP($JOB,"ECRPT",CNT)=$PIECE(NODE,U)_U_$$FMTE^XLFDT($PIECE(NODE,U,3))
QUIT
+8 IF ECRTN="I"
IF $PIECE(NODE,U,3)'=""
SET CNT=CNT+1
SET ^TMP($JOB,"ECRPT",CNT)=$PIECE(NODE,U)_U_$$FMTE^XLFDT($PIECE(NODE,U,3))
End DoDot:1
+9 QUIT
