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