ECMLMD.m

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 ---ECMLMD   1434     printed  Apr 09, 2024@21:02                                                                                                                                                                                                         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