| [613] | 1 | ECDSS3 ;BIR/RHK,JPW-Active/Inactive Category Report ; 5/22/01 11:14am
 | 
|---|
 | 2 |  ;;2.0; EVENT CAPTURE ;**25**;8 May 96
 | 
|---|
 | 3 |  ; Routine to report active and inactive procedures
 | 
|---|
 | 4 | START ; Routine execution
 | 
|---|
 | 5 |  N ECRAS S ECRAS=1  ;roll and scroll flag
 | 
|---|
 | 6 |  S DIR(0)="SO^A:Active Categories;I:Inactive Categories;B:Both"
 | 
|---|
 | 7 |  S DIR("A")="Select Report"
 | 
|---|
 | 8 |  S DIR("?",1)="Enter an A for Active Categories, I for Inactive Categories,"
 | 
|---|
 | 9 |  S DIR("?")="B for a consolidated report of all categories, or ^ to quit."
 | 
|---|
 | 10 |  S DIR("??")="ECDSS3^"
 | 
|---|
 | 11 |  D ^DIR K DIR I $D(DIRUT) G END
 | 
|---|
 | 12 |  S ECRTN=Y
 | 
|---|
 | 13 | ACT ;list active cats (LISTA)
 | 
|---|
 | 14 | INACT ;list inactive cats (LISTI)
 | 
|---|
 | 15 | ALL ;list all cats (LISTB)
 | 
|---|
 | 16 |  W ! D PRINT W @IOF
 | 
|---|
 | 17 |  Q
 | 
|---|
 | 18 | PRINT ;starts print for RPC
 | 
|---|
 | 19 |  I ECRTN="A" D LISTA
 | 
|---|
 | 20 |  I ECRTN="I" D LISTI
 | 
|---|
 | 21 |  I ECRTN="B" D LISTB
 | 
|---|
 | 22 | END ; Kill variables and exit
 | 
|---|
 | 23 |  D ^ECKILL
 | 
|---|
 | 24 |  Q
 | 
|---|
 | 25 | LISTA ;list active categories
 | 
|---|
 | 26 |  K DIC S DIC="^EC(726,",FLDS=".01",BY=".01",(FR,TO)="",L=0,DHD="LIST OF ACTIVE LOCAL CATEGORIES",DIS(0)="I '$P(^EC(726,D0,0),""^"",3)" D EN1^DIP
 | 
|---|
 | 27 |  I $D(ECRAS) W !!,"Press <RET> to continue   " R X:DTIME
 | 
|---|
 | 28 |  Q
 | 
|---|
 | 29 | LISTI ;list inactive categories
 | 
|---|
 | 30 |  K DIC S DIC="^EC(726,",FLDS=".01,2;""INACTIVE DATE""",BY=".01",(FR,TO)="",L=0,DHD="LIST OF INACTIVE LOCAL CATEGORIES",DIS(0)="I +$P(^EC(726,D0,0),""^"",3)" D EN1^DIP
 | 
|---|
 | 31 |  I $D(ECRAS) W !!,"Press <RET> to continue   " R X:DTIME
 | 
|---|
 | 32 |  Q
 | 
|---|
 | 33 | LISTB ;list all cats
 | 
|---|
 | 34 |  K DIC S DIC="^EC(726,",FLDS=".01,2;""INACTIVE DATE""",BY=".01",(FR,TO)="",L=0,DHD="LIST OF ALL LOCAL CATEGORIRES" D EN1^DIP
 | 
|---|
 | 35 |  I $D(ECRAS) W !!,"Press <RET> to continue   " R X:DTIME
 | 
|---|
 | 36 |  Q
 | 
|---|