source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECBEN1A.m@ 1147

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

initial load of WorldVistAEHR

File size: 861 bytes
RevLine 
[613]1ECBEN1A ;BIR/JLP,RHK-New Batch Entry ;12 Feb 96
2 ;;2.0; EVENT CAPTURE ;**4,5,72**;8 May 96
3O ;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)
7DATE ;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
13DATE1 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 ;
20PAT ;select pat
21 D ^ECBEN1B
22 K ECPRVARY
23END Q
24 ;
25MSG ;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.