BDWREDO.m

BDWREDO ; IHS/CMI/LAB - REDO A RUN ;

 ;;1.0;IHS DATA WAREHOUSE;**2,4**;JAN 23, 2006;Build 24

START ;

 D EN^XBVK("BDW")

 I $D(^BDWTMP) W !!,"Previous run not completed." Q

 S BDWO("RUN")="REDO" ;     Let ^BDWRDRI know this is a 'REDO'

 S BDWO("RUN TYPE")="REX"

 D ^BDWRDRI ;           

 I BDW("QFLG")=66 W:'$D(ZTQUEUED) !,"Contact your site manager.  ^BDWTMP still exists." D  D EOJ Q

 .S DIR(0)="EO",DIR("A")="Press any key to continue" K DA D ^DIR K DIR

 I BDW("QFLG") D EOJ W !!,"Bye",!! Q

 D INIT ;               Get Log entry to redo

 I BDW("QFLG") D EOJ W !!,"Bye",!! Q

 D QUEUE^BDWRDRI

 I BDW("QFLG") D EOJ W !!,"Bye",!! Q

 I $D(BDWO("QUEUE")) D EOJ W !!,"Okay your request is queued!",!! Q

 ;

EN ;EP FROM TASKMAN

 S BDWLOG=BDW("RUN LOG")

 S BDWCNT=$S('$D(ZTQUEUED):"X BDWCNT1  X BDWCNT2",1:"S BDWCNTR=BDWCNTR+1"),BDWCNT1="F BDWCNTL=1:1:$L(BDWCNTR)+1 W @BDWBS",BDWCNT2="S BDWCNTR=BDWCNTR+1 W BDWCNTR,"")"""

 D NOW^%DTC S BDW("RUN START")=%,BDW("MAIN TX DATE")=$P(%,".") K %,%H,%I

 D ^XBFMK S DA=BDWLOG,DIE="^BDWXLOG(",DR=".03////"_BDW("RUN START")_";.15///R"_";.22///1" D ^DIE,^XBFMK

 S BDW("BT")=$HOROLOG

 D PROCESS ;            Generate transactions

 I BDW("QFLG") W:'$D(ZTQUEUED) !!,"Abnormal termination!  QFLG=",BDW("QFLG") D:$D(ZTQUEUED) ABORT D EOJ Q

 D ALPMR^BDWRDR2  ;generate ALPMR patient centric messages

 I BDW("QFLG") W:'$D(ZTQUEUED) !!,"Abnormal termination!  QFLG=",BDW("QFLG") D:$D(ZTQUEUED) ABORT D EOJ Q

 D LOG ;                Update Log entry

 I BDW("QFLG") W:'$D(ZTQUEUED) !!,"Log error! ",BDW("QFLG") D:$D(ZTQUEUED) ABORT D EOJ Q

 D RUNTIME^BDWRDR

 S BDWMSGT=$$DW1TRLR^BHLEVENT(90213,BDW("RUN LOG"))

 S ^BDWTMP(BDWIEDST,BDWMSGT)=""

 S DA=BDW("RUN LOG"),DIE="^BDWXLOG(",DR=".13////"_BDWRUN_";.14////"_BDWMSGT_";.15////C" D ^DIE

 D:'$D(ZTQUEUED) CHKLOG ;             See if Log needs cleaning

 D RESETV ;             Reset VISITs processed in Log

 I '$D(ZTQUEUED) S DIR(0)="EO",DIR("A")="DONE -- Press ENTER to Continue" K DA D ^DIR K DIR

 D EOJ

 Q

 ;

PROCESS ;

 D GIS^BDW1VBLI

 S BDWMSGH=$$DW1HDR^BHLEVENT(90213,BDW("RUN LOG"))

 S ^BDWTMP(BDWIEDST,BDWMSGH)=""

 D ^XBFMK S DA=BDWLOG,DIE="^BDWXLOG(",DR=".12////"_BDWMSGH D ^DIE,^XBFMK

 S ^XTMP("BDWREDO",0)=$$FMADD^XLFDT(DT,14)_U_DT_U_"DATA WAREHOUSE EXPORT REDO" ;IHS/CMI/LAB

 W:'$D(ZTQUEUED) !,"Generating transactions.  Counting encounters.  (1)" S BDWCNTR=0

 S BDWDFN=0 F  S BDWDFN=$O(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN)) Q:BDWDFN'=+BDWDFN  D

 .K INA("DELETE"),BDWDELF,BDWDELT

 .I '$D(^AUPNPAT(BDWDFN,0)) Q

 .I '$D(^DPT(BDWDFN,0)) Q

 .S BDWDELF=$P(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),U,13),BDWDELT=$P(^DPT(BDWDFN,0),U,19)

 .I 'BDWDELF,'$$ORF^BDWUTIL1(BDWDFN) Q

 .K BDWR S Y=^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),BDWR("BASE")=$P(Y,U,2),BDWR("DEMO")=$P(Y,U,3),BDWR("ALIAS")=$P(Y,U,4),BDWR("CHART")=$P(Y,U,5),BDWR("ELIG")=$P(Y,U,6)

 .I BDWDELF S INA("DELETE")=BDWDELT

 .S INA=0

 .I BDWDELF D

 ..S INA("DELETE")=BDWDFN

 ..S BDWM=$$DW1MRG^BHLEVENT(BDWDELT,.INA)

 .I 'BDWDELF D

 ..S BDWM=$$DW1REG^BHLEVENT(BDWDFN,.INA)

 .S BDW("REG")=BDW("REG")+1,^BDWTMP(BDWIEDST,BDWM)=""

 .S $P(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),U,7)=BDWM

 .K INA("DELETE"),BDWDELT,BDWDELF

 K ^BDWXLOG(BDW("RUN LOG"),51)  ;clean out old error log

 S BDW("V DFN")=0 F  S BDW("V DFN")=$O(^BDWXLOG(BDW("RUN LOG"),21,BDW("V DFN"))) Q:BDW("V DFN")'=+BDW("V DFN")  D PROCESS2 Q:BDW("QFLG")

 Q

