ECDSINAC ;BIR/RHK,TTH,JPW-Inactivate Event Code Screen ;6 May 96
;;2.0; EVENT CAPTURE ;;8 May 96
;This routine allows the users to inactive or active procedures.
;in the Event Code Screen file.
I $O(^DIC(4,"LOC",""))="" W !,"You have no locations flagged for event capture.",!,"See your program coordinator.",!! W "Press <RET> to continue " R X:DTIME K X Q
UNIT ;Allow user to enter DSS Unit.
K DIRUT W @IOF,!,"Inactivate Event Code Screen",! F XX=0:1:79 W "-"
S NOTIOF=1 D ^ECL K NOTIOF G END:ECOUT!('$D(ECL))
K DIC S DIC=724,DIC(0)="QEAMZ",DIC("A")="Select DSS Unit: ",DIC("S")="I $D(^ECJ(""AP"",ECL,+Y))" D ^DIC K DIC G:Y<0 END S (ECC,ECD)=+Y,ECDN=$P(Y,U,2) I $P(^(0),U,11) S ECCT=1
I $D(ECCT) D G END:$G(ECOUT)=1
.I '$O(^ECJ("AP",ECL,ECD,"")) S ECC=0 W !,"Category: None" Q
.D CAT
I '$D(ECCT) S ECC=0 W !,"Category: None"
G PROC
CAT ;Display or allow user to select category.
S (CNT,ECC)=0
F ECCAT=0:0 S ECCAT=$O(^ECJ("AP",ECL,ECD,ECCAT)) Q:'ECCAT S ECC=ECCAT,CNT=CNT+1
I CNT'>1 S ECCN=$P(^EC(726,ECC,0),U) W !,"Category: ",ECCN Q
K Y S DIC=726,DIC(0)="AEQMZ",DIC("A")="Select Category: ",DIC("S")="I $D(^ECJ(""AP"",ECL,ECD,+Y))"
D ^DIC K DIC I Y<0 S ECOUT=1 Q
S ECC=+Y,ECCN=$P(Y,U,2)
Q
PROC ;Set Procedures in ^TMP array.
S ECC1=ECC ;**NOTE**If 'ECC in PROS^ECHECK1, ECC is set to null.
PROC1 K ^TMP("ECPRO",$J) S ECOUT=0,ECACTIV=1 D PROS^ECHECK1
PROC2 W !!,"Enter Procedure: " R XX:DTIME
I XX="^" K ^TMP("ECPRO",$J) S ECOUT=1
I XX="" S:$G(ECDONE) ECOUT=1
I XX="?" D HELP G PROC2
I XX="??" D LISTALL I $D(DUOUT)!($D(DTOUT)) S ECOUT=1
I ECOUT!('$D(XX)&('$G(ECDONE))) G END
;Match user selection to specific cross-references in ^TMP("ECPRO".
D MATCH G:$G(ECPROC) STUFF G:ECOUT END
I '$G(ECPROC) D LISTALL
I $G(ECOUT)!('$G(ECDONE)) G END
;
STUFF ;Inactive or active Event Code Screen.
S DA=$P(^TMP("ECPRO",$J,ECPROC),U,2),(ECDEL,ECYES)=0
I $P($G(^ECJ(DA,0)),"^",2),$P($G(^ECJ(DA,0)),"^",2)'>DT S ECYES=1
I $G(ECYES)=0 D G:Y=0 REPET I $D(DIRUT)!(Y<0) S ECOUT=1 G END
.K Y W ! S DIR(0)="Y",DIR("B")="YES",DIR("A")="Are you sure that you want to inactivate this procedure"
.D ^DIR
I $P($G(^ECJ(DA,0)),"^",2),$P($G(^ECJ(DA,0)),"^",2)'>DT D RETURN2 G:$D(DIRUT) END I ECDEL=0 D END0 G PROC2
S DIE=720.3 D D ^DIE K DIE,DR,DA
.I $G(ECDEL)=1 S DR="1////@" Q
.S DR="1///^S X=DT"
S PROC=$P(^TMP("ECPRO",$J,ECPROC),U,8)
S PROCNAM=$P(^TMP("ECPRO",$J,ECPROC),U,4)
S ECTEST(1)=ECL_"-"_ECD_"-"_ECC1_"-"_PROC
W !!,"Event Code Screen: ",ECTEST(1)
W !,"Procedure: ",PROCNAM," is now"_$S($G(ECDEL)=1:" ",1:" in")_"activated."
REPET D END1 G PROC2
Q
END ;Kill variables.
I $G(ECOUT)=1 K ^TMP("ECPRO",$J)
K ECC,ECL,ECD,ECC1,ECHOICE,ECR,ANS,ECOUT,ECPROS,OK
END0 K DIRUT,DTOUT,DUOUT,ECACTIV,ECCT,ECDEL,ECDONE,ECINAC,ECLN,ECP,ECPC,ECPCC,ECPN,ECPNN,ECPRIEN,ECPRO,ECHOICE,ECR
K ECPROF,ECPRONAM,ECPT,ECUCAT,ECUCATN,FROOT,RK,XX,Y
END1 K CNT,DA,DIC,DIE,DIR,DISYS,DR,ECCAT,ECCN,ECCT,ECDEL,ECDN,ECPROC,ECTEST,ECYES,LOC,PROC,PROCNAM,ECHOICE,ECR,ECDONE
Q
LISTALL ;Display the available procedures.
K ECR S ANS="" W @IOF,!!,"Available Procedures: ",!! D LABEL
S CNT=0 F XX=0:0 S XX=$O(^TMP("ECPRO",$J,XX)) Q:'XX!($D(ECHOICE)) D:($Y+5>IOSL) SPLIT Q:$D(ECHOICE)!($G(ECOUT)=1) G:$D(ECR) LISTALL I ANS="" D
.S CNT=CNT+1 W !,$E(XX,1,4),?7,$E($P(^TMP("ECPRO",$J,XX),U,3),1,32),?41,$E($P(^TMP("ECPRO",$J,XX),U,4),1,30),?73,$P(^TMP("ECPRO",$J,XX),U,5)
Q:$D(ECHOICE)!($D(ECDONE))!($G(ECOUT)=1)
W !!,"Select Number (1-"_CNT_"): " R ANS:DTIME
I ANS="^"!('$T)!(ANS="") K ^TMP("ECPRO",$J) S ECOUT=1 Q
I $D(^TMP("ECPRO",$J,+ANS)) S ECOUT=0
I ANS["?" W !!,"This is a listing of all available, active procedures.",!,"Please enter the correct number corresponding to the desired procedure.",! D RETURN Q:ECOUT G LISTALL
I ANS'?1.4N!'ANS W !!,"Select a single number corresponding to the procedure.",! D RETURN Q:ECOUT G LISTALL
I '$D(^TMP("ECPRO",$J,+ANS)) W " **Invalid Number**",! D RETURN Q:ECOUT G LISTALL
I $D(^TMP("ECPRO",$J,+ANS)) S ECPROC=+ANS,ECDONE=1 ;Answer selected.
Q
RETURN ;Ask user to exit or continue.
W ! S DIR(0)="E" D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S ECOUT=1
Q
RETURN2 ;Ask user to activate procedures.
W !!,"The Event Code Screen for this procedure has a status of inactive."
S DIR(0)="Y",DIR("A")="However, would you like to activate it",DIR("B")="NO" D ^DIR S ECDEL=+Y I $D(DUOUT)!($D(DIRUT))!($D(DTOUT)) S ECOUT=1
Q
MATCH ;Check ^TMP cross-references.
I XX="" S ECOUT=1 Q
I $O(^TMP("ECPRO",$J,"B",XX,0)) S ECPROC=+$O(^TMP("ECPRO",$J,"B",XX,0))
I $O(^TMP("ECPRO",$J,"N",XX,0)) S ECPROC=+$O(^TMP("ECPRO",$J,"N",XX,0))
I $O(^TMP("ECPRO",$J,"SYN",XX,0)) S ECPROC=+$O(^TMP("ECPRO",$J,"SYN",XX,0))
Q
LABEL W !,"Num",?7,"Synonym",?41,"Procedure Name",?73,"Nat ID",!
W "---",?7,"-------",?41,"--------------",?73,"------",!
Q
HELP ;Display user options.
W !!,"Enter one of the following: < Procedure Name",!,?29,"< Procedure Number"
W !,?29,"< Procedure Synonym",!,?29,"< Enter ""??"" to List Procedures",!
Q
SPLIT ;
W !!,"Select Number, or press <RET> to continue listing : " R ANS:DTIME
I '$T!(ANS="^") S (ECOUT,ECHOICE)=1 Q
I ANS="" W @IOF D LABEL Q
I ANS["?" W !!,"Please enter the correct number corresponding to the desired procedure.",! D RETURN S ECR=1 Q
I ANS'?1.4N!'ANS W !!,"Select a single number corresponding to the procedure.",! D RETURN S ECR=1 Q
I '$D(^TMP("ECPRO",$J,+ANS)) W " ** Invalid Number **" D RETURN S ECR=1 Q
I $D(^TMP("ECPRO",$J,+ANS)) S ECPROC=+ANS,(ECDONE,ECHOICE)=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECDSINAC 5578 printed Apr 09, 2024@21:01:51 Page 2
ECDSINAC ;BIR/RHK,TTH,JPW-Inactivate Event Code Screen ;6 May 96
+1 ;;2.0; EVENT CAPTURE ;;8 May 96
+2 ;This routine allows the users to inactive or active procedures.
+3 ;in the Event Code Screen file.
+4 IF $ORDER(^DIC(4,"LOC",""))=""
WRITE !,"You have no locations flagged for event capture.",!,"See your program coordinator.",!!
WRITE "Press <RET> to continue "
READ X:DTIME
KILL X
QUIT
UNIT ;Allow user to enter DSS Unit.
+1 KILL DIRUT
WRITE @IOF,!,"Inactivate Event Code Screen",!
FOR XX=0:1:79
WRITE "-"
+2 SET NOTIOF=1
DO ^ECL
KILL NOTIOF
if ECOUT!('$DATA(ECL))
GOTO END
+3 KILL DIC
SET DIC=724
SET DIC(0)="QEAMZ"
SET DIC("A")="Select DSS Unit: "
SET DIC("S")="I $D(^ECJ(""AP"",ECL,+Y))"
DO ^DIC
KILL DIC
if Y<0
GOTO END
SET (ECC,ECD)=+Y
SET ECDN=$PIECE(Y,U,2)
IF $PIECE(^(0),U,11)
SET ECCT=1
+4 IF $DATA(ECCT)
Begin DoDot:1
+5 IF '$ORDER(^ECJ("AP",ECL,ECD,""))
SET ECC=0
WRITE !,"Category: None"
QUIT
+6 DO CAT
End DoDot:1
if $GET(ECOUT)=1
GOTO END
+7 IF '$DATA(ECCT)
SET ECC=0
WRITE !,"Category: None"
+8 GOTO PROC
CAT ;Display or allow user to select category.
+1 SET (CNT,ECC)=0
+2 FOR ECCAT=0:0
SET ECCAT=$ORDER(^ECJ("AP",ECL,ECD,ECCAT))
if 'ECCAT
QUIT
SET ECC=ECCAT
SET CNT=CNT+1
+3 IF CNT'>1
SET ECCN=$PIECE(^EC(726,ECC,0),U)
WRITE !,"Category: ",ECCN
QUIT
+4 KILL Y
SET DIC=726
SET DIC(0)="AEQMZ"
SET DIC("A")="Select Category: "
SET DIC("S")="I $D(^ECJ(""AP"",ECL,ECD,+Y))"
+5 DO ^DIC
KILL DIC
IF Y<0
SET ECOUT=1
QUIT
+6 SET ECC=+Y
SET ECCN=$PIECE(Y,U,2)
+7 QUIT
PROC ;Set Procedures in ^TMP array.
+1 ;**NOTE**If 'ECC in PROS^ECHECK1, ECC is set to null.
SET ECC1=ECC
PROC1 KILL ^TMP("ECPRO",$JOB)
SET ECOUT=0
SET ECACTIV=1
DO PROS^ECHECK1
PROC2 WRITE !!,"Enter Procedure: "
READ XX:DTIME
+1 IF XX="^"
KILL ^TMP("ECPRO",$JOB)
SET ECOUT=1
+2 IF XX=""
if $GET(ECDONE)
SET ECOUT=1
+3 IF XX="?"
DO HELP
GOTO PROC2
+4 IF XX="??"
DO LISTALL
IF $DATA(DUOUT)!($DATA(DTOUT))
SET ECOUT=1
+5 IF ECOUT!('$DATA(XX)&('$GET(ECDONE)))
GOTO END
+6 ;Match user selection to specific cross-references in ^TMP("ECPRO".
+7 DO MATCH
if $GET(ECPROC)
GOTO STUFF
if ECOUT
GOTO END
+8 IF '$GET(ECPROC)
DO LISTALL
+9 IF $GET(ECOUT)!('$GET(ECDONE))
GOTO END
+10 ;
STUFF ;Inactive or active Event Code Screen.
+1 SET DA=$PIECE(^TMP("ECPRO",$JOB,ECPROC),U,2)
SET (ECDEL,ECYES)=0
+2 IF $PIECE($GET(^ECJ(DA,0)),"^",2)
IF $PIECE($GET(^ECJ(DA,0)),"^",2)'>DT
SET ECYES=1
+3 IF $GET(ECYES)=0
Begin DoDot:1
+4 KILL Y
WRITE !
SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Are you sure that you want to inactivate this procedure"
+5 DO ^DIR
End DoDot:1
if Y=0
GOTO REPET
IF $DATA(DIRUT)!(Y<0)
SET ECOUT=1
GOTO END
+6 IF $PIECE($GET(^ECJ(DA,0)),"^",2)
IF $PIECE($GET(^ECJ(DA,0)),"^",2)'>DT
DO RETURN2
if $DATA(DIRUT)
GOTO END
IF ECDEL=0
DO END0
GOTO PROC2
+7 SET DIE=720.3
Begin DoDot:1
+8 IF $GET(ECDEL)=1
SET DR="1////@"
QUIT
+9 SET DR="1///^S X=DT"
End DoDot:1
DO ^DIE
KILL DIE,DR,DA
+10 SET PROC=$PIECE(^TMP("ECPRO",$JOB,ECPROC),U,8)
+11 SET PROCNAM=$PIECE(^TMP("ECPRO",$JOB,ECPROC),U,4)
+12 SET ECTEST(1)=ECL_"-"_ECD_"-"_ECC1_"-"_PROC
+13 WRITE !!,"Event Code Screen: ",ECTEST(1)
+14 WRITE !,"Procedure: ",PROCNAM," is now"_$SELECT($GET(ECDEL)=1:" ",1:" in")_"activated."
REPET DO END1
GOTO PROC2
+1 QUIT
END ;Kill variables.
+1 IF $GET(ECOUT)=1
KILL ^TMP("ECPRO",$JOB)
+2 KILL ECC,ECL,ECD,ECC1,ECHOICE,ECR,ANS,ECOUT,ECPROS,OK
END0 KILL DIRUT,DTOUT,DUOUT,ECACTIV,ECCT,ECDEL,ECDONE,ECINAC,ECLN,ECP,ECPC,ECPCC,ECPN,ECPNN,ECPRIEN,ECPRO,ECHOICE,ECR
+1 KILL ECPROF,ECPRONAM,ECPT,ECUCAT,ECUCATN,FROOT,RK,XX,Y
END1 KILL CNT,DA,DIC,DIE,DIR,DISYS,DR,ECCAT,ECCN,ECCT,ECDEL,ECDN,ECPROC,ECTEST,ECYES,LOC,PROC,PROCNAM,ECHOICE,ECR,ECDONE
+1 QUIT
LISTALL ;Display the available procedures.
+1 KILL ECR
SET ANS=""
WRITE @IOF,!!,"Available Procedures: ",!!
DO LABEL
+2 SET CNT=0
FOR XX=0:0
SET XX=$ORDER(^TMP("ECPRO",$JOB,XX))
if 'XX!($DATA(ECHOICE))
QUIT
if ($Y+5>IOSL)
DO SPLIT
if $DATA(ECHOICE)!($GET(ECOUT)=1)
QUIT
if $DATA(ECR)
GOTO LISTALL
IF ANS=""
Begin DoDot:1
+3 SET CNT=CNT+1
WRITE !,$EXTRACT(XX,1,4),?7,$EXTRACT($PIECE(^TMP("ECPRO",$JOB,XX),U,3),1,32),?41,$EXTRACT($PIECE(^TMP("ECPRO",$JOB,XX),U,4),1,30),?73,$PIECE(^TMP("ECPRO",$JOB,XX),U,5)
End DoDot:1
+4 if $DATA(ECHOICE)!($DATA(ECDONE))!($GET(ECOUT)=1)
QUIT
+5 WRITE !!,"Select Number (1-"_CNT_"): "
READ ANS:DTIME
+6 IF ANS="^"!('$TEST)!(ANS="")
KILL ^TMP("ECPRO",$JOB)
SET ECOUT=1
QUIT
+7 IF $DATA(^TMP("ECPRO",$JOB,+ANS))
SET ECOUT=0
+8 IF ANS["?"
WRITE !!,"This is a listing of all available, active procedures.",!,"Please enter the correct number corresponding to the desired procedure.",!
DO RETURN
if ECOUT
QUIT
GOTO LISTALL
+9 IF ANS'?1.4N!'ANS
WRITE !!,"Select a single number corresponding to the procedure.",!
DO RETURN
if ECOUT
QUIT
GOTO LISTALL
+10 IF '$DATA(^TMP("ECPRO",$JOB,+ANS))
WRITE " **Invalid Number**",!
DO RETURN
if ECOUT
QUIT
GOTO LISTALL
+11 ;Answer selected.
IF $DATA(^TMP("ECPRO",$JOB,+ANS))
SET ECPROC=+ANS
SET ECDONE=1
+12 QUIT
RETURN ;Ask user to exit or continue.
+1 WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
SET ECOUT=1
+2 QUIT
RETURN2 ;Ask user to activate procedures.
+1 WRITE !!,"The Event Code Screen for this procedure has a status of inactive."
+2 SET DIR(0)="Y"
SET DIR("A")="However, would you like to activate it"
SET DIR("B")="NO"
DO ^DIR
SET ECDEL=+Y
IF $DATA(DUOUT)!($DATA(DIRUT))!($DATA(DTOUT))
SET ECOUT=1
+3 QUIT
MATCH ;Check ^TMP cross-references.
+1 IF XX=""
SET ECOUT=1
QUIT
+2 IF $ORDER(^TMP("ECPRO",$JOB,"B",XX,0))
SET ECPROC=+$ORDER(^TMP("ECPRO",$JOB,"B",XX,0))
+3 IF $ORDER(^TMP("ECPRO",$JOB,"N",XX,0))
SET ECPROC=+$ORDER(^TMP("ECPRO",$JOB,"N",XX,0))
+4 IF $ORDER(^TMP("ECPRO",$JOB,"SYN",XX,0))
SET ECPROC=+$ORDER(^TMP("ECPRO",$JOB,"SYN",XX,0))
+5 QUIT
LABEL WRITE !,"Num",?7,"Synonym",?41,"Procedure Name",?73,"Nat ID",!
+1 WRITE "---",?7,"-------",?41,"--------------",?73,"------",!
+2 QUIT
HELP ;Display user options.
+1 WRITE !!,"Enter one of the following: < Procedure Name",!,?29,"< Procedure Number"
+2 WRITE !,?29,"< Procedure Synonym",!,?29,"< Enter ""??"" to List Procedures",!
+3 QUIT
SPLIT ;
+1 WRITE !!,"Select Number, or press <RET> to continue listing : "
READ ANS:DTIME
+2 IF '$TEST!(ANS="^")
SET (ECOUT,ECHOICE)=1
QUIT
+3 IF ANS=""
WRITE @IOF
DO LABEL
QUIT
+4 IF ANS["?"
WRITE !!,"Please enter the correct number corresponding to the desired procedure.",!
DO RETURN
SET ECR=1
QUIT
+5 IF ANS'?1.4N!'ANS
WRITE !!,"Select a single number corresponding to the procedure.",!
DO RETURN
SET ECR=1
QUIT
+6 IF '$DATA(^TMP("ECPRO",$JOB,+ANS))
WRITE " ** Invalid Number **"
DO RETURN
SET ECR=1
QUIT
+7 IF $DATA(^TMP("ECPRO",$JOB,+ANS))
SET ECPROC=+ANS
SET (ECDONE,ECHOICE)=1
+8 QUIT
