97 lines
5.0 KiB
Mathematica
97 lines
5.0 KiB
Mathematica
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
|