ECDSS2 ;BIR/RHK,JPW-Local Category Routine ;1 May 96
;;2.0; EVENT CAPTURE ;**1**;8 May 96
EDITC ; Create/Edit local categories
W @IOF,!,"Enter/Edit Local Categories",!
K DA,DIC,DIE,DLAYGO,DR
F W ! S DIC=726,DIC(0)="AEQLMZ",DIC("A")="Select Category: ",DLAYGO=726 D ^DIC K DIC,DLAYGO Q:Y<0 D
.S DA=+Y I $P(Y,"^",3) S $P(^EC(726,DA,0),"^",2)=$G(DT)
.S DIE=726,DR=".01T" D ^DIE K DA,DIE,DR
G END
SETDEAC ; Set inactivation date for local categories
W @IOF,!,"Inactivate Categories",!
K DA,DIC,DIE,DLAYGO,DR S ECOUT=0
F S DIC="^EC(726,",DIC(0)="AEQMZ",DIC("A")="Select Category: " D ^DIC K DIC Q:Y<0 D Q:ECOUT
.S ECC=+Y,ECCN=$P(Y,"^",2),(ECJLP,ECOUT)=0
.I $P($G(^EC(726,ECC,0)),"^",3)]"" D Q:$D(DUOUT)!($D(DTOUT)) Q:ECJLP
..W !!,ECCN," is currently inactive."
..S DIR(0)="Y",DIR("A")="Do you wish to reactivate",DIR("B")="YES"
..S DIR("?")="Enter YES to reactivate this category or NO to leave inactive."
..D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S ECOUT=1 Q
..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
..I 'Y W !,ECCN," remains inactive.",!! S ECJLP=1 Q
.S DIR(0)="Y",DIR("A")="Do you wish to inactivate",DIR("B")="YES"
.S DIR("?")="Enter YES to inactivate this category or NO to leave active."
.D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S ECOUT=1 Q
.I Y>0 S DIE=726,DA=ECC,DR="2///TODAY" D ^DIE K DA,DIE,DR W !,ECCN," has been inactivated.",!!
.K DA,DIC,DIE,DR,DTOUT,DUOUT,ECC,ECCN
END ;kill variables and exit
D ^ECKILL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECDSS2 1542 printed Dec 13, 2024@01:57:10 Page 2
ECDSS2 ;BIR/RHK,JPW-Local Category Routine ;1 May 96
+1 ;;2.0; EVENT CAPTURE ;**1**;8 May 96
EDITC ; Create/Edit local categories
+1 WRITE @IOF,!,"Enter/Edit Local Categories",!
+2 KILL DA,DIC,DIE,DLAYGO,DR
+3 FOR
WRITE !
SET DIC=726
SET DIC(0)="AEQLMZ"
SET DIC("A")="Select Category: "
SET DLAYGO=726
DO ^DIC
KILL DIC,DLAYGO
if Y<0
QUIT
Begin DoDot:1
+4 SET DA=+Y
IF $PIECE(Y,"^",3)
SET $PIECE(^EC(726,DA,0),"^",2)=$GET(DT)
+5 SET DIE=726
SET DR=".01T"
DO ^DIE
KILL DA,DIE,DR
End DoDot:1
+6 GOTO END
SETDEAC ; Set inactivation date for local categories
+1 WRITE @IOF,!,"Inactivate Categories",!
+2 KILL DA,DIC,DIE,DLAYGO,DR
SET ECOUT=0
+3 FOR
SET DIC="^EC(726,"
SET DIC(0)="AEQMZ"
SET DIC("A")="Select Category: "
DO ^DIC
KILL DIC
if Y<0
QUIT
Begin DoDot:1
+4 SET ECC=+Y
SET ECCN=$PIECE(Y,"^",2)
SET (ECJLP,ECOUT)=0
+5 IF $PIECE($GET(^EC(726,ECC,0)),"^",3)]""
Begin DoDot:2
+6 WRITE !!,ECCN," is currently inactive."
+7 SET DIR(0)="Y"
SET DIR("A")="Do you wish to reactivate"
SET DIR("B")="YES"
+8 SET DIR("?")="Enter YES to reactivate this category or NO to leave inactive."
+9 DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
SET ECOUT=1
QUIT
+10 IF Y>0
SET DIE=726
SET DA=ECC
SET DR="2///@"
DO ^DIE
KILL DA,DIE,DR
WRITE !,ECCN," has been reactivated for use.",!!
SET ECJLP=1
QUIT
+11 IF 'Y
WRITE !,ECCN," remains inactive.",!!
SET ECJLP=1
QUIT
End DoDot:2
if $DATA(DUOUT)!($DATA(DTOUT))
QUIT
if ECJLP
QUIT
+12 SET DIR(0)="Y"
SET DIR("A")="Do you wish to inactivate"
SET DIR("B")="YES"
+13 SET DIR("?")="Enter YES to inactivate this category or NO to leave active."
+14 DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
SET ECOUT=1
QUIT
+15 IF Y>0
SET DIE=726
SET DA=ECC
SET DR="2///TODAY"
DO ^DIE
KILL DA,DIE,DR
WRITE !,ECCN," has been inactivated.",!!
+16 KILL DA,DIC,DIE,DR,DTOUT,DUOUT,ECC,ECCN
End DoDot:1
if ECOUT
QUIT
END ;kill variables and exit
+1 DO ^ECKILL
+2 QUIT
