ECMLMD ;ALB/ESD - Multiple Dates/Multiple Procedures Driver ;20 AUG 1997 13:56
;;2.0; EVENT CAPTURE ;**5,15,72**;8 May 96
;
EN ;- Entry point for Multiple Date/Multiple Procedures Data Entry Option
;
N ECCAT,ECDSSU,ECFFLG,ECL,ECLN,ECNFLG,ECPRDT,ECPROC,ECU
;
;- Ask location
I '$$ASKLOC^ECMUTL G ENQ
;
;- Ask DSS Unit
I $$ONEUNIT^ECMUTL(.ECDSSU),('$D(ECDSSU)) G ENQ
;
;- Ask providers (provider 1 is required, providers 2..n optional)
D ASKPRV^ECPRVMUT("",DT,.ECU,.ECOUT) I $G(ECOUT) G ENQ
;
;- Ask procedure date(s)
I '$$ASKPRDT^ECMUTL(+$P(ECDSSU,"^")) G ENQ
;
;- Ask category
S ECCAT=$$ASKCAT^ECMUTL(ECL,+$P(ECDSSU,"^"))
I $G(ECCAT)="" G ENQ
;
;- Ask procedure(s)
D ASKPRO^ECMUTL(ECL,+$P(ECDSSU,"^"),+$P(ECCAT,"^"))
I '$D(^TMP("ECPROC",$J)) G ENQ
;
D WAIT^DICD
;
;- Call 1st ListMan screen (procedure dates/procedures)
D EN^ECMLMP
;
;- Flag to go to 2nd ListMan screen and data in array must exist to continue
I '$G(ECNFLG)!($G(ECNFLG)&('$D(^TMP("ECMPIDX",$J)))) G ENQ
;
;- Call 2nd ListMan screen (patients)
D EN^ECMLMN
;
;- Flag to go to filing routine and data in array must exist to continue
I '$G(ECFFLG)!($G(ECFFLG)&('$D(^TMP("ECMPTIDX",$J)))) G ENQ
;
;- Call filing routine
D EN^ECMLMF
Q
;
ENQ ;- clean up and exit
K ^TMP("ECPRDT",$J),^TMP("ECPROC",$J),^TMP("ECPAT",$J)
K ^TMP("ECMPIDX",$J),^TMP("ECMPTIDX",$J),^TMP("ECPLST",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECMLMD 1434 printed Dec 13, 2024@01:57:42 Page 2
ECMLMD ;ALB/ESD - Multiple Dates/Multiple Procedures Driver ;20 AUG 1997 13:56
+1 ;;2.0; EVENT CAPTURE ;**5,15,72**;8 May 96
+2 ;
EN ;- Entry point for Multiple Date/Multiple Procedures Data Entry Option
+1 ;
+2 NEW ECCAT,ECDSSU,ECFFLG,ECL,ECLN,ECNFLG,ECPRDT,ECPROC,ECU
+3 ;
+4 ;- Ask location
+5 IF '$$ASKLOC^ECMUTL
GOTO ENQ
+6 ;
+7 ;- Ask DSS Unit
+8 IF $$ONEUNIT^ECMUTL(.ECDSSU)
IF ('$DATA(ECDSSU))
GOTO ENQ
+9 ;
+10 ;- Ask providers (provider 1 is required, providers 2..n optional)
+11 DO ASKPRV^ECPRVMUT("",DT,.ECU,.ECOUT)
IF $GET(ECOUT)
GOTO ENQ
+12 ;
+13 ;- Ask procedure date(s)
+14 IF '$$ASKPRDT^ECMUTL(+$PIECE(ECDSSU,"^"))
GOTO ENQ
+15 ;
+16 ;- Ask category
+17 SET ECCAT=$$ASKCAT^ECMUTL(ECL,+$PIECE(ECDSSU,"^"))
+18 IF $GET(ECCAT)=""
GOTO ENQ
+19 ;
+20 ;- Ask procedure(s)
+21 DO ASKPRO^ECMUTL(ECL,+$PIECE(ECDSSU,"^"),+$PIECE(ECCAT,"^"))
+22 IF '$DATA(^TMP("ECPROC",$JOB))
GOTO ENQ
+23 ;
+24 DO WAIT^DICD
+25 ;
+26 ;- Call 1st ListMan screen (procedure dates/procedures)
+27 DO EN^ECMLMP
+28 ;
+29 ;- Flag to go to 2nd ListMan screen and data in array must exist to continue
+30 IF '$GET(ECNFLG)!($GET(ECNFLG)&('$DATA(^TMP("ECMPIDX",$JOB))))
GOTO ENQ
+31 ;
+32 ;- Call 2nd ListMan screen (patients)
+33 DO EN^ECMLMN
+34 ;
+35 ;- Flag to go to filing routine and data in array must exist to continue
+36 IF '$GET(ECFFLG)!($GET(ECFFLG)&('$DATA(^TMP("ECMPTIDX",$JOB))))
GOTO ENQ
+37 ;
+38 ;- Call filing routine
+39 DO EN^ECMLMF
+40 QUIT
+41 ;
ENQ ;- clean up and exit
+1 KILL ^TMP("ECPRDT",$JOB),^TMP("ECPROC",$JOB),^TMP("ECPAT",$JOB)
+2 KILL ^TMP("ECMPIDX",$JOB),^TMP("ECMPTIDX",$JOB),^TMP("ECPLST",$JOB)
+3 QUIT
