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