source: FOIAVistA/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECBEP2A.m@ 1765

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

initial load of FOIAVistA 6/30/08 version

File size: 5.4 KB
Line 
1ECBEP2A ;BIR/MAM,JPW-Batch Enter by Procedure (cont'd) ;1 May 96
2 ;;2.0; EVENT CAPTURE ;**4,5,10,13,17,18,23,33,41,42,54,72**;8 May 96
3EN ;entry pt
4 D HDR
5 S CNT=0
6PATS ; get patients
7 W ! Q:ECOUT=1 K ECADD
8 K DIC,DUOUT S DIC=2,DIC(0)="QEAMZ",DIC("A")=$S($D(ECPT):"Select Next Patient: ",1:"Select Patient: ")
9 D ^DIC K DIC S OK=0
10 I $D(DUOUT)!($D(DTOUT)) S ECOUT=1 Q
11 I Y<0,CNT=0 S ECOUT=2 Q
12 I Y<0 D G:ECOUT'=2 PATS I ECOUT=2 D KILL Q
13 .D LIST Q:ECOUT Q:'$O(ECPT(0)) Q:$G(ECADD)="A"
14 .S ECTWO=0 K ECHOICE D ^ECBEP2B S ECOUT=2
15 I $O(ECPT(0)) S JJ="" F S JJ=$O(ECPT(JJ)) Q:'JJ!(OK=1) I +$G(ECPT(JJ))=+Y S OK=1 W !!,"Patient already selected. Please select another patient.",!
16 I OK=1 G PATS
17 N YY,ECUP D I $G(ECUP)="^" G PATS
18 . S YY=Y,DFN=+Y D 2^VADPT S Y=YY I +VADM(6) D
19 . . W !!,"WARNING ",VADM(7),!!
20 . . R "Press Return to Continue or ^ to Deselect: ",ECUP:DTIME
21 S CNT=CNT+1,CNT1=CNT,ECPT(CNT)=+Y_"^"_$P(Y,"^",2) D ASK
22 G PATS
23 ;
24LIST ; list patients
25 K ECADD
26 W @IOF,!,"Patients Selected for Batch Entry: ",! F I=0:0 S I=$O(ECPT(I)) Q:'I W:I#2 ! W:I#2=0 ?40 W I_". "_$P(ECPT(I),"^",2)
27 W !!,"Is this list correct ? YES// " R ECYN:DTIME I '$T!(ECYN="^") S ECOUT=1 Q
28 S ECYN=$E(ECYN) S:ECYN="" ECYN="Y" I "YyNn"'[ECYN W !!,"Enter <RET> if this list is complete, or NO to add or delete",!,"patients on the list.",!!,"Press <RET> to continue " R X:DTIME G LIST
29 I "Yy"[ECYN Q:$O(ECPT(0)) D NOBODY Q:ECOUT
30ADD W !!,"Add or Delete Patients ? ADD// " R ECADD:DTIME I '$T!(ECADD="^") S ECOUT=1 Q
31 S ECADD=$E(ECADD) S:ECADD="" ECADD="A" I "AaDd"'[ECADD W !!,"Enter <RET> to make additions to the list, or D to delete a ",!,"patient from the list." K ECADD G ADD
32 Q:ECADD="A"
33DEL ; delete patients from list
34 I '$D(ECPT(1)) D NOBODY Q:ECOUT G LIST
35 W !!,"Select Number: " R X:DTIME I '$T!(X="^") S ECOUT=1 Q
36 I X="" Q
37 I '$D(ECPT(X)) W !!,"Select the number corresponding to the patient that you would like",!,"to remove from the list.",!!,"Press <RET> to continue " R X:DTIME S ECMORE=1 D LIST Q:ECOUT G DEL
38 F I=X+1:1:CNT S ECPT(I-1)=ECPT(I)
39 K ECPT(CNT),I S CNT=CNT-1
40 W !!,"Patient deleted.",!!,"Press <RET> to continue " R X:DTIME
41 G LIST
42 Q
43HDR ;
44 W @IOF,!,"Location: ",ECLN
45 W !,"DSS Unit: ",ECDN
46 I $G(ECCN)]"" W !,"Category: ",ECCN
47 W !,"Procedure: "_$S(ECCPT'="":ECPTCD_" ",1:"")_$E(ECPN,1,50)
48 W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")"
49 ;- Display CPT procedure Modifiers
50 I ECCPT'="" N MOD S MOD="" F S MOD=$O(ECMOD(ECCPT,MOD)) Q:MOD="" D
51 . W !?1,"Modifier: "," - ",MOD," ",$E($P(ECMOD(ECCPT,MOD),U),1,55)
52 W !,"Procedure Date: ",ECDATE
53 W ! D DSP1416^ECPRVMUT(.ECPRVARY)
54 W !
55 Q
56 ;
57NOBODY ;No patients selected
58 I $D(ECADD),ECADD="D" W !!,"You cannot delete patients when your patient list is empty."
59 I $G(ECADD)'="D" W !!,"You have selected no patients."
60 R !!,"Do you wish to quit? Y//",X:DTIME S X=$E(X) I '$T!(X="^") S ECOUT=1 Q
61 S:X="" X="Y" I "yY"[X S ECOUT=1 Q
62 I "nN"'[X W !,"Answer ""N"" to continue selection, or enter return to quit",! G NOBODY
63 Q
64ADCAT ;add category/procedures for patients
65 ;D ^ECBEN2A I ECOUT=1 Q
66 ;W !!! K DIR,DIRUT,DA S DIR(0)="Y",DIR("A")="Do you want to enter another category and procedure for these patients" D ^DIR Q:$D(DIRUT)!'Y
67 Q
68KILL ;kill arrays and variables
69 K ECSC,ECZEC,ECIR,ECDX,ECDXN,ECVST,ECINP,ECAO,ECPTSTAT,ECMST,ECHNC,ECCV
70 K ECA,ECHOICE,ECJLP,ECPT,ECO,ECON,ECV,ECDXS,ECDXIEN
71 S ECOUT=0
72 Q
73ASK ; ask ord sect & vol
74 W !!,"DSS Unit: "_ECDN,?50,"Category: "_ECCN,!
75 W "Procedure: "_$S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50)
76 W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",!
77 ;- Display CPT procedure Modifiers
78 I ECCPT'="" N MOD S MOD="" F S MOD=$O(ECMOD(ECCPT,MOD)) Q:MOD="" D
79 . W ?1,"Modifier: "," - ",MOD," ",$E($P(ECMOD(ECCPT,MOD),U),1,55),!
80 W "Patient: ",$P(ECPT(CNT),"^",2),!
81 ;
82 ;- Determine inpatient/outpatient status
83 S ECPTSTAT=$$INOUTPT^ECUTL0(+$G(ECPT(CNT)),+$G(ECDT))
84 I ECPTSTAT="" D INOUTERR^ECUTL0 Q
85 ;
86 ;- Determine patient eligibility
87 I $$CHKDSS^ECUTL0(+$G(ECD),ECPTSTAT) D
88 . I $$MULTELG^ECUTL0(+$G(ECPT(CNT))) S ECELIG=+$$ELGLST^ECUTL0
89 . E S ECELIG=+$G(VAEL(1))
90 K VAEL
91 ;
92 ;- Display inpatient/outpatient status message
93 D DSPSTAT^ECUTL0(ECPTSTAT)
94 ;
95O ; ord sect
96 K DIC,DUOUT S DIC=723,DIC(0)="QEAMZ",DIC("A")="Ordering Section: "
97 D ^DIC K DIC I Y<0 D DELPT(.CNT) Q
98 S ECO=+Y,ECON=$P(Y,"^",2)
99V ; vol
100 S:'VOL VOL=1
101 W !,"Volume: "_VOL_"//" R X:DTIME I '$T S ECOUT=1 Q
102 I X="^" D DELPT(.CNT) Q
103 S:X="" X=VOL I X'?1.2N!'X W !!,"Enter a whole number between 1 and 99." G V
104 S ECV=X
105DIAG ;diagnosis, in/outpatient, visit
106 S (ECDX,ECDXN,ECINP,ECVST,ECSC,ECAO,ECIR,ECZEC,ECMST,ECHNC,ECCV)=""
107 S ECDFN=$P(ECPT(CNT),U)
108 I $P(ECPCE,"~",2)="N" G NODE
109 D PCEQST^ECBEN2U
110 I ECOUT D DELPT(.CNT) Q
111NODE ;set node
112 ;- Get associated clinic from event code screen and DSS ID if null
113 S:$G(EC4)="" EC4=$P($G(^ECJ(+$O(^ECJ("AP",+ECL,+ECD,+ECC,$G(ECP),0)),"PRO")),"^",4)
114 S EC4N=$S($P($G(^SC(+EC4,0)),"^")]"":$P(^(0),"^"),1:"NO ASSOCIATED CLINIC"),ECID=$P($G(^SC(+EC4,0)),"^",7)
115 S ECPT(CNT)=ECPT(CNT)_"^"_ECO_"^"_ECON_"^"_ECV_"^"_ECDX_"^"_$S(ECINP="":$G(ECPTSTAT),1:ECINP)_"^"_ECVST_"^"_ECSC_"^"_ECAO_"^"_ECIR_"^"_ECZEC_"^"_EC4_"^"_ECID_"^"_ECMST_"^"_ECHNC_"^"_ECCV
116 I $D(ECDXS) M ECPT(CNT,"DXS")=ECDXS K ECDXS
117 S ECELPT(CNT)=$S($G(ECELIG):ECELIG,1:"") K ECPTSTAT
118 Q
119 ;
120DELPT(CNT) ;deselect patient due to missing required data
121 N DIR,Y
122 K ECPT(CNT) S CNT=CNT-1
123 W !,"Required data missing.",!,"Patient deselected...",!
124 S ECOUT=0
125 S DIR(0)="E",DIR("A")="Press RETURN to continue"
126 D ^DIR
127 W !
128 Q
Note: See TracBrowser for help on using the repository browser.