|
Last change
on this file since 1720 was 613, checked in by George Lilly, 15 years ago |
|
initial load of WorldVistAEHR
|
|
File size:
716 bytes
|
| Rev | Line | |
|---|
| [613] | 1 | ECBEP1A ;BIR;JPW-Batch Entry by Procedure (cont'd) ;2 Mar 96
|
|---|
| 2 | ;;2.0; EVENT CAPTURE ;**4,5,72**;8 May 96
|
|---|
| 3 | DATE ;select date
|
|---|
| 4 | K %DT S %DT="AEXR"
|
|---|
| 5 | I ECDDT="",$G(ECDR)]"" S %DT("B")=ECDR G DATE1
|
|---|
| 6 | I ECDDT'="" S %DT("B")=ECDDT
|
|---|
| 7 | ;
|
|---|
| 8 | ; ALB/ESD - Prevent future dates from being entered
|
|---|
| 9 | DATE1 S %DT("A")="Procedure Date and Time: ",%DT(0)="-NOW" D ^%DT I Y<0 S ECOUT=1 Q
|
|---|
| 10 | S ECDT=+Y,(ECDATE,ECDR)=$$FMTE^XLFDT(ECDT) K %DT
|
|---|
| 11 | ;
|
|---|
| 12 | ;select provider(s) with active person class
|
|---|
| 13 | D ASKPRV^ECPRVMUT("",ECDT,.ECPRVARY,.ECOUT)
|
|---|
| 14 | I $G(ECOUT) S ECOUT=1 K ECPRVARY Q
|
|---|
| 15 | ;
|
|---|
| 16 | CAT ;select category
|
|---|
| 17 | D ^ECBEP1B K ECPRVARY I ECOUT=2 D MSG S ECOUT=2 Q
|
|---|
| 18 | END Q
|
|---|
| 19 | ;
|
|---|
| 20 | MSG ;quit msg
|
|---|
| 21 | W !!,"No action taken.",!!,"Press <RET> to continue " R X:DTIME S ECOUT=1
|
|---|
| 22 | Q
|
|---|
Note:
See
TracBrowser
for help on using the repository browser.
