Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECDSS3

ECDSS3.m

Go to the documentation of this file.
  1. 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
  1. ; Routine to report active and inactive procedures
  1. START ; Routine execution
  1. N ECRAS S ECRAS=1 ;roll and scroll flag
  1. S DIR(0)="SO^A:Active Categories;I:Inactive Categories;B:Both"
  1. S DIR("A")="Select Report"
  1. S DIR("?",1)="Enter an A for Active Categories, I for Inactive Categories,"
  1. S DIR("?")="B for a consolidated report of all categories, or ^ to quit."
  1. S DIR("??")="ECDSS3^"
  1. D ^DIR K DIR I $D(DIRUT) G END
  1. S ECRTN=Y
  1. ACT ;list active cats (LISTA)
  1. INACT ;list inactive cats (LISTI)
  1. ALL ;list all cats (LISTB)
  1. W ! D PRINT W @IOF
  1. Q
  1. PRINT ;starts print for RPC
  1. I $G(ECPTYP)="E" D EXPORT,^ECKILL Q ;119
  1. I ECRTN="A" D LISTA
  1. I ECRTN="I" D LISTI
  1. I ECRTN="B" D LISTB
  1. END ; Kill variables and exit
  1. D ^ECKILL
  1. Q
  1. LISTA ;list active categories
  1. 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
  1. I $D(ECRAS) W !!,"Press <RET> to continue " R X:DTIME
  1. Q
  1. LISTI ;list inactive categories
  1. 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
  1. I $D(ECRAS) W !!,"Press <RET> to continue " R X:DTIME
  1. Q
  1. LISTB ;list all cats
  1. 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
  1. I $D(ECRAS) W !!,"Press <RET> to continue " R X:DTIME
  1. Q
  1. ;
  1. EXPORT ;Section added in patch 119
  1. N CNT,I,NM,NODE
  1. S CNT=1
  1. S ^TMP($J,"ECRPT",CNT)="NAME"_$S(ECRTN'="A":(U_"INACTIVE DATE"),1:"")
  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
  1. .S NODE=$G(^EC(726,I,0)) Q:NODE=""
  1. .I ECRTN="A" I $P(NODE,U,3)="" S CNT=CNT+1,^TMP($J,"ECRPT",CNT)=$P(NODE,U) Q
  1. .I ECRTN="B" S CNT=CNT+1,^TMP($J,"ECRPT",CNT)=$P(NODE,U)_U_$$FMTE^XLFDT($P(NODE,U,3)) Q
  1. .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))
  1. Q