[613] | 1 | ECED2 ;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
|
---|
| 3 | NEW ; 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
|
---|
| 8 | LIST 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
|
---|
| 10 | PICK 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,!
|
---|
| 14 | P ; 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
|
---|
| 21 | P1 ;
|
---|
| 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_")",!
|
---|
| 25 | P2 ;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 | ;
|
---|
| 51 | PROS ;
|
---|
| 52 | LISTP 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 | ;
|
---|
| 64 | FILE ;file pro
|
---|
| 65 | D HDR^ECEDU
|
---|
| 66 | D ^ECEDF
|
---|
| 67 | Q
|
---|
| 68 | SETP ;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
|
---|
| 81 | SELC ; 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
|
---|