- 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 Feb 18, 2025@23:23:35 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