| 1 | ECBEN2A ;BIR/MAM,JPW-Categories and Procedures Selection ;30 Apr 96
|
---|
| 2 | ;;2.0; EVENT CAPTURE ;**1,4,5,13,18,33,47,72**;8 May 96
|
---|
| 3 | CHK ; check unit for valid categories
|
---|
| 4 | S (COUNT,EC1)=0 K ECHOICE,ECSTOP
|
---|
| 5 | D CATS^ECHECK1 S ECONE=""
|
---|
| 6 | I '$D(ECC(1)) S ECC=0,ECCN="None",ECONE=0 G P
|
---|
| 7 | I '$D(ECC(2)) S ECC=+ECC(1),ECCN=$P(ECC(1),"^",2),ECONE=1 G P
|
---|
| 8 | CATS ; select category
|
---|
| 9 | S X="",CNT=0
|
---|
| 10 | LIST D HDR^ECBEN2U S JJ=0 W !,"Categories within "_ECDN_": ",!
|
---|
| 11 | S EC1=0
|
---|
| 12 | F 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)
|
---|
| 13 | I '$D(ECSTOP),$D(ECHOICE) S ECONE=2 G P
|
---|
| 14 | PICK W !!,"Select Number: " R X:DTIME I '$T!("^"[X) S ECOUT=1 Q
|
---|
| 15 | I '$D(ECC(X)) W !!,"Select the number corresponding to the category, or ^ to quit.",!!,"Press <RET> to continue " R X:DTIME S CNT=CNT-5,X="" G LIST
|
---|
| 16 | S ECHOICE=1,ECC=$P(ECC(X),"^"),ECCN=$P(ECC(X),"^",2),ECONE=2
|
---|
| 17 | P ;check for valid procedures
|
---|
| 18 | K ^TMP("ECLKUP",$J)
|
---|
| 19 | D PROS^ECHECK1
|
---|
| 20 | I '$O(^TMP("ECPRO",$J,0)) D Q:ECOUT
|
---|
| 21 | .W !!,"Within the ",ECLN," location there are no procedures defined",!
|
---|
| 22 | .W "for the DSS Unit ",ECDN,". Please select another DSS Unit.",!!
|
---|
| 23 | .W "Press <RET> to continue " R X:DTIME S ECOUT=2 Q
|
---|
| 24 | D HDR^ECBEN2U
|
---|
| 25 | P1 ;
|
---|
| 26 | I '$D(^TMP("ECPRO",$J,2)) S CNT=1,ECONE=ECONE_"^1" D SETP W !,"Procedure: " D G V
|
---|
| 27 | . W $S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50)
|
---|
| 28 | . W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",!
|
---|
| 29 | P2 ;ask mul proc
|
---|
| 30 | S ECX="",(ECPCNT,CNT,OK)=0,EC1=1 K ECHOICE,ECSTOP,ECMOD
|
---|
| 31 | S DIR("?")="^D PROS^ECBEN2A"
|
---|
| 32 | S ECX=$$GETPRO^ECDSUTIL
|
---|
| 33 | I +$G(ECX)=-1,(COUNT=0) D MSG^ECBEN2U,KILLV^ECDSUTIL Q
|
---|
| 34 | I +$G(ECX)=-1,COUNT G FILE
|
---|
| 35 | I +$G(ECX)=1 D SRCHTM^ECDSUTIL(ECX)
|
---|
| 36 | S ECPCNT=+$G(ECPCNT)
|
---|
| 37 | I ECPCNT=-1!(ECPCNT=-2) D G P2
|
---|
| 38 | . D @($S(ECPCNT=-1:"ERRMSG^ECDSUTIL",ECPCNT=-2:"ERRMSG2^ECDSUTIL"))
|
---|
| 39 | . D KILLV^ECDSUTIL
|
---|
| 40 | I ECPCNT>0 D G V
|
---|
| 41 | . S CNT=ECPCNT
|
---|
| 42 | . D SETP
|
---|
| 43 | . S OK=1,ECONE=ECONE_"^2"
|
---|
| 44 | . D KILLV^ECDSUTIL
|
---|
| 45 | I 'ECPCNT,$D(ECPNAME) S CNT=$$PRLST^ECDSUTIL
|
---|
| 46 | I CNT=-1 D MSG^ECBEN2U,KILLV^ECDSUTIL Q
|
---|
| 47 | I CNT>0 D G V
|
---|
| 48 | . D SETP
|
---|
| 49 | . S OK=1,ECONE=ECONE_"^2"
|
---|
| 50 | . D KILLV^ECDSUTIL
|
---|
| 51 | Q
|
---|
| 52 | ;
|
---|
| 53 | PROS ;
|
---|
| 54 | S X="",CNT=0 K ECHOICE
|
---|
| 55 | LISTP D HDR^ECBEN2U S JJ=1 W !,"Available Procedures within "_ECDN_": ",!
|
---|
| 56 | W ?72,"National",!,?5,"Procedure Name",?40,"Synonym",?72,"Number",!
|
---|
| 57 | S EC1=1
|
---|
| 58 | 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)
|
---|
| 59 | I X="" D
|
---|
| 60 | .W !!?5,"Select by number, CPT or national code, procedure name, or synonym."
|
---|
| 61 | .W !?5,"Synonym must be preceded by the & character (example: &TESTSYN).",!
|
---|
| 62 | .W ?2,"** Modifier(s) can be appended to a CPT code (ex: CPT code-mod1,mod2,mod3) **",!
|
---|
| 63 | Q
|
---|
| 64 | ;
|
---|
| 65 | V ;vol (and procedure reason),ask for CPT modifier is applicable
|
---|
| 66 | ;
|
---|
| 67 | ;ALB/JAM - Ask CPT Procedure Modifier
|
---|
| 68 | I ECCPT'="" D I ECOUT Q
|
---|
| 69 | . S ECMODS=$G(ECMODS)
|
---|
| 70 | . S ECMODF=$$ASKMOD^ECUTL(ECCPT,ECMODS,ECDT,.ECMOD,.ECERR)
|
---|
| 71 | . I $G(ECERR) S ECOUT=1
|
---|
| 72 | . K ECMODF,ECMODS
|
---|
| 73 | ;ALB/ESD - Ask Procedure Reason
|
---|
| 74 | I $G(ECP)]"" S ECSCR=+$O(^ECJ("AP",+ECL,+ECD,+ECC,ECP,0))
|
---|
| 75 | K ECPRPTR
|
---|
| 76 | I ECSCR>0,($P($G(^ECJ(ECSCR,"PRO")),"^",5)=1),(+$O(^ECL("AD",ECSCR,0))) D
|
---|
| 77 | . S ECPRPTR=0
|
---|
| 78 | . S DIC="^ECL(",DIC(0)="QEAM"
|
---|
| 79 | . S DIC("A")="Procedure Reason: ",DIC("S")="I $P(^(0),U,2)=ECSCR"
|
---|
| 80 | . D ^DIC K DIC
|
---|
| 81 | . I +Y>0 S ECPRPTR=+Y
|
---|
| 82 | K ECSCR
|
---|
| 83 | ;
|
---|
| 84 | VV ;vol
|
---|
| 85 | S:'VOL VOL=1
|
---|
| 86 | W !,"Volume: "_VOL_"// " R X:DTIME I '$T S ECOUT=1 Q
|
---|
| 87 | I X="^" S ECOUT=1 Q
|
---|
| 88 | S:X="" X=VOL I X'?1.2N!'X W !!,"Enter a whole number between 1 and 99." G VV
|
---|
| 89 | S ECV=X
|
---|
| 90 | CHKP ;
|
---|
| 91 | W !!,"Category: ",?14,$E(ECCN,1,26),?44,"Ord Section: "_$E(ECON,1,22)
|
---|
| 92 | W !,"Procedure: ",?14,$S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50)
|
---|
| 93 | W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")"
|
---|
| 94 | I ECCPT'="" N MOD S MOD="" F S MOD=$O(ECMOD(ECCPT,MOD)) Q:MOD="" D
|
---|
| 95 | . W !?1,"Modifier: ",?18,"- ",MOD," ",$E($P(ECMOD(ECCPT,MOD),U),1,55)
|
---|
| 96 | ;
|
---|
| 97 | ;ALB/ESD - Display procedure reason
|
---|
| 98 | I +$G(ECPRPTR) S ECPRSL=$P($G(^ECL(+ECPRPTR,0)),"^") W !,"Procedure Reason: ",$P($G(^ECR(+ECPRSL,0)),"^")
|
---|
| 99 | W !,"Date: ",?14,ECDATE,?44,"Volume: "_ECV
|
---|
| 100 | W ! D DSP1444^ECPRVMUT(.ECPRVARY)
|
---|
| 101 | W !!!,"Is this information correct ? YES// " R ECYN:DTIME I '$T!(ECYN="^") D NOTE S ECOUT=2,CNT=0 K ECEC W "Press <RET> to continue " R X:DTIME Q
|
---|
| 102 | S ECYN=$E(ECYN) S:ECYN="" ECYN="Y"
|
---|
| 103 | I "YyNn"'[ECYN W !!,"Enter <RET> if the information listed above is correct and should be",!,"entered for the patients selected. Enter NO to re-enter the information",!,"for this procedure.",!
|
---|
| 104 | I "YyNn"'[ECYN W !!,"Press <RET> to continue " R X:DTIME G CHKP
|
---|
| 105 | I "Nn"[ECYN,$P(ECONE,"^")<2,$P(ECONE,"^",2)<2 S ECOUT=2 Q
|
---|
| 106 | I "Nn"[ECYN K ECHOICE,ECCN,ECP,ECPN,ECONE,ECMOD,^TMP("ECPRO",$J) G CHK
|
---|
| 107 | ;
|
---|
| 108 | ;ALB/ESD - File procedure reason in local array ECEC (used in ECBENF)
|
---|
| 109 | S COUNT=COUNT+1,ECEC(COUNT)=ECC_"^"_ECP_"^^"_ECO_"^"_ECV_"^^^^^^"_ECCPT_$S(+$G(ECPRPTR):"^"_ECPRPTR,1:"")
|
---|
| 110 | ;File CPT modifiers in array ECEC if they exist
|
---|
| 111 | I ECCPT'="",$O(ECMOD(ECCPT,""))'="" D
|
---|
| 112 | . M ECEC(COUNT,"MOD")=ECMOD(ECCPT)
|
---|
| 113 | I $D(^TMP("ECPRO",$J,2)) W !! G P2
|
---|
| 114 | FILE ;file proc
|
---|
| 115 | I '$D(ECEC(1)) W !!,"No procedures have been selected for filing. Please re-enter the ",!,"information for the procedures, or ^ to exit.",!!,"Press <RET> to continue" R X:DTIME S:X="^" ECOUT=1 K ECTEMP,^TMP("ECPRO",$J) G P
|
---|
| 116 | D ^ECBEN2B
|
---|
| 117 | END Q
|
---|
| 118 | SETP ;set proc
|
---|
| 119 | S ECP=$P(^TMP("ECPRO",$J,CNT),"^"),ECPN=$P(^(CNT),"^",4),SYN=$P(^(CNT),"^",3),NATN=$P(^(CNT),"^",5),VOL=$P(^(CNT),"^",6)
|
---|
| 120 | S ECCPT=$S(ECP["EC":$P($G(^EC(725,+ECP,0)),"^",5),1:+ECP)
|
---|
| 121 | S ECPTCD="" I ECCPT'="" D
|
---|
| 122 | . S ECPTCD=$$CPT^ICPTCOD(ECCPT,ECDT) I +ECPTCD>0 S ECPTCD=$P(ECPTCD,U,2)
|
---|
| 123 | W " "_$S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50)
|
---|
| 124 | W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",!
|
---|
| 125 | S EC4=$P(^TMP("ECPRO",$J,CNT),"^",2)
|
---|
| 126 | S ^TMP("ECLKUP",$J,"LAST")=CNT
|
---|
| 127 | Q
|
---|
| 128 | SELC ; select category
|
---|
| 129 | 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
|
---|
| 130 | I X="" W @IOF,!,$S(EC1:"Available Procedures",1:"Categories")_" within ",ECDN," : ",! Q
|
---|
| 131 | I 'EC1,'$D(ECC(X)) D MSG1^ECBEN2U Q
|
---|
| 132 | I EC1,'$D(^TMP("ECPRO",$J,X)) D MSG1^ECBEN2U Q
|
---|
| 133 | S ECHOICE=1
|
---|
| 134 | I 'EC1 S ECC=$P(ECC(X),"^"),ECCN=$P(ECC(X),"^",2) Q
|
---|
| 135 | Q
|
---|
| 136 | NOTE ;
|
---|
| 137 | W !!,"**NOTE** No action taken.",!,"You must re-enter the correct patient and procedure data that",!,"has NOT been filed during this session. ",!!
|
---|
| 138 | Q
|
---|