PROCESS2 ;

 K BDWE,BDWV

 X BDWCNT

 S ^XTMP("BDWREDO","MAIN TX",BDW("V DFN"))="",BDWV("TX GENERATED")=0

 I '$D(^AUPNVSIT(BDW("V DFN"))) Q

 S BDW("VPROC")=BDW("VPROC")+1

 S BDWV("V REC")=^AUPNVSIT(BDW("V DFN"),0)

 S BDWV("V DATE")=+BDWV("V REC")\1

 I $P(BDWV("V REC"),U,11),$P($G(^AUPNVSIT(BDW("V DFN"),11)),U,6)="" D  G SETUTIL

 .S BDWE("ERROR")=100 D ^BDWRERR

 K BDWVMSG D ^BDWRDR2

SETUTIL S ^XTMP("BDWREDO",BDW("V DFN"))=BDW("V DFN")_U_BDWV("TX GENERATED")_U_$G(BDWVMSG)

 Q

 ;

 ;

CHKLOG ; CHECK LOG FILE

 S BDW("X")=0 F BDW("I")=BDW("RUN LOG"):-1:1 Q:'$D(^BDWXLOG(BDW("I")))  I $O(^BDWXLOG(BDW("I"),21,0)) S BDW("X")=BDW("X")+1

 I BDW("X")>3 W !!,"-->There are more than three generations of VISITs stored in the LOG file.",!,"-->Time to do a purge."

 Q

 ;

RESETV ; RESET VISIT DATA IN LOG

 W:'$D(ZTQUEUED) !,"Resetting VISIT specific data in Log file.  (1)" S BDWCNTR=0

 S BDW("X")=0 F  S BDW("X")=$O(^XTMP("BDWREDO",BDW("X"))) Q:BDW("X")'=+BDW("X")  S BDW("Y")=^(BDW("X")),^BDWXLOG(BDW("RUN LOG"),21,BDW("X"),0)=BDW("Y") X BDWCNT ;FORGIVE ME LORD

 W:'$D(ZTQUEUED) !,"Resetting VISIT TX Flags. (1)" S BDWCNTR=0

 S BDW("X")=0 F  S BDW("X")=$O(^XTMP("BDWREDO","MAIN TX",BDW("X"))) Q:BDW("X")'=+BDW("X")  D

 .S DIE="^AUPNVSIT(",DA=BDW("X"),DR="1106///"_$S(^XTMP("BDWREDO","MAIN TX",BDW("X"))]"":^XTMP("BDWREDO","MAIN TX",BDW("X")),1:"@") D ^DIE K DA,DR X BDWCNT

 .Q

 K ^XTMP("BDWREDO")

 Q

 ;

LOG ; UPDATE LOG

 S BDW("COUNT")=BDW("REG")+BDW("VISITS") W:'$D(ZTQUEUED) !!,BDW("COUNT")," HL7 Messages were generated."

 W:'$D(ZTQUEUED) !,"Updating log entry."

 D NOW^%DTC S BDW("RUN STOP")=%

 S DA=BDW("RUN LOG"),DIE="^BDWXLOG(",DR=".04////"_BDW("RUN STOP")_";.05////"_BDW("SKIP")_";.06////"_BDW("COUNT")_";.08///"_BDW("VPROC") D ^DIE I $D(Y) S BDW("QFLG")=26 Q

 K DIE,DA,DR

 S DA=BDW("RUN LOG"),DIE="^BDWXLOG(",DR=".11////"_BDW("REG")_";.12////"_BDWMSGH_";.18////"_$G(BDW("VISITS"))_";.23///REX" D ^DIE I $D(Y) S BDW("QFLG")=26 Q

 K DR,DIE,DA,DIV,DIU

 S DIE="^BDWXLOG(",DA=BDW("RUN LOG"),DR="3101////"_BDW("DEMO")_";3102////"_BDW("ZERO")_";3103////"_BDW("DEL")_";3104////"_BDW("NO PAT")_";3105////"_BDW("NO LOC")_";3106////"_BDW("NO TYPE")_";3107////"_BDW("NO CAT")_";3111////"_BDW("MFI")

 D ^DIE I $D(Y) S BDW("QFLG")=26 Q

 S DA=BDW("RUN LOG"),DIK="^BDWXLOG(" D IX1^DIK K DA,DIK

 D ^XBFMK

 ;

 Q

INIT ;

 D INIT^BDWRED1

 Q

ABORT ; ABNORMAL TERMINATION

 I $D(BDW("RUN LOG")) S BDW("QFLG1")=$O(^BDWERRC("B",BDW("QFLG"),"")),DA=BDW("RUN LOG"),DIE="^BDWXLOG(",DR=".15///F;.16////"_BDW("QFLG1")

 I $D(ZTQUEUED) D ERRBULL^BDWRDRI3,EOJ Q

 W !!,"Abnormal termination!!  QFLG=",BDW("QFLG")

 S DIR(0)="EO",DIR("A")="Press any key to continue" K DA D ^DIR K DIR

 Q

 ;

EOJ ;

 K AUPNVSIT

 D EN^XBVK("BDW"),KILL^AUPNPAT

 I $D(ZTQUEUED) S ZTREQ="@"

 Q

BDWREDO   ; IHS/CMI/LAB - REDO A RUN ;

 +1       ;;1.0;IHS DATA WAREHOUSE;**2,4**;JAN 23, 2006;Build 24

START     ;

 +1        DO EN^XBVK("BDW")

 +2        IF $DATA(^BDWTMP)

               WRITE !!,"Previous run not completed."

               QUIT 

 +3       ;     Let ^BDWRDRI know this is a 'REDO'

           SET BDWO("RUN")="REDO"

 +4        SET BDWO("RUN TYPE")="REX"

 +5       ;           

           DO ^BDWRDRI

 +6        IF BDW("QFLG")=66

               IF '$DATA(ZTQUEUED)

                   WRITE !,"Contact your site manager.  ^BDWTMP still exists."

               Begin DoDot:1

 +7                SET DIR(0)="EO"

                   SET DIR("A")="Press any key to continue"

                   KILL DA

                   DO ^DIR

                   KILL DIR

               End DoDot:1

               DO EOJ

               QUIT 

 +8        IF BDW("QFLG")

               DO EOJ

               WRITE !!,"Bye",!!

               QUIT 

 +9       ;               Get Log entry to redo

           DO INIT

 +10       IF BDW("QFLG")

               DO EOJ

               WRITE !!,"Bye",!!

               QUIT 

 +11       DO QUEUE^BDWRDRI

 +12       IF BDW("QFLG")

               DO EOJ

               WRITE !!,"Bye",!!

               QUIT 

 +13       IF $DATA(BDWO("QUEUE"))

               DO EOJ

               WRITE !!,"Okay your request is queued!",!!

               QUIT 

 +14      ;

EN        ;EP FROM TASKMAN

 +1        SET BDWLOG=BDW("RUN LOG")

 +2        SET BDWCNT=$SELECT('$DATA(ZTQUEUED):"X BDWCNT1  X BDWCNT2",1:"S BDWCNTR=BDWCNTR+1")

           SET BDWCNT1="F BDWCNTL=1:1:$L(BDWCNTR)+1 W @BDWBS"

           SET BDWCNT2="S BDWCNTR=BDWCNTR+1 W BDWCNTR,"")"""

 +3        DO NOW^%DTC

           SET BDW("RUN START")=%

           SET BDW("MAIN TX DATE")=$PIECE(%,".")

           KILL %,%H,%I

 +4        DO ^XBFMK

           SET DA=BDWLOG

           SET DIE="^BDWXLOG("

           SET DR=".03////"_BDW("RUN START")_";.15///R"_";.22///1"

           DO ^DIE

           DO ^XBFMK

 +5        SET BDW("BT")=$HOROLOG

 +6       ;            Generate transactions

           DO PROCESS

 +7        IF BDW("QFLG")

               IF '$DATA(ZTQUEUED)

                   WRITE !!,"Abnormal termination!  QFLG=",BDW("QFLG")

               IF $DATA(ZTQUEUED)

                   DO ABORT

               DO EOJ

               QUIT 

 +8       ;generate ALPMR patient centric messages

           DO ALPMR^BDWRDR2

 +9        IF BDW("QFLG")

               IF '$DATA(ZTQUEUED)

                   WRITE !!,"Abnormal termination!  QFLG=",BDW("QFLG")

               IF $DATA(ZTQUEUED)

                   DO ABORT

               DO EOJ

               QUIT 

 +10      ;                Update Log entry

           DO LOG

 +11       IF BDW("QFLG")

               IF '$DATA(ZTQUEUED)

                   WRITE !!,"Log error! ",BDW("QFLG")

               IF $DATA(ZTQUEUED)

                   DO ABORT

               DO EOJ

               QUIT 

 +12       DO RUNTIME^BDWRDR

 +13       SET BDWMSGT=$$DW1TRLR^BHLEVENT(90213,BDW("RUN LOG"))

 +14       SET ^BDWTMP(BDWIEDST,BDWMSGT)=""

 +15       SET DA=BDW("RUN LOG")

           SET DIE="^BDWXLOG("

           SET DR=".13////"_BDWRUN_";.14////"_BDWMSGT_";.15////C"

           DO ^DIE

 +16      ;             See if Log needs cleaning

           IF '$DATA(ZTQUEUED)

               DO CHKLOG

 +17      ;             Reset VISITs processed in Log

           DO RESETV

 +18       IF '$DATA(ZTQUEUED)

               SET DIR(0)="EO"

               SET DIR("A")="DONE -- Press ENTER to Continue"

               KILL DA

               DO ^DIR

               KILL DIR

 +19       DO EOJ

 +20       QUIT 

 +21      ;

PROCESS   ;

 +1        DO GIS^BDW1VBLI

 +2        SET BDWMSGH=$$DW1HDR^BHLEVENT(90213,BDW("RUN LOG"))

 +3        SET ^BDWTMP(BDWIEDST,BDWMSGH)=""

 +4        DO ^XBFMK

           SET DA=BDWLOG

           SET DIE="^BDWXLOG("

           SET DR=".12////"_BDWMSGH

           DO ^DIE

           DO ^XBFMK

 +5       ;IHS/CMI/LAB

           SET ^XTMP("BDWREDO",0)=$$FMADD^XLFDT(DT,14)_U_DT_U_"DATA WAREHOUSE EXPORT REDO"

 +6        IF '$DATA(ZTQUEUED)

               WRITE !,"Generating transactions.  Counting encounters.  (1)"

           SET BDWCNTR=0

 +7        SET BDWDFN=0

           FOR 

               SET BDWDFN=$ORDER(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN))

               IF BDWDFN'=+BDWDFN

                   QUIT 

               Begin DoDot:1

 +8                KILL INA("DELETE"),BDWDELF,BDWDELT

 +9                IF '$DATA(^AUPNPAT(BDWDFN,0))

                       QUIT 

 +10               IF '$DATA(^DPT(BDWDFN,0))

                       QUIT 

 +11               SET BDWDELF=$PIECE(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),U,13)

                   SET BDWDELT=$PIECE(^DPT(BDWDFN,0),U,19)

 +12               IF 'BDWDELF

                       IF '$$ORF^BDWUTIL1(BDWDFN)

                           QUIT 

 +13               KILL BDWR

                   SET Y=^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0)

                   SET BDWR("BASE")=$PIECE(Y,U,2)

                   SET BDWR("DEMO")=$PIECE(Y,U,3)

                   SET BDWR("ALIAS")=$PIECE(Y,U,4)

                   SET BDWR("CHART")=$PIECE(Y,U,5)

                   SET BDWR("ELIG")=$PIECE(Y,U,6)

 +14               IF BDWDELF

                       SET INA("DELETE")=BDWDELT

 +15               SET INA=0

 +16               IF BDWDELF

                       Begin DoDot:2

 +17                       SET INA("DELETE")=BDWDFN

 +18                       SET BDWM=$$DW1MRG^BHLEVENT(BDWDELT,.INA)

                       End DoDot:2

 +19               IF 'BDWDELF

                       Begin DoDot:2

 +20                       SET BDWM=$$DW1REG^BHLEVENT(BDWDFN,.INA)

                       End DoDot:2

 +21               SET BDW("REG")=BDW("REG")+1

                   SET ^BDWTMP(BDWIEDST,BDWM)=""

 +22               SET $PIECE(^BDWXLOG(BDW("RUN LOG"),41,BDWDFN,0),U,7)=BDWM

 +23               KILL INA("DELETE"),BDWDELT,BDWDELF

               End DoDot:1

 +24      ;clean out old error log

           KILL ^BDWXLOG(BDW("RUN LOG"),51)

 +25       SET BDW("V DFN")=0

           FOR 

               SET BDW("V DFN")=$ORDER(^BDWXLOG(BDW("RUN LOG"),21,BDW("V DFN")))

               IF BDW("V DFN")'=+BDW("V DFN")

                   QUIT 

               DO PROCESS2

               IF BDW("QFLG")

                   QUIT 

 +26       QUIT 

PROCESS2  ;

 +1        KILL BDWE,BDWV

 +2        XECUTE BDWCNT

 +3        SET ^XTMP("BDWREDO","MAIN TX",BDW("V DFN"))=""

           SET BDWV("TX GENERATED")=0

 +4        IF '$DATA(^AUPNVSIT(BDW("V DFN")))

               QUIT 

 +5        SET BDW("VPROC")=BDW("VPROC")+1

 +6        SET BDWV("V REC")=^AUPNVSIT(BDW("V DFN"),0)

 +7        SET BDWV("V DATE")=+BDWV("V REC")\1

 +8        IF $PIECE(BDWV("V REC"),U,11)

               IF $PIECE($GET(^AUPNVSIT(BDW("V DFN"),11)),U,6)=""

                   Begin DoDot:1

 +9                    SET BDWE("ERROR")=100

                       DO ^BDWRERR

                   End DoDot:1

                   GOTO SETUTIL

 +10       KILL BDWVMSG

           DO ^BDWRDR2

SETUTIL    SET ^XTMP("BDWREDO",BDW("V DFN"))=BDW("V DFN")_U_BDWV("TX GENERATED")_U_$GET(BDWVMSG)

 +1        QUIT 

 +2       ;

 +3       ;

CHKLOG    ; CHECK LOG FILE

 +1        SET BDW("X")=0

           FOR BDW("I")=BDW("RUN LOG"):-1:1

               IF '$DATA(^BDWXLOG(BDW("I")))

                   QUIT 

               IF $ORDER(^BDWXLOG(BDW("I"),21,0))

                   SET BDW("X")=BDW("X")+1

 +2        IF BDW("X")>3

               WRITE !!,"-->There are more than three generations of VISITs stored in the LOG file.",!,"-->Time to do a purge."

 +3        QUIT 

 +4       ;

RESETV    ; RESET VISIT DATA IN LOG

 +1        IF '$DATA(ZTQUEUED)

               WRITE !,"Resetting VISIT specific data in Log file.  (1)"

           SET BDWCNTR=0

 +2       ;FORGIVE ME LORD

           SET BDW("X")=0

           FOR 

               SET BDW("X")=$ORDER(^XTMP("BDWREDO",BDW("X")))

               IF BDW("X")'=+BDW("X")

                   QUIT 

               SET BDW("Y")=^(BDW("X"))

               SET ^BDWXLOG(BDW("RUN LOG"),21,BDW("X"),0)=BDW("Y")

               XECUTE BDWCNT

 +3        IF '$DATA(ZTQUEUED)

               WRITE !,"Resetting VISIT TX Flags. (1)"

           SET BDWCNTR=0

 +4        SET BDW("X")=0

           FOR 

               SET BDW("X")=$ORDER(^XTMP("BDWREDO","MAIN TX",BDW("X")))

               IF BDW("X")'=+BDW("X")

                   QUIT 

               Begin DoDot:1

 +5                SET DIE="^AUPNVSIT("

                   SET DA=BDW("X")

                   SET DR="1106///"_$SELECT(^XTMP("BDWREDO","MAIN TX",BDW("X"))]"":^XTMP("BDWREDO","MAIN TX",BDW("X")),1:"@")

                   DO ^DIE

                   KILL DA,DR

                   XECUTE BDWCNT

 +6                QUIT 

               End DoDot:1

 +7        KILL ^XTMP("BDWREDO")

 +8        QUIT 

 +9       ;

LOG       ; UPDATE LOG

 +1        SET BDW("COUNT")=BDW("REG")+BDW("VISITS")

           IF '$DATA(ZTQUEUED)

               WRITE !!,BDW("COUNT")," HL7 Messages were generated."

 +2        IF '$DATA(ZTQUEUED)

               WRITE !,"Updating log entry."

 +3        DO NOW^%DTC

           SET BDW("RUN STOP")=%

 +4        SET DA=BDW("RUN LOG")

           SET DIE="^BDWXLOG("

           SET DR=".04////"_BDW("RUN STOP")_";.05////"_BDW("SKIP")_";.06////"_BDW("COUNT")_";.08///"_BDW("VPROC")

           DO ^DIE

           IF $DATA(Y)

               SET BDW("QFLG")=26

               QUIT 

 +5        KILL DIE,DA,DR

 +6        SET DA=BDW("RUN LOG")

           SET DIE="^BDWXLOG("

           SET DR=".11////"_BDW("REG")_";.12////"_BDWMSGH_";.18////"_$GET(BDW("VISITS"))_";.23///REX"

           DO ^DIE

           IF $DATA(Y)

               SET BDW("QFLG")=26

               QUIT 

 +7        KILL DR,DIE,DA,DIV,DIU

 +8        SET DIE="^BDWXLOG("

           SET DA=BDW("RUN LOG")

           SET DR="3101////"_BDW("DEMO")_";3102////"_BDW("ZERO")_";3103////"_BDW("DEL")_";3104////"_BDW("NO PAT")_";3105////"_BDW("NO LOC")_";3106////"_BDW("NO TYPE")_";3107////"_BDW("NO CAT")_";3111////"_BDW("MFI")

 +9        DO ^DIE

           IF $DATA(Y)

               SET BDW("QFLG")=26

               QUIT 

 +10       SET DA=BDW("RUN LOG")

           SET DIK="^BDWXLOG("

           DO IX1^DIK

           KILL DA,DIK

 +11       DO ^XBFMK

 +12      ;

 +13       QUIT 

INIT      ;

 +1        DO INIT^BDWRED1

 +2        QUIT 

ABORT     ; ABNORMAL TERMINATION

 +1        IF $DATA(BDW("RUN LOG"))

               SET BDW("QFLG1")=$ORDER(^BDWERRC("B",BDW("QFLG"),""))

               SET DA=BDW("RUN LOG")

               SET DIE="^BDWXLOG("

               SET DR=".15///F;.16////"_BDW("QFLG1")

 +2        IF $DATA(ZTQUEUED)

               DO ERRBULL^BDWRDRI3

               DO EOJ

               QUIT 

 +3        WRITE !!,"Abnormal termination!!  QFLG=",BDW("QFLG")

 +4        SET DIR(0)="EO"

           SET DIR("A")="Press any key to continue"

           KILL DA

           DO ^DIR

           KILL DIR

 +5        QUIT 

 +6       ;

EOJ       ;

 +1        KILL AUPNVSIT

 +2        DO EN^XBVK("BDW")

           DO KILL^AUPNPAT

 +3        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +4        QUIT