ECSECT ;BIR/MAM,JPW-Create DSS Units for Event Capture ;1 May 96
;;2.0; EVENT CAPTURE ;**4,5**;8 May 96
;
SECT ;entry
S (MSG1,MSG2)=0
W @IOF,!,"Enter/Edit DSS Units for Event Capture"
W !!,?5,"If you elect to send data to PCE for DSS Unit, you must answer the",!,?5,"""Send to PCE"" prompt."
W !! K DA,DIC S (ECOUT,ECJLP)=0,DIC=724,DLAYGO=724
S DIC("S")="I $P(^(0),""^"",8)=1",DIC(0)="QEAMZL",DIC("DR")="1T;3T;2T",DIC("A")="Select DSS Unit: " D ^DIC S DIE=DIC K DIC,DLAYGO I Y<0 G END
S ECDA=+Y D CHK I ECFLG W !!,"Cateories are "_$S($P($G(^ECD(+ECDA,0)),"^",11):"used",1:"not used")_" to group procedures. You have event codes screens defined",!,"and cannot change the use of categories.",!
I $P(Y,"^",3) K DR,DA S DA=ECDA,DR=$S(ECFLG:"4T;7///1;11T;12T;13T",1:"4T;7///1;10T;11T;12T;13T") D ^DIE K DIE,DA,DR D SCCHK(ECDA) G:$D(Y) END G:$D(DTOUT) END D MSG G SECT
D DIE G SECT
END ;D ^ECKILL W @IOF
Q
REACT ; reactivate DSS Unit
W !!,"This DSS Unit has been inactivated.",!!,"Would you like to reactivate it ? YES// " R ECYN:DTIME I '$T!(ECYN="^") S ECOUT=1 Q
S ECYN=$E(ECYN) S:ECYN="" ECYN="Y" I "YyNn"'[ECYN W !!,"Enter <RET> to make this DSS Unit valid for use in the Event Capture",!,"software, or NO if this DSS Unit should remain inactive." G REACT
I "Nn"[ECYN S ECOUT=1 Q
K DIE,DR,DA S DIE=724,DR="5///0",DA=ECDA D ^DIE K DIE,DR,DA
Q
DIE ; enter DSS Unit info
S MSG1=1
I $P($G(^ECD(ECDA,0)),"^",13)']"" S MSG2=1
I $P(^ECD(ECDA,0),"^",6) D REACT I ECOUT Q
K DIE,DR,DA
S DA=ECDA,DIE=724,DLAYGO=724,DR=$S(ECFLG:".01T;1T;3T;2T;4T;7///1;11T;13T",1:".01T;1T;3T;2T;4T;7///1;10T;11T;13T")
D ^DIE
K DR,DIE,DLAYGO,DA
;
D SCCHK(ECDA) ;* Check to prompt for Associated Stop Code
;
;* If sending to PCE, remove Associated Stop Code
I $P(^ECD(ECDA,0),"^",14)'="",($P(^ECD(ECDA,0),"^",14)'="N") DO
.S DA=ECDA,DIE=724,DR="9////@"
.D ^DIE
K ECDA,DA,DR,DIE
MSG W !!,"Press <RET> to continue " R X:DTIME
Q
CHK ;loop thru screens
S ECFLG=0
S JJ=0 F S JJ=$O(^ECJ("AP",JJ)) Q:'JJ!(ECFLG) I $D(^ECJ("AP",JJ,ECDA)) S ECFLG=1
Q
;
SCCHK(ECDA) ;** Check to see if sending to PCE
I $P(^ECD(ECDA,0),"^",14)=""!($P(^ECD(ECDA,0),"^",14)="N") DO
.S DA=ECDA,DIE=724,DR="9T"
.D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECSECT 2249 printed Nov 22, 2024@17:09:01 Page 2
ECSECT ;BIR/MAM,JPW-Create DSS Units for Event Capture ;1 May 96
+1 ;;2.0; EVENT CAPTURE ;**4,5**;8 May 96
+2 ;
SECT ;entry
+1 SET (MSG1,MSG2)=0
+2 WRITE @IOF,!,"Enter/Edit DSS Units for Event Capture"
+3 WRITE !!,?5,"If you elect to send data to PCE for DSS Unit, you must answer the",!,?5,"""Send to PCE"" prompt."
+4 WRITE !!
KILL DA,DIC
SET (ECOUT,ECJLP)=0
SET DIC=724
SET DLAYGO=724
+5 SET DIC("S")="I $P(^(0),""^"",8)=1"
SET DIC(0)="QEAMZL"
SET DIC("DR")="1T;3T;2T"
SET DIC("A")="Select DSS Unit: "
DO ^DIC
SET DIE=DIC
KILL DIC,DLAYGO
IF Y<0
GOTO END
+6 SET ECDA=+Y
DO CHK
IF ECFLG
WRITE !!,"Cateories are "_$SELECT($PIECE($GET(^ECD(+ECDA,0)),"^",11):"used",1:"not used")_" to group procedures. You have event codes screens defined",!,"and cannot change the use of categories.",!
+7 IF $PIECE(Y,"^",3)
KILL DR,DA
SET DA=ECDA
SET DR=$SELECT(ECFLG:"4T;7///1;11T;12T;13T",1:"4T;7///1;10T;11T;12T;13T")
DO ^DIE
KILL DIE,DA,DR
DO SCCHK(ECDA)
if $DATA(Y)
GOTO END
if $DATA(DTOUT)
GOTO END
DO MSG
GOTO SECT
+8 DO DIE
GOTO SECT
END ;D ^ECKILL W @IOF
+1 QUIT
REACT ; reactivate DSS Unit
+1 WRITE !!,"This DSS Unit has been inactivated.",!!,"Would you like to reactivate it ? YES// "
READ ECYN:DTIME
IF '$TEST!(ECYN="^")
SET ECOUT=1
QUIT
+2 SET ECYN=$EXTRACT(ECYN)
if ECYN=""
SET ECYN="Y"
IF "YyNn"'[ECYN
WRITE !!,"Enter <RET> to make this DSS Unit valid for use in the Event Capture",!,"software, or NO if this DSS Unit should remain inactive."
GOTO REACT
+3 IF "Nn"[ECYN
SET ECOUT=1
QUIT
+4 KILL DIE,DR,DA
SET DIE=724
SET DR="5///0"
SET DA=ECDA
DO ^DIE
KILL DIE,DR,DA
+5 QUIT
DIE ; enter DSS Unit info
+1 SET MSG1=1
+2 IF $PIECE($GET(^ECD(ECDA,0)),"^",13)']""
SET MSG2=1
+3 IF $PIECE(^ECD(ECDA,0),"^",6)
DO REACT
IF ECOUT
QUIT
+4 KILL DIE,DR,DA
+5 SET DA=ECDA
SET DIE=724
SET DLAYGO=724
SET DR=$SELECT(ECFLG:".01T;1T;3T;2T;4T;7///1;11T;13T",1:".01T;1T;3T;2T;4T;7///1;10T;11T;13T")
+6 DO ^DIE
+7 KILL DR,DIE,DLAYGO,DA
+8 ;
+9 ;* Check to prompt for Associated Stop Code
DO SCCHK(ECDA)
+10 ;
+11 ;* If sending to PCE, remove Associated Stop Code
+12 IF $PIECE(^ECD(ECDA,0),"^",14)'=""
IF ($PIECE(^ECD(ECDA,0),"^",14)'="N")
Begin DoDot:1
+13 SET DA=ECDA
SET DIE=724
SET DR="9////@"
+14 DO ^DIE
End DoDot:1
+15 KILL ECDA,DA,DR,DIE
MSG WRITE !!,"Press <RET> to continue "
READ X:DTIME
+1 QUIT
CHK ;loop thru screens
+1 SET ECFLG=0
+2 SET JJ=0
FOR
SET JJ=$ORDER(^ECJ("AP",JJ))
if 'JJ!(ECFLG)
QUIT
IF $DATA(^ECJ("AP",JJ,ECDA))
SET ECFLG=1
+3 QUIT
+4 ;
SCCHK(ECDA) ;** Check to see if sending to PCE
+1 IF $PIECE(^ECD(ECDA,0),"^",14)=""!($PIECE(^ECD(ECDA,0),"^",14)="N")
Begin DoDot:1
+2 SET DA=ECDA
SET DIE=724
SET DR="9T"
+3 DO ^DIE
End DoDot:1
+4 QUIT
