ECBEN1A.m

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 ---ECBEN1A   888     printed  Feb 18, 2025@23:23:13                                                                                                                                                                                                      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