source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECBEP1B.m@ 623

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

initial load of WorldVistAEHR

File size: 6.0 KB
Line 
1ECBEP1B ;BIR/MAM,JPW-Batch Entry by Procedure (cont'd) ;30 Apr 96
2 ;;2.0; EVENT CAPTURE ;**1,4,5,10,13,17,18,42,47,54,72**;8 May 96
3CHK ; check unit for valid categories
4 K ECC,ECCN,ECHOICE,ECEC,ECSTOP
5 S (COUNT,EC1)=0
6 D CATS^ECHECK1 S ECONE=""
7 I '$D(ECC(1)) S ECC=0,ECCN="None",ECONE=0 G P
8 I '$D(ECC(2)) S ECC=+ECC(1),ECCN=$P(ECC(1),"^",2),ECONE=1 G P
9CATS ; select category
10 S X="",CNT=0
11LIST D HDRP^ECBEN2U S JJ=0 W !,"Categories within "_ECDN_": ",!
12 S EC1=0
13 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)
14 I '$D(ECSTOP),$D(ECHOICE) S ECONE=2 G P
15PICK W !!,"Select Number: " R X:DTIME I '$T!("^"[X) S ECOUT=1 Q
16 I X="" S ECOUT=2 Q
17 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
18 S ECHOICE=1,ECC=$P(ECC(X),"^"),ECCN=$P(ECC(X),"^",2),ECONE=2
19P ;check for valid procedures
20 D PROS^ECHECK1
21 I '$O(^TMP("ECPRO",$J,0)) D Q:ECOUT
22 .W !!,"Within the ",ECLN," location there are no procedures defined",!
23 .W "for the DSS Unit ",ECDN,". Please select another DSS Unit.",!!
24 .W "Press <RET> to continue " R X:DTIME S ECOUT=2 Q
25 D HDRP^ECBEN2U
26P1 ;
27 I '$D(^TMP("ECPRO",$J,2)) S CNT=1,ECONE=ECONE_"^1" D SETP W !,"Procedure: " D G CHKP
28 . W $S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50)
29 . W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",!
30P2 ;ask mul proc
31 S ECX="",(ECPCNT,CNT,OK)=0,EC1=1 K ECHOICE,ECSTOP
32 S DIR("?")="^D PROS^ECBEP1B"
33 S ECX=$$GETPRO^ECDSUTIL
34 I +$G(ECX)=-1,(COUNT=0) S ECOUT=2 D KILLV^ECDSUTIL Q
35 I +$G(ECX)=-1,COUNT G FILE
36 I +$G(ECX)=1 D SRCHTM^ECDSUTIL(ECX)
37 S ECPCNT=+$G(ECPCNT)
38 I ECPCNT=-1!(ECPCNT=-2) D G P2
39 .; Don't display spacebar/return error msg since only 1 procedure
40 . D ERRMSG^ECDSUTIL
41 . D KILLV^ECDSUTIL
42 I ECPCNT>0 D G CHKP
43 . S CNT=ECPCNT
44 . D SETP
45 . S OK=1,ECONE=ECONE_"^2"
46 . D KILLV^ECDSUTIL
47 I 'ECPCNT,$D(ECPNAME) S CNT=$$PRLST^ECDSUTIL
48 I CNT=-1 D MSG^ECBEN2U,KILLV^ECDSUTIL Q
49 I CNT>0 D G CHKP
50 . D SETP
51 . S OK=1,ECONE=ECONE_"^2"
52 . D KILLV^ECDSUTIL
53 Q
54 ;
55PROS ;
56 S X="",CNT=0 K ECHOICE
57LISTP D HDRP^ECBEN2U S JJ=1 W !,"Available Procedures within "_ECDN_": ",!
58 W ?72,"National",!,?5,"Procedure Name",?40,"Synonym",?72,"Number",!
59 S EC1=1
60 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)
61 I X="" D
62 .W !!?5,"Select by number, CPT or national code, procedure name, or synonym.",!?5,"Synonym must be preceded by the & character (example: &TESTSYN).",!
63 .W ?2,"** Modifier(s) can be appended to a CPT code (ex: CPT code-mod1,mod2,mod3) **",!
64 Q
65 ;
66CHKP ;
67 ;Ask CPT procedure modifiers
68 I ECCPT'="" D K ECMODF,ECMODS
69 . S ECMODS=$G(ECMODS)
70 . S ECMODF=$$ASKMOD^ECUTL(ECCPT,ECMODS,ECDT,.ECMOD,.ECERR)
71 I $G(ECERR) S ECOUT=2 K ECERR,ECMOD D KILLV^ECDSUTIL Q
72 ;
73 ;- 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 W !
83 ;
84 I $G(ECCN)]"" W !,"Category: ",ECCN
85 W !,"Procedure: ",$S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50)
86 W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")"
87 ;
88 ;- Display CPT procedure Modifiers
89 I ECCPT'="" N MOD S MOD="" F S MOD=$O(ECMOD(ECCPT,MOD)) Q:MOD="" D
90 . W !?1,"Modifier: "," - ",MOD," ",$E($P(ECMOD(ECCPT,MOD),U),1,55)
91 ;- Display procedure reason
92 I +$G(ECPRPTR) S ECPRSL=$P($G(^ECL(+ECPRPTR,0)),"^") W !,"Procedure Reason: ",$P($G(^ECR(+ECPRSL,0)),"^")
93 D DSP1442^ECPRVMUT(.ECPRVARY)
94 W !
95 W !!,"Is this information correct ? YES// " R ECYN:DTIME I '$T!(ECYN="^") Q
96 S ECYN=$E(ECYN) S:ECYN="" ECYN="Y"
97 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.",!
98 I "YyNn"'[ECYN W !!,"Press <RET> to continue " R X:DTIME G CHKP
99 I "Nn"[ECYN,$P(ECONE,"^")<2,$P(ECONE,"^",2)<2 S ECOUT=2 Q
100 I "Nn"[ECYN K ECHOICE,ECCN,ECP,ECPN,ECMOD,ECONE,^TMP("ECPRO",$J) G CHK
101 ;
102 ;- File procedure reason in local array ECEC (used in ECBEPF)
103 S COUNT=COUNT+1,ECEC(COUNT)=ECC_"^"_ECP_"^^^^^^^"_ECCPT_"^"_EC4_"^"_ECID_$S(+$G(ECPRPTR):"^"_ECPRPTR,1:"")
104 ;- File CPT modifiers in local array ECEC
105 I ECCPT'="",$O(ECMOD(ECCPT,""))'="" D
106 . M ECEC(COUNT,"MOD")=ECMOD(ECCPT)
107FILE ;file proc
108 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
109 D ^ECBEP2A Q:ECOUT K ECA,ECCN,ECEC,ECHOICE,ECJLP,ECP,ECPN,ECPT,ECO,ECON,ECV,NATN,NODE,SYN,^TMP("ECPRO",$J),ECDX,ECDXN,ECINP,ECCPT,ECSC,ECIR,ECZEC,ECAO,ECVST,ECPTSTAT,ECMST,ECHNC,ECCV,ECMOD,ECPTCD G CHK
110END Q
111SETP ;set proc
112 S ECP=$P(^TMP("ECPRO",$J,CNT),"^"),ECPN=$P(^(CNT),"^",4),SYN=$P(^(CNT),"^",3),NATN=$P(^(CNT),"^",5),VOL=$P(^(CNT),"^",6)
113 S ECCPT=$S(ECP["EC":$P($G(^EC(725,+ECP,0)),"^",5),1:+ECP)
114 S ECPTCD="" I ECCPT'="" D
115 . S ECPTCD=$$CPT^ICPTCOD(ECCPT,ECDT) I +ECPTCD>0 S ECPTCD=$P(ECPTCD,U,2)
116 W " "_$S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50)
117 W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",!
118 S EC4=$P(^TMP("ECPRO",$J,CNT),"^",2),EC4=$P($G(^ECJ(+EC4,"PRO")),"^",4)
119 S EC4N=$S($P($G(^SC(+EC4,0)),"^")]"":$P(^(0),"^"),1:"NO ASSOCIATED CLINIC"),ECID=$P($G(^SC(+EC4,0)),"^",7)
120 Q
121SELC ; select category
122 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
123 I X="" W @IOF,!,$S(EC1:"Available Procedures",1:"Categories")_" within ",ECDN," : ",! Q
124 I 'EC1,'$D(ECC(X)) D MSG1^ECBEN2U S ECOUT=2 Q
125 I EC1,'$D(^TMP("ECPRO",$J,X)) D MSG1^ECBEN2U S ECOUT=2 Q
126 S ECHOICE=1
127 I 'EC1 S ECC=$P(ECC(X),"^"),ECCN=$P(ECC(X),"^",2) Q
128 Q
Note: See TracBrowser for help on using the repository browser.