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

ECDSS2.m

Go to the documentation of this file.
  1. ECDSS2 ;BIR/RHK,JPW-Local Category Routine ;1 May 96
  1. ;;2.0; EVENT CAPTURE ;**1**;8 May 96
  1. EDITC ; Create/Edit local categories
  1. W @IOF,!,"Enter/Edit Local Categories",!
  1. K DA,DIC,DIE,DLAYGO,DR
  1. F W ! S DIC=726,DIC(0)="AEQLMZ",DIC("A")="Select Category: ",DLAYGO=726 D ^DIC K DIC,DLAYGO Q:Y<0 D
  1. .S DA=+Y I $P(Y,"^",3) S $P(^EC(726,DA,0),"^",2)=$G(DT)
  1. .S DIE=726,DR=".01T" D ^DIE K DA,DIE,DR
  1. G END
  1. SETDEAC ; Set inactivation date for local categories
  1. W @IOF,!,"Inactivate Categories",!
  1. K DA,DIC,DIE,DLAYGO,DR S ECOUT=0
  1. F S DIC="^EC(726,",DIC(0)="AEQMZ",DIC("A")="Select Category: " D ^DIC K DIC Q:Y<0 D Q:ECOUT
  1. .S ECC=+Y,ECCN=$P(Y,"^",2),(ECJLP,ECOUT)=0
  1. .I $P($G(^EC(726,ECC,0)),"^",3)]"" D Q:$D(DUOUT)!($D(DTOUT)) Q:ECJLP
  1. ..W !!,ECCN," is currently inactive."
  1. ..S DIR(0)="Y",DIR("A")="Do you wish to reactivate",DIR("B")="YES"
  1. ..S DIR("?")="Enter YES to reactivate this category or NO to leave inactive."
  1. ..D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S ECOUT=1 Q
  1. ..I Y>0 S DIE=726,DA=ECC,DR="2///@" D ^DIE K DA,DIE,DR W !,ECCN," has been reactivated for use.",!! S ECJLP=1 Q
  1. ..I 'Y W !,ECCN," remains inactive.",!! S ECJLP=1 Q
  1. .S DIR(0)="Y",DIR("A")="Do you wish to inactivate",DIR("B")="YES"
  1. .S DIR("?")="Enter YES to inactivate this category or NO to leave active."
  1. .D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S ECOUT=1 Q
  1. .I Y>0 S DIE=726,DA=ECC,DR="2///TODAY" D ^DIE K DA,DIE,DR W !,ECCN," has been inactivated.",!!
  1. .K DA,DIC,DIE,DR,DTOUT,DUOUT,ECC,ECCN
  1. END ;kill variables and exit
  1. D ^ECKILL
  1. Q