Last change
on this file since 619 was 613, checked in by George Lilly, 15 years ago |
initial load of WorldVistAEHR
|
File size:
861 bytes
|
Line | |
---|
1 | ECBEN1A ;BIR/JLP,RHK-New Batch Entry ;12 Feb 96
|
---|
2 | ;;2.0; EVENT CAPTURE ;**4,5,72**;8 May 96
|
---|
3 | O ;select ord sect
|
---|
4 | W !!,"Location: "_ECLN,!,"DSS Unit: "_ECDN K DIC,DUOUT
|
---|
5 | S DIC=723,DIC(0)="QEAMZ",DIC("A")="Ordering Section: " D ^DIC K DIC I Y<0 S ECOUT=1 Q
|
---|
6 | S ECO=+Y,ECON=$P(Y,"^",2)
|
---|
7 | DATE ;select date
|
---|
8 | K %DT S %DT="AEXR"
|
---|
9 | I ECDDT="",$G(ECDR)]"" S %DT("B")=ECDR G DATE1
|
---|
10 | I ECDDT'="" S %DT("B")=ECDDT
|
---|
11 | ;
|
---|
12 | ; ALB/ESD - Prevent future dates from being entered
|
---|
13 | DATE1 S %DT("A")="Procedure Date and Time: ",%DT(0)="-NOW" D ^%DT I Y<0 S ECOUT=1 Q
|
---|
14 | S ECDT=+Y,(ECDATE,ECDR)=$$FMTE^XLFDT(ECDT) K %DT
|
---|
15 | ;
|
---|
16 | ;select provider(s) with active person class
|
---|
17 | D ASKPRV^ECPRVMUT("",ECDT,.ECPRVARY,.ECOUT)
|
---|
18 | I $G(ECOUT) S ECOUT=1 K ECPRVARY Q
|
---|
19 | ;
|
---|
20 | PAT ;select pat
|
---|
21 | D ^ECBEN1B
|
---|
22 | K ECPRVARY
|
---|
23 | END Q
|
---|
24 | ;
|
---|
25 | MSG ;quit msg
|
---|
26 | W !!,"No action taken.",!!,"Press <RET> to continue " R X:DTIME S ECOUT=1
|
---|
27 | Q
|
---|
Note:
See
TracBrowser
for help on using the repository browser.