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