BCHEXDI.m

BCHEXDI ; IHS/CMI/LAB - INIT FOR CHR EXPORT ; 

 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 ;

 ;Initialization for export process.

 ;Set up all necessary variables, check site file, etc.

 ;

START ;

 D BASICS ;      Set variables like U,DT,DUZ(2) etc.

 D CHKSITE ;     Make sure Site file has correct fields.

 Q:BCH("QFLG")

 ;

 D:BCHO("RUN")="NEW" ^BCHEXDI2 ;  Do new run initialization.

 Q:$D(ZTQUEUED)

 Q:BCH("QFLG")

 D:BCHO("RUN")="NEW" QUEUE

 Q

 ;

BASICS ; BASIC INITS

 D HOME^%ZIS S BCHBS=$S('$D(ZTQUEUED):IOBS,1:"")

 K BCH,BCHS,BCHV,BCHT,BCHE

 S BCH("RUN LOCATION")=$P(^AUTTLOC(DUZ(2),0),U,10),BCH("QFLG")=0

 S (BCH("U"),BCH("D"),BCH("ERROR COUNT"),BCH("COUNT"),BCH("VISIT COUNT"))=0

 Q

 ;

CHKSITE ; CHECK SITE FILE

 I '$D(^BCHSITE(DUZ(2),0)) W:'$D(ZTQUEUED) !!,"*** Site file has not been setup! ***" S BCH("QFLG")=1 Q

 I '$D(^BCHSITE(DUZ(2))) W:'$D(ZTQUEUED) !!,"*** RUN LOCATION not in SITE file!" S BCH("QFLG")=2 Q

 ;I $P(^BCHSITE(DUZ(2),0),U,8)="" W:'$D(ZTQUEUED) !!,"*** Site file does not specify EXPORT METHOD" S BCH("QFLG")=3 Q

 ;I $P(^BCHSITE(DUZ(2),0),U,7)="",$P(^BCHSITE(DUZ(2),0),U,8)="A" W:'$D(ZTQUEUED) !!,"***No DEFAULT DEVICE value in Site file! ***" S BCH("QFLG")=4

 Q

 ;

 ;

 ;

QUEUE ;EP - QUEUE TX GENERATOR

 K ZTSK

 S DIR(0)="Y",DIR("A")="Do you want to QUEUE this to run at a later time",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y=1 D QUEUE1 Q

 I BCHO("RUN")="NEW",$D(DIRUT) S BCH("QFLG")=99 S DA=BCH("RUN LOG"),DIK="^BCHXLOG(" W !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",! D ^DIK K DIK,DA

 I BCHO("RUN")="REDO",$D(DIRUT) S BCH("QFLG")=99 Q

 Q

QUEUE1 ;

 S ZTRTN=$S(BCHO("RUN")="NEW":"DRIVER^BCHEXD",1:"EN^BCHEXRE")

 S ZTIO="",ZTDTH="",ZTDESC="CHR CHR EXPORT" S ZTSAVE("BCH*")="",ZTSAVE("APCD*")=""

 D ^%ZTLOAD

 W !!,$S($D(ZTSK):"Request Queued!!",1:"Request cancelled")

 I '$D(ZTSK),BCHO("RUN")="NEW" S BCH("QFLG")=99 S DA=BCH("RUN LOG"),DIK="^BCHXLOG(" W !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",! D ^DIK K DIK,DA Q  ;LAB/OHPRD BCH*1.51*2 ADDED BCHO("RUN")="NEW"

 S BCHO("QUEUE")=""

 S DIE="^BCHXLOG(",DA=BCH("RUN LOG"),DR=".15///Q" D CALLDIE^BCHUTIL

 K ZTSK

 Q

BCHEXDI   ; IHS/CMI/LAB - INIT FOR CHR EXPORT ; 

 +1       ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 +2       ;

 +3       ;Initialization for export process.

 +4       ;Set up all necessary variables, check site file, etc.

 +5       ;

START     ;

 +1       ;      Set variables like U,DT,DUZ(2) etc.

           DO BASICS

 +2       ;     Make sure Site file has correct fields.

           DO CHKSITE

 +3        IF BCH("QFLG")

               QUIT 

 +4       ;

 +5       ;  Do new run initialization.

           IF BCHO("RUN")="NEW"

               DO ^BCHEXDI2

 +6        IF $DATA(ZTQUEUED)

               QUIT 

 +7        IF BCH("QFLG")

               QUIT 

 +8        IF BCHO("RUN")="NEW"

               DO QUEUE

 +9        QUIT 

 +10      ;

BASICS    ; BASIC INITS

 +1        DO HOME^%ZIS

           SET BCHBS=$SELECT('$DATA(ZTQUEUED):IOBS,1:"")

 +2        KILL BCH,BCHS,BCHV,BCHT,BCHE

 +3        SET BCH("RUN LOCATION")=$PIECE(^AUTTLOC(DUZ(2),0),U,10)

           SET BCH("QFLG")=0

 +4        SET (BCH("U"),BCH("D"),BCH("ERROR COUNT"),BCH("COUNT"),BCH("VISIT COUNT"))=0

 +5        QUIT 

 +6       ;

CHKSITE   ; CHECK SITE FILE

 +1        IF '$DATA(^BCHSITE(DUZ(2),0))

               IF '$DATA(ZTQUEUED)

                   WRITE !!,"*** Site file has not been setup! ***"

               SET BCH("QFLG")=1

               QUIT 

 +2        IF '$DATA(^BCHSITE(DUZ(2)))

               IF '$DATA(ZTQUEUED)

                   WRITE !!,"*** RUN LOCATION not in SITE file!"

               SET BCH("QFLG")=2

               QUIT 

 +3       ;I $P(^BCHSITE(DUZ(2),0),U,8)="" W:'$D(ZTQUEUED) !!,"*** Site file does not specify EXPORT METHOD" S BCH("QFLG")=3 Q

 +4       ;I $P(^BCHSITE(DUZ(2),0),U,7)="",$P(^BCHSITE(DUZ(2),0),U,8)="A" W:'$D(ZTQUEUED) !!,"***No DEFAULT DEVICE value in Site file! ***" S BCH("QFLG")=4

 +5        QUIT 

 +6       ;

 +7       ;

 +8       ;

QUEUE     ;EP - QUEUE TX GENERATOR

 +1        KILL ZTSK

 +2        SET DIR(0)="Y"

           SET DIR("A")="Do you want to QUEUE this to run at a later time"

           SET DIR("B")="N"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF Y=1

               DO QUEUE1

               QUIT 

 +4        IF BCHO("RUN")="NEW"

               IF $DATA(DIRUT)

                   SET BCH("QFLG")=99

                   SET DA=BCH("RUN LOG")

                   SET DIK="^BCHXLOG("

                   WRITE !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",!

                   DO ^DIK

                   KILL DIK,DA

 +5        IF BCHO("RUN")="REDO"

               IF $DATA(DIRUT)

                   SET BCH("QFLG")=99

                   QUIT 

 +6        QUIT 

QUEUE1    ;

 +1        SET ZTRTN=$SELECT(BCHO("RUN")="NEW":"DRIVER^BCHEXD",1:"EN^BCHEXRE")

 +2        SET ZTIO=""

           SET ZTDTH=""

           SET ZTDESC="CHR CHR EXPORT"

           SET ZTSAVE("BCH*")=""

           SET ZTSAVE("APCD*")=""

 +3        DO ^%ZTLOAD

 +4        WRITE !!,$SELECT($DATA(ZTSK):"Request Queued!!",1:"Request cancelled")

 +5       ;LAB/OHPRD BCH*1.51*2 ADDED BCHO("RUN")="NEW"

           IF '$DATA(ZTSK)

               IF BCHO("RUN")="NEW"

                   SET BCH("QFLG")=99

                   SET DA=BCH("RUN LOG")

                   SET DIK="^BCHXLOG("

                   WRITE !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",!

                   DO ^DIK

                   KILL DIK,DA

                   QUIT 

 +6        SET BCHO("QUEUE")=""

 +7        SET DIE="^BCHXLOG("

           SET DA=BCH("RUN LOG")

           SET DR=".15///Q"

           DO CALLDIE^BCHUTIL

 +8        KILL ZTSK

 +9        QUIT