ECBEN1A ;BIR/JLP,RHK-New Batch Entry ;12 Feb 96
;;2.0; EVENT CAPTURE ;**4,5,72**;8 May 96
O ;select ord sect
W !!,"Location: "_ECLN,!,"DSS Unit: "_ECDN K DIC,DUOUT
S DIC=723,DIC(0)="QEAMZ",DIC("A")="Ordering Section: " D ^DIC K DIC I Y<0 S ECOUT=1 Q
S ECO=+Y,ECON=$P(Y,"^",2)
DATE ;select date
K %DT S %DT="AEXR"
I ECDDT="",$G(ECDR)]"" S %DT("B")=ECDR G DATE1
I ECDDT'="" S %DT("B")=ECDDT
;
; ALB/ESD - Prevent future dates from being entered
DATE1 S %DT("A")="Procedure Date and Time: ",%DT(0)="-NOW" D ^%DT I Y<0 S ECOUT=1 Q
S ECDT=+Y,(ECDATE,ECDR)=$$FMTE^XLFDT(ECDT) K %DT
;
;select provider(s) with active person class
D ASKPRV^ECPRVMUT("",ECDT,.ECPRVARY,.ECOUT)
I $G(ECOUT) S ECOUT=1 K ECPRVARY Q
;
PAT ;select pat
D ^ECBEN1B
K ECPRVARY
END Q
;
MSG ;quit msg
W !!,"No action taken.",!!,"Press <RET> to continue " R X:DTIME S ECOUT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECBEN1A 888 printed Dec 13, 2024@01:56:49 Page 2
ECBEN1A ;BIR/JLP,RHK-New Batch Entry ;12 Feb 96
+1 ;;2.0; EVENT CAPTURE ;**4,5,72**;8 May 96
O ;select ord sect
+1 WRITE !!,"Location: "_ECLN,!,"DSS Unit: "_ECDN
KILL DIC,DUOUT
+2 SET DIC=723
SET DIC(0)="QEAMZ"
SET DIC("A")="Ordering Section: "
DO ^DIC
KILL DIC
IF Y<0
SET ECOUT=1
QUIT
+3 SET ECO=+Y
SET ECON=$PIECE(Y,"^",2)
DATE ;select date
+1 KILL %DT
SET %DT="AEXR"
+2 IF ECDDT=""
IF $GET(ECDR)]""
SET %DT("B")=ECDR
GOTO DATE1
+3 IF ECDDT'=""
SET %DT("B")=ECDDT
+4 ;
+5 ; ALB/ESD - Prevent future dates from being entered
DATE1 SET %DT("A")="Procedure Date and Time: "
SET %DT(0)="-NOW"
DO ^%DT
IF Y<0
SET ECOUT=1
QUIT
+1 SET ECDT=+Y
SET (ECDATE,ECDR)=$$FMTE^XLFDT(ECDT)
KILL %DT
+2 ;
+3 ;select provider(s) with active person class
+4 DO ASKPRV^ECPRVMUT("",ECDT,.ECPRVARY,.ECOUT)
+5 IF $GET(ECOUT)
SET ECOUT=1
KILL ECPRVARY
QUIT
+6 ;
PAT ;select pat
+1 DO ^ECBEN1B
+2 KILL ECPRVARY
END QUIT
+1 ;
MSG ;quit msg
+1 WRITE !!,"No action taken.",!!,"Press <RET> to continue "
READ X:DTIME
SET ECOUT=1
+2 QUIT
