source: FOIAVistA/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECDSSYN.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1ECDSSYN ;BIR/RHK,TTH,JPW-Edit Synonyms and Volume ;30 Apr 96
2 ;;2.0; EVENT CAPTURE ;**1,4,5,33**;8 May 96
3 ;This routine allows the user to edit the synonyms and volume
4 ;associated with an Event Code Screens.
5START ;Check Event Capture Locations.
6 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
7 W @IOF,!,"Procedure Synonym/Default Volume (Enter/Edit)",! F XX=0:1:79 W "-"
8 S (MSG1,MSG2)=0
9LOC ;Allow user to select the availiable locations.
10 K ECL S NOTIOF=1 D ^ECL K NOTIOF G END:'$D(ECL)
11 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
12UNIT ;Allow user to select DSS Unit.
13 D UNIT^ECDSUTIL G END:'$D(ECL)
14 W !
15PRO ;Check Event Code Screens Procedures.
16 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
17 ;Set Procedures in ^TMP array.
18PROC1 K ^TMP("ECPRO",$J) S ECOUT=0 D PROS^ECHECK1
19 I '$O(^TMP("ECPRO",$J,0)) W !!,"There are no procedures available for the selected data." D RETURN S ECOUT=1 G END
20PROC2 W !,"Enter Procedure: " R XX:DTIME
21 I XX="^" K ^TMP("ECPRO",$J) S ECOUT=1
22 I XX="" S:$G(ECDONE) ECOUT=1
23 I XX="?" D HELP G PROC2
24 I XX="??" D LISTALL I $D(DUOUT)!($D(DTOUT)) S ECOUT=1
25 I ECOUT!('$D(XX)&('$G(ECDONE))) G END
26 ;Match user selection to specific cross-references.
27 D MATCH G:$G(ECPROC) STUFF G:ECOUT END
28 I '$G(ECPROC) D LISTALL I $D(DUOUT)!($D(DTOUT)) S ECOUT=1
29 I $G(ECOUT)!('$G(ECDONE)) G END
30 ;Allow user to edit synonym and volume fields.
31STUFF K Y S (DA,ECFN)=$P(^TMP("ECPRO",$J,ECPROC),U,2)
32 S DIE=720.3
33 ;ALB/ESD - Ask procedure reason indicator
34 S DR=$S($P(ECPCE,"~",2)="N":"",1:"55T;")_"53T;54T;56T"
35 D ^DIE I $D(Y) G END
36 ;ALB/ESD - If proc reasons indictor is YES, ask procedure reasons
37 I $P($G(^ECJ(ECFN,"PRO")),"^",5)=1 D ADREAS^ECDSUTIL(ECFN)
38 ;
39 ;ALB/ESD - Always ask associated clinic and do active clinic check
40 ;ALB/JAM - Only ask for associated clinic if DSS Unit sends data to PCE
41 I $P(ECPCE,"~",2)'="N" D CLIN
42 ;Allow user to repeat process.
43 W ! K DIE,DR,ECFN,ECPROC,LOC,XX,ECHOICE,ECDONE G PROC1
44END ;Kill existing variables and exit.
45 W @IOF
46 K ^TMP("ECPRO",$J),Y,ECANS,OK,ANS,ECR,RK D ^ECKILL
47 Q
48LISTALL ;Display the available procedures.
49 K ECR S ANS="" W @IOF,!!,"Available Procedures: ",!! D LABEL
50 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
51 .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)
52 Q:$D(ECHOICE)!($D(ECDONE))!($G(ECOUT)=1)
53 W !!,"Select Number (1-"_CNT_"): " R ANS:DTIME
54 I ANS="^"!('$T)!(ANS="") K ^TMP("ECPRO",$J) S ECOUT=1 Q
55 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
56 I ANS'?1.4N!'ANS W !!,"Select a single number corresponding to the procedure.",! D RETURN Q:ECOUT G LISTALL
57 I ('$D(^TMP("ECPRO",$J,+ANS))) W " **Invalid Number**",! D RETURN Q:ECOUT G LISTALL
58 I $D(^TMP("ECPRO",$J,ANS)) S ECPROC=ANS,ECDONE=1 ;Answer selected.
59 Q
60RETURN ;Ask user to exit or continue.
61 F RK=$Y:1:(IOSL-6) W !
62 S DIR(0)="E" D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S ECOUT=1
63 Q
64MATCH ;Check ^TMP cross-references.
65 I XX="" S ECOUT=1 Q
66 I $O(^TMP("ECPRO",$J,"B",XX,0)) S ECPROC=+$O(^TMP("ECPRO",$J,"B",XX,0))
67 I $O(^TMP("ECPRO",$J,"N",XX,0)) S ECPROC=+$O(^TMP("ECPRO",$J,"N",XX,0))
68 I $O(^TMP("ECPRO",$J,"SYN",XX,0)) S ECPROC=+$O(^TMP("ECPRO",$J,"SYN",XX,0))
69 Q
70LABEL W !,"Num",?7,"Synonym",?41,"Procedure Name",?73,"Nat ID",!
71 W "---",?7,"-------",?41,"--------------",?73,"------",!
72 Q
73HELP ;Display user options.
74 W !!,"Enter one of the following: < Procedure Name",!,?29,"< Procedure Number"
75 W !,?29,"< Procedure Synonym"
76 W !,?29,"< Enter ""??"" to List Procedures",!
77 Q
78SPLIT ;
79 W !!,"Select Number, or press <RET> to continue listing : " R ANS:DTIME
80 I '$T!(ANS="^") S (ECOUT,ECHOICE)=1 Q
81 I ANS="" W @IOF D LABEL Q
82 I ANS["?" W !!,"Please enter the correct number corresponding to the desired procedure.",! D RETURN S ECR=1 Q
83 I ANS'?1.4N!'ANS W !!,"Select a single number corresponding to the procedure.",! D RETURN S ECR=1 Q
84 I '$D(^TMP("ECPRO",$J,+ANS)) W " ** Invalid Number **" D RETURN S ECR=1 Q
85 I $D(^TMP("ECPRO",$J,+ANS)) S ECPROC=ANS,(ECDONE,ECHOICE)=1
86 Q
87CLIN ;check for active associated clinic
88 S MSG1=1,MSG2=0
89 S EC4=$P($G(^ECJ(+ECFN,"PRO")),"^",4) I EC4']"" S MSG2=1
90 D CLIN^ECPCEU
91 I 'ECPCL D
92 .W !!,"The clinic ",$S(MSG1:"associated with",1:"you selected for")," this event code screen ",$S(MSG2:"has not been entered",1:"is inactive"),"."
93 .W !,"Workload data cannot be sent to PCE for this event code screen with ",!,$S(MSG2:"a missing",1:"an inactive")," clinic."
94 .W !!,"Please use the Procedure Synonym/Default Volume (Enter/Edit) option to enter",!,"an active clinic.",!!
95 S (MSG1,MSG2)=0
96 Q
Note: See TracBrowser for help on using the repository browser.