|
Last change
on this file since 846 was 613, checked in by George Lilly, 15 years ago |
|
initial load of WorldVistAEHR
|
|
File size:
861 bytes
|
| Rev | Line | |
|---|
| [613] | 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.
