source: FOIAVistA/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECMLMD.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 1.4 KB
Line 
1ECMLMD ;ALB/ESD - Multiple Dates/Multiple Procedures Driver ;20 AUG 1997 13:56
2 ;;2.0; EVENT CAPTURE ;**5,15,72**;8 May 96
3 ;
4EN ;- 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 ;
46ENQ ;- 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
Note: See TracBrowser for help on using the repository browser.