source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECED2.m@ 1474

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1ECED2 ;BIR/MAM,JPW-Enter Event Capture Data (cont'd) ;7 May 96
2 ;;2.0; EVENT CAPTURE ;**1,4,5,13,18,47**;8 May 96
3NEW ; create new procedure
4 S (EC1,OK)=0 K ECHOICE,ECSTOP
5 I '$D(ECC(1)) S ECC=+$P(ECC(0),"^"),ECCN="None" G P
6 I '$D(ECC(2)) S ECC=+ECC(1),ECCN=$P(ECC(1),"^",2) G P
7 S X="",CNT=0
8LIST W:$D(EC(1))!($Y+5>IOSL) @IOF W !,"Categories within "_ECDN_": ",! S EC1=0 F I=0:0 S CNT=$O(ECC(CNT)) Q:'CNT!$D(ECHOICE) D:($Y+5>IOSL) SELC Q:$D(ECHOICE) I X="" W !,CNT_". ",?5,$P(ECC(CNT),"^",2)
9 I '$D(ECSTOP),$D(ECHOICE) G P
10PICK W !!,"Select Number: " R X:DTIME I '$T!("^"[X) S ECOUT=1 Q
11 I '$D(ECC(X)) W !!,"Select the number corresponding to the category, or ^ to quit.",!!,"Press <RET> to continue ",! R X:DTIME K ECHOICE,ECSTOP S CNT=CNT-5,X="" G LIST
12 S ECC=+$P(ECC(X),"^"),ECCN=$P(ECC(X),"^",2)
13 W !,"Category: "_ECCN,!
14P ; get procedure
15 I '$D(ECC) W !!,"Category not defined.",! D MSG^ECEDU Q
16 D PROS^ECHECK1
17 I '$O(^TMP("ECPRO",$J,0)) D Q:ECOUT
18 .W !!,"Within the ",ECLN," location there are no procedures defined",!
19 .W "for the DSS Unit ",ECDN,". Please select another DSS Unit.",!!
20 .W "Press <RET> to continue " R X:DTIME S ECOUT=2 Q
21P1 ;
22 I '$D(^TMP("ECPRO",$J,2)) S CNT=1 D SETP W !,"Procedure: " D G FILE
23 . W $S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50)
24 . W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",!
25P2 ;ask mul proc
26 S EC1=1
27 S ECX="",(ECPCNT,CNT,OK)=0 K ECHOICE,ECSTOP
28 ;
29 ;New code for procedure entry/lookup
30 S DIR("?")="^D PROS^ECED2"
31 S ECX=$$GETPRO^ECDSUTIL
32 I +$G(ECX)=-1 D MSG^ECEDU,KILLV^ECDSUTIL Q
33 I +$G(ECX)=1 D SRCHTM^ECDSUTIL(ECX)
34 S ECPCNT=+$G(ECPCNT)
35 I ECPCNT=-1!(ECPCNT=-2) D G P2
36 . D @($S(ECPCNT=-1:"ERRMSG^ECDSUTIL",ECPCNT=-2:"ERRMSG2^ECDSUTIL"))
37 . D KILLV^ECDSUTIL
38 I ECPCNT>0 D G FILE
39 . S CNT=ECPCNT
40 . D SETP
41 . S OK=1
42 . D KILLV^ECDSUTIL
43 I 'ECPCNT,$D(ECPNAME) S CNT=$$PRLST^ECDSUTIL
44 I CNT=-1 D MSG^ECEDU,KILLV^ECDSUTIL Q
45 I CNT>0 D G FILE
46 . D SETP
47 . S OK=1
48 . D KILLV^ECDSUTIL
49 Q
50 ;
51PROS ;
52LISTP N X,CNT
53 S X="",CNT=0 K ECHOICE,ECSTOP
54 D HDR1^ECEDU S JJ=1 W !,"Available Procedures within "_ECDN_": ",!
55 W ?72,"National",!,?5,"Procedure Name",?40,"Synonym",?72,"Number",!
56 S EC1=1
57 F S CNT=$O(^TMP("ECPRO",$J,CNT)) Q:'CNT!$D(ECHOICE) D:($Y+5>IOSL) SELC Q:$D(ECHOICE) I X="" W !,CNT_".",?5,$E($P(^TMP("ECPRO",$J,CNT),"^",4),1,30),?38,$E($P(^(CNT),"^",3),1,30),?72,$P(^(CNT),"^",5)
58 I X="" D
59 .W !!?5,"Select by number, CPT or national code, procedure name, or synonym."
60 .W !?5,"Synonym must be preceded by the & character (example: &TESTSYN).",!
61 .W ?2,"** Modifier(s) can be appended to a CPT code (ex: CPT code-mod1,mod2,mod3) **",!
62 Q
63 ;
64FILE ;file pro
65 D HDR^ECEDU
66 D ^ECEDF
67 Q
68SETP ;set proc info
69 S ECJJ=0
70 S ECP=$P(^TMP("ECPRO",$J,CNT),"^"),ECPN=$P(^(CNT),"^",4),NATN=$P(^(CNT),"^",5),ECVOL=$P(^(CNT),"^",6),SYN=$P(^(CNT),"^",3),EC4=$P(^(CNT),"^",2)
71 S ECCPT=$S(ECP["EC":$P($G(^EC(725,+ECP,0)),"^",5),1:+ECP)
72 S ECPTCD="" I ECCPT'="" D
73 . S ECPTCD=$$CPT^ICPTCOD(ECCPT,ECDT)
74 . I +ECPTCD>0 S ECPTCD=$P(ECPTCD,U,2)
75 W " "_$S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50)
76 W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",!
77 S EC4=$P($G(^ECJ(+EC4,"PRO")),"^",4)
78 S EC4N=$S($P($G(^SC(+EC4,0)),"^")]"":$P(^(0),"^"),1:""),ECID=$P($G(^SC(+EC4,0)),"^",7)
79 S ^TMP("ECLKUP",$J,"LAST")=CNT
80 Q
81SELC ; select category
82 W !!,$S(EC1:"Press",1:"Select Number, or press")_" <RET> to continue listing "_$S(EC1:"procedures",1:"categories")_" or '^' to stop: " R X:DTIME I '$T!(X="^") S (ECSTOP,ECHOICE)=1 Q
83 I X="" W @IOF,!,$S(EC1:"Available Procedures",1:"Categories")_" within ",ECDN," : ",! Q
84 I 'EC1,'$D(ECC(X)) D MSGC^ECEDU Q
85 I EC1,'$D(^TMP("ECPRO",$J,X)) D MSGC^ECEDU Q
86 S ECHOICE=1
87 I 'EC1 S ECC=+$P(ECC(X),"^"),ECCN=$P(ECC(X),"^",2) Q
88 Q
Note: See TracBrowser for help on using the repository browser.