ECDSINAC.m

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 ---ECDSINAC   5578     printed  Mar 13, 2025@21:01:45                                                                                                                                                                                                    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