ECDSSYN ;BIR/RHK,TTH,JPW-Edit Synonyms and Volume ;30 Apr 96
;;2.0; EVENT CAPTURE ;**1,4,5,33**;8 May 96
;This routine allows the user to edit the synonyms and volume
;associated with an Event Code Screens.
START ;Check Event Capture Locations.
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
W @IOF,!,"Procedure Synonym/Default Volume (Enter/Edit)",! F XX=0:1:79 W "-"
S (MSG1,MSG2)=0
LOC ;Allow user to select the availiable locations.
K ECL S NOTIOF=1 D ^ECL K NOTIOF G END:'$D(ECL)
I '$D(^ECJ("AP",ECL)) W !,"There are no event code screens set up for your selected location.",!,"Contact your program coordinator." K ECL D RETURN Q
UNIT ;Allow user to select DSS Unit.
D UNIT^ECDSUTIL G END:'$D(ECL)
W !
PRO ;Check Event Code Screens Procedures.
I $O(^ECJ("AP",ECL,ECD,ECC,""))="" W !,"There are no procedures set up for the selected unit and category.",!,"Please contact your Event Capture administrator." D RETURN G END
;Set Procedures in ^TMP array.
PROC1 K ^TMP("ECPRO",$J) S ECOUT=0 D PROS^ECHECK1
I '$O(^TMP("ECPRO",$J,0)) W !!,"There are no procedures available for the selected data." D RETURN S ECOUT=1 G END
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.
D MATCH G:$G(ECPROC) STUFF G:ECOUT END
I '$G(ECPROC) D LISTALL I $D(DUOUT)!($D(DTOUT)) S ECOUT=1
I $G(ECOUT)!('$G(ECDONE)) G END
;Allow user to edit synonym and volume fields.
STUFF K Y S (DA,ECFN)=$P(^TMP("ECPRO",$J,ECPROC),U,2)
S DIE=720.3
;ALB/ESD - Ask procedure reason indicator
S DR=$S($P(ECPCE,"~",2)="N":"",1:"55T;")_"53T;54T;56T"
D ^DIE I $D(Y) G END
;ALB/ESD - If proc reasons indictor is YES, ask procedure reasons
I $P($G(^ECJ(ECFN,"PRO")),"^",5)=1 D ADREAS^ECDSUTIL(ECFN)
;
;ALB/ESD - Always ask associated clinic and do active clinic check
;ALB/JAM - Only ask for associated clinic if DSS Unit sends data to PCE
I $P(ECPCE,"~",2)'="N" D CLIN
;Allow user to repeat process.
W ! K DIE,DR,ECFN,ECPROC,LOC,XX,ECHOICE,ECDONE G PROC1
END ;Kill existing variables and exit.
W @IOF
K ^TMP("ECPRO",$J),Y,ECANS,OK,ANS,ECR,RK D ^ECKILL
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 ANS["?" W !!,"This is a listing of all available, active procedures.",!,"Please enter the correct number corresponding to the desired procedure.",! D RETURN Q:$D(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.
F RK=$Y:1:(IOSL-6) W !
S DIR(0)="E" D ^DIR K DIR I $D(DUOUT)!($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"
W !,?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
CLIN ;check for active associated clinic
S MSG1=1,MSG2=0
S EC4=$P($G(^ECJ(+ECFN,"PRO")),"^",4) I EC4']"" S MSG2=1
D CLIN^ECPCEU
I 'ECPCL D
.W !!,"The clinic ",$S(MSG1:"associated with",1:"you selected for")," this event code screen ",$S(MSG2:"has not been entered",1:"is inactive"),"."
.W !,"Workload data cannot be sent to PCE for this event code screen with ",!,$S(MSG2:"a missing",1:"an inactive")," clinic."
.W !!,"Please use the Procedure Synonym/Default Volume (Enter/Edit) option to enter",!,"an active clinic.",!!
S (MSG1,MSG2)=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECDSSYN 5263 printed Dec 13, 2024@01:57:15 Page 2
ECDSSYN ;BIR/RHK,TTH,JPW-Edit Synonyms and Volume ;30 Apr 96
+1 ;;2.0; EVENT CAPTURE ;**1,4,5,33**;8 May 96
+2 ;This routine allows the user to edit the synonyms and volume
+3 ;associated with an Event Code Screens.
START ;Check Event Capture Locations.
+1 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
+2 WRITE @IOF,!,"Procedure Synonym/Default Volume (Enter/Edit)",!
FOR XX=0:1:79
WRITE "-"
+3 SET (MSG1,MSG2)=0
LOC ;Allow user to select the availiable locations.
+1 KILL ECL
SET NOTIOF=1
DO ^ECL
KILL NOTIOF
if '$DATA(ECL)
GOTO END
+2 IF '$DATA(^ECJ("AP",ECL))
WRITE !,"There are no event code screens set up for your selected location.",!,"Contact your program coordinator."
KILL ECL
DO RETURN
QUIT
UNIT ;Allow user to select DSS Unit.
+1 DO UNIT^ECDSUTIL
if '$DATA(ECL)
GOTO END
+2 WRITE !
PRO ;Check Event Code Screens Procedures.
+1 IF $ORDER(^ECJ("AP",ECL,ECD,ECC,""))=""
WRITE !,"There are no procedures set up for the selected unit and category.",!,"Please contact your Event Capture administrator."
DO RETURN
GOTO END
+2 ;Set Procedures in ^TMP array.
PROC1 KILL ^TMP("ECPRO",$JOB)
SET ECOUT=0
DO PROS^ECHECK1
+1 IF '$ORDER(^TMP("ECPRO",$JOB,0))
WRITE !!,"There are no procedures available for the selected data."
DO RETURN
SET ECOUT=1
GOTO END
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.
+7 DO MATCH
if $GET(ECPROC)
GOTO STUFF
if ECOUT
GOTO END
+8 IF '$GET(ECPROC)
DO LISTALL
IF $DATA(DUOUT)!($DATA(DTOUT))
SET ECOUT=1
+9 IF $GET(ECOUT)!('$GET(ECDONE))
GOTO END
+10 ;Allow user to edit synonym and volume fields.
STUFF KILL Y
SET (DA,ECFN)=$PIECE(^TMP("ECPRO",$JOB,ECPROC),U,2)
+1 SET DIE=720.3
+2 ;ALB/ESD - Ask procedure reason indicator
+3 SET DR=$SELECT($PIECE(ECPCE,"~",2)="N":"",1:"55T;")_"53T;54T;56T"
+4 DO ^DIE
IF $DATA(Y)
GOTO END
+5 ;ALB/ESD - If proc reasons indictor is YES, ask procedure reasons
+6 IF $PIECE($GET(^ECJ(ECFN,"PRO")),"^",5)=1
DO ADREAS^ECDSUTIL(ECFN)
+7 ;
+8 ;ALB/ESD - Always ask associated clinic and do active clinic check
+9 ;ALB/JAM - Only ask for associated clinic if DSS Unit sends data to PCE
+10 IF $PIECE(ECPCE,"~",2)'="N"
DO CLIN
+11 ;Allow user to repeat process.
+12 WRITE !
KILL DIE,DR,ECFN,ECPROC,LOC,XX,ECHOICE,ECDONE
GOTO PROC1
END ;Kill existing variables and exit.
+1 WRITE @IOF
+2 KILL ^TMP("ECPRO",$JOB),Y,ECANS,OK,ANS,ECR,RK
DO ^ECKILL
+3 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 ANS["?"
WRITE !!,"This is a listing of all available, active procedures.",!,"Please enter the correct number corresponding to the desired procedure.",!
DO RETURN
if $DATA(ECOUT)
QUIT
GOTO LISTALL
+8 IF ANS'?1.4N!'ANS
WRITE !!,"Select a single number corresponding to the procedure.",!
DO RETURN
if ECOUT
QUIT
GOTO LISTALL
+9 IF ('$DATA(^TMP("ECPRO",$JOB,+ANS)))
WRITE " **Invalid Number**",!
DO RETURN
if ECOUT
QUIT
GOTO LISTALL
+10 ;Answer selected.
IF $DATA(^TMP("ECPRO",$JOB,ANS))
SET ECPROC=ANS
SET ECDONE=1
+11 QUIT
RETURN ;Ask user to exit or continue.
+1 FOR RK=$Y:1:(IOSL-6)
WRITE !
+2 SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($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"
+3 WRITE !,?29,"< Enter ""??"" to List Procedures",!
+4 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
CLIN ;check for active associated clinic
+1 SET MSG1=1
SET MSG2=0
+2 SET EC4=$PIECE($GET(^ECJ(+ECFN,"PRO")),"^",4)
IF EC4']""
SET MSG2=1
+3 DO CLIN^ECPCEU
+4 IF 'ECPCL
Begin DoDot:1
+5 WRITE !!,"The clinic ",$SELECT(MSG1:"associated with",1:"you selected for")," this event code screen ",$SELECT(MSG2:"has not been entered",1:"is inactive"),"."
+6 WRITE !,"Workload data cannot be sent to PCE for this event code screen with ",!,$SELECT(MSG2:"a missing",1:"an inactive")," clinic."
+7 WRITE !!,"Please use the Procedure Synonym/Default Volume (Enter/Edit) option to enter",!,"an active clinic.",!!
End DoDot:1
+8 SET (MSG1,MSG2)=0
+9 QUIT
