Routine: BDWEPRN

BDWEPRN ; IHS/CMI/LAB - Display TX ERRORS AUGUST 14, 1992 ;

 ;;1.0;IHS DATA WAREHOUSE;;JAN 23, 2006

LOG ;get log entry

 W !!,"Data Warehouse Transmission Error Listing",!

 S DIC="^BDWXLOG(",DIC(0)="AEMQ" D ^DIC K DIC I Y=-1 W !!,"Goodbye" G XIT

 S BDWLOG=+Y S BDWD=BDWLOG

 I '$D(^BDWXLOG(BDWLOG,51)) W !!,"No TX errors generated on that run." G LOG

LOC ;

 K BDWLOCT

 S DIR(0)="S^A:ALL Locations/Facilities;S:One SERVICE UNIT'S Locations/Facilities;O:ONE Location/Facility",DIR("A")="Include Visits to Which Location/Facilities",DIR("B")="A"

 S DIR("A")="Enter a code indicating what LOCATIONS/FACILITIES are of interest",DIR("B")="O" K DA D ^DIR K DIR,DA

 G:$D(DIRUT) LOG

 S BDWLOCT=Y

 I BDWLOCT="A" K BDWLOCT G ZIS

 D @BDWLOCT

 G:$D(BDWQ) LOC

ZIS ;call xbdbque

 S XBRC="DRIVER^BDWEPRN",XBRP="PRINT^BDWEPRN",XBRX="XIT^BDWEPRN",XBNS="BDW"

 D ^XBDBQUE

 D XIT

DRIVER ;EP entry point for taskman

 S BDWH=$H,BDWJ=$J

 K ^XTMP("BDWEPRN",BDWJ,BDWH)

 S BDWE=0 F  S BDWE=$O(^BDWXLOG(BDWLOG,51,BDWE)) Q:BDWE'=+BDWE  D

 .S BDWERR=$P(^BDWXLOG(BDWLOG,51,BDWE,0),U,3)

 .S BDWV=$P(^BDWXLOG(BDWLOG,51,BDWE,0),U,1)

 .Q:BDWV=""

 .Q:'$D(^AUPNVSIT(BDWV,0))

 .I $P(^AUPNVSIT(BDWV,0),U,6),$D(BDWLOCT),'$D(BDWLOCT($P(^AUPNVSIT(BDWV,0),U,6))) Q

 .I $E(BDWERR,1,6)="100-DE" S BDWDVNS=$G(BDWDVNS)+1 Q

 .S ^XTMP("BDWEPRN",BDWJ,BDWH,"ERRORS",+$P(^AUPNVSIT(BDWV,0),U,6),$P(^AUPNVSIT(BDWV,0),U,1),BDWE)=BDWV_U_BDWERR

PRINT ;EP

 S BDWPG=0,BDWQ=""

 D HEAD

 W !,"There were ",$G(BDWDVNS)," deleted visits that were never sent to the Data Warehouse.",!,"These visits are those that were added and then merged to another visit,",!,"thus they would not have been passed to the Warehouse.",!

 S BDWL=0 F  S BDWL=$O(^XTMP("BDWEPRN",BDWJ,BDWH,"ERRORS",BDWL)) Q:BDWL'=+BDWL!(BDWQ)  D

 .S BDWD="" F  S BDWD=$O(^XTMP("BDWEPRN",BDWJ,BDWH,"ERRORS",BDWL,BDWD)) Q:BDWD=""!(BDWQ)  D

 ..S BDWE=0 F  S BDWE=$O(^XTMP("BDWEPRN",BDWJ,BDWH,"ERRORS",BDWL,BDWD,BDWE)) Q:BDWE'=+BDWE!(BDWQ)  D

 ...S BDWV=$P(^XTMP("BDWEPRN",BDWJ,BDWH,"ERRORS",BDWL,BDWD,BDWE),U),BDWERR=$P(^(BDWE),U,2),BDWDFN=$P(^AUPNVSIT(BDWV,0),U,5)

 ...I $Y>(IOSL-5) D HEAD Q:BDWQ

 ...W !,$E($$VAL^XBDIQ1(9000010,BDWV,.05),1,20)

 ...S BDWHRN=$$HRN^AUPNPAT(BDWDFN,BDWL)

 ...I BDWHRN="" S BDWHRN=$$CHART^BDWUTIL1(BDWV)

 ...I BDWHRN="" S BDWHRN="?????"

 ...W ?22,BDWHRN,?29,$$FMTE^XLFDT(BDWD,5),?45,$S(BDWL:$E($P($G(^DIC(4,BDWL,0)),U,1),1,10),1:"??"),?57,$E(BDWERR,1,22)

 K ^XTMP("BDWEPRN",BDWJ,BDWH)

XIT ;EP

 D EN^XBVK("BDW")

 D ^XBFMK

O ;one community

 S DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("A")="Which LOCATION: " D ^DIC K DIC

 I Y=-1 S BDWQ="" Q

 S BDWLOCT(+Y)=""

S ;all communities within BDWSU su

 S DIC="^AUTTSU(",DIC("B")=$$VAL^XBDIQ1(9999999.06,DUZ(2),.05),DIC(0)="AEMQ",DIC("A")="Which SERVICE UNIT: " D ^DIC K DIC

 I Y=-1 S BDWQ="" Q

 W !!,"Gathering up ",$P(^AUTTSU(+Y,0),U),"'s Facilities.."

 S X=0 F  S X=$O(^AUTTLOC(X)) Q:X'=+X  I $P(^AUTTLOC(X,0),U,5)=+Y S BDWLOCT(X)=""

HEAD ;EP

 G:'BDWPG HEAD1

 K DIR I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BDWQ=1 Q

HEAD1 ;

 W:$D(IOF) @IOF S BDWPG=BDWPG+1

 W !?35,$$FMTE^XLFDT(DT),?70,"Page ",BDWPG

 S X="***** DATA WAREHOUSE EXPORT ERROR LISTING *****" W !,?((80-$L(X))/2),X

 S X="Log Entry: "_BDWLOG_"  Dates: "_$$FMTE^XLFDT($P(^BDWXLOG(BDWLOG,0),U,1))_" to "_$$FMTE^XLFDT($P(^BDWXLOG(BDWLOG,0),U,2)) W !,$$CTR(X,80),!

 I '$D(BDWLOCT) S X="ALL Locations/Facilities Included" W $$CTR(X,80),!

 I $D(BDWLOCT) S X="Selected Facilities/Locations Included" W $$CTR(X,80),!

 W !,"Name",?22,"HRN",?29,"Visit Date/Time",?45,"Location",?57,"ERROR"

 W !,$TR($J("",80)," ","-")

LBLK(V,L) ;left blank fill

 NEW %,I

 S %=$L(V),Z=L-% F I=1:1:Z S V=" "_V

Q V

RBLK(V,L) ;EP right blank fill

 NEW %,I

 S %=$L(V),Z=L-% F I=1:1:Z S V=V_" "

Q V

CTR(X,Y) ;EP - Center X in a field Y wide.

 Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X

 ;----------

EOP ;EP - End of page.

 Q:$E(IOST)'="C"

 Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))

 NEW DIR

 K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 S DIR(0)="E" D ^DIR

 ;----------

USR() ;EP - Return name of current user from ^VA(200.

 Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")

 ;----------

BDWEPRN   ; IHS/CMI/LAB - Display TX ERRORS AUGUST 14, 1992 ;

 +1       ;;1.0;IHS DATA WAREHOUSE;;JAN 23, 2006

 +2       ;

LOG       ;get log entry

 +1        WRITE !!,"Data Warehouse Transmission Error Listing",!

 +2        SET DIC="^BDWXLOG("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

           IF Y=-1

               WRITE !!,"Goodbye"

               GOTO XIT

 +3        SET BDWLOG=+Y

           SET BDWD=BDWLOG

 +4        IF '$DATA(^BDWXLOG(BDWLOG,51))

               WRITE !!,"No TX errors generated on that run."

               GOTO LOG

LOC       ;

 +1        KILL BDWLOCT

 +2        SET DIR(0)="S^A:ALL Locations/Facilities;S:One SERVICE UNIT'S Locations/Facilities;O:ONE Location/Facility"

           SET DIR("A")="Include Visits to Which Location/Facilities"

           SET DIR("B")="A"

 +3        SET DIR("A")="Enter a code indicating what LOCATIONS/FACILITIES are of interest"

           SET DIR("B")="O"

           KILL DA

           DO ^DIR

           KILL DIR,DA

 +4        IF $DATA(DIRUT)

               GOTO LOG

 +5        SET BDWLOCT=Y

 +6        IF BDWLOCT="A"

               KILL BDWLOCT

               GOTO ZIS

 +7        DO @BDWLOCT

 +8        IF $DATA(BDWQ)

               GOTO LOC

ZIS       ;call xbdbque

 +1        SET XBRC="DRIVER^BDWEPRN"

           SET XBRP="PRINT^BDWEPRN"

           SET XBRX="XIT^BDWEPRN"

           SET XBNS="BDW"

 +2        DO ^XBDBQUE

 +3        DO XIT

 +4        QUIT

DRIVER    ;EP entry point for taskman

 +1        SET BDWH=$HOROLOG

           SET BDWJ=$JOB

 +2        KILL ^XTMP("BDWEPRN",BDWJ,BDWH)

 +3        SET BDWE=0

FOR

               SET BDWE=$ORDER(^BDWXLOG(BDWLOG,51,BDWE))

               IF BDWE'=+BDWE

                   QUIT

               Begin DoDot:1

 +4                SET BDWERR=$PIECE(^BDWXLOG(BDWLOG,51,BDWE,0),U,3)

 +5                SET BDWV=$PIECE(^BDWXLOG(BDWLOG,51,BDWE,0),U,1)

 +6                IF BDWV=""

                       QUIT

 +7                IF '$DATA(^AUPNVSIT(BDWV,0))

                       QUIT

 +8                IF $PIECE(^AUPNVSIT(BDWV,0),U,6)

                       IF $DATA(BDWLOCT)

                           IF '$DATA(BDWLOCT($PIECE(^AUPNVSIT(BDWV,0),U,6)))

                               QUIT

 +9                IF $EXTRACT(BDWERR,1,6)="100-DE"

                       SET BDWDVNS=$GET(BDWDVNS)+1

                       QUIT

 +10               SET ^XTMP("BDWEPRN",BDWJ,BDWH,"ERRORS",+$PIECE(^AUPNVSIT(BDWV,0),U,6),$PIECE(^AUPNVSIT(BDWV,0),U,1),BDWE)=BDWV_U_BDWERR

               End DoDot:1

 +11       QUIT

PRINT     ;EP

 +1        SET BDWPG=0

           SET BDWQ=""

 +2        DO HEAD

 +3        WRITE !,"There were ",$GET(BDWDVNS)," deleted visits that were never sent to the Data Warehouse.",!,"These visits are those that were added and then merged to another visit,",!,"thus they would not have been passed to the Warehouse.",!

 +4        SET BDWL=0

FOR

               SET BDWL=$ORDER(^XTMP("BDWEPRN",BDWJ,BDWH,"ERRORS",BDWL))

               IF BDWL'=+BDWL!(BDWQ)

                   QUIT

               Begin DoDot:1

 +5                SET BDWD=""

FOR

                       SET BDWD=$ORDER(^XTMP("BDWEPRN",BDWJ,BDWH,"ERRORS",BDWL,BDWD))

                       IF BDWD=""!(BDWQ)

                           QUIT

                       Begin DoDot:2

 +6                        SET BDWE=0

FOR

                               SET BDWE=$ORDER(^XTMP("BDWEPRN",BDWJ,BDWH,"ERRORS",BDWL,BDWD,BDWE))

                               IF BDWE'=+BDWE!(BDWQ)

                                   QUIT

                               Begin DoDot:3

 +7                                SET BDWV=$PIECE(^XTMP("BDWEPRN",BDWJ,BDWH,"ERRORS",BDWL,BDWD,BDWE),U)

                                   SET BDWERR=$PIECE(^(BDWE),U,2)

                                   SET BDWDFN=$PIECE(^AUPNVSIT(BDWV,0),U,5)

 +8                                IF $Y>(IOSL-5)

                                       DO HEAD

                                       IF BDWQ

                                           QUIT

 +9                                WRITE !,$EXTRACT($$VAL^XBDIQ1(9000010,BDWV,.05),1,20)

 +10                               SET BDWHRN=$$HRN^AUPNPAT(BDWDFN,BDWL)

 +11                               IF BDWHRN=""

                                       SET BDWHRN=$$CHART^BDWUTIL1(BDWV)

 +12                               IF BDWHRN=""

                                       SET BDWHRN="?????"

 +13                               WRITE ?22,BDWHRN,?29,$$FMTE^XLFDT(BDWD,5),?45,$SELECT(BDWL:$EXTRACT($PIECE($GET(^DIC(4,BDWL,0)),U,1),1,10),1:"??"),?57,$EXTRACT(BDWERR,1,22)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +14       KILL ^XTMP("BDWEPRN",BDWJ,BDWH)

 +15       QUIT

XIT       ;EP

 +1        DO EN^XBVK("BDW")

 +2        DO ^XBFMK

 +3        QUIT

O         ;one community

 +1        SET DIC="^AUTTLOC("

           SET DIC(0)="AEMQ"

           SET DIC("A")="Which LOCATION: "

           DO ^DIC

           KILL DIC

 +2        IF Y=-1

               SET BDWQ=""

               QUIT

 +3        SET BDWLOCT(+Y)=""

 +4        QUIT

S         ;all communities within BDWSU su

 +1        SET DIC="^AUTTSU("

           SET DIC("B")=$$VAL^XBDIQ1(9999999.06,DUZ(2),.05)

           SET DIC(0)="AEMQ"

           SET DIC("A")="Which SERVICE UNIT: "

           DO ^DIC

           KILL DIC

 +2        IF Y=-1

               SET BDWQ=""

               QUIT

 +3        WRITE !!,"Gathering up ",$PIECE(^AUTTSU(+Y,0),U),"'s Facilities.."

 +4        SET X=0

FOR

               SET X=$ORDER(^AUTTLOC(X))

               IF X'=+X

                   QUIT

               IF $PIECE(^AUTTLOC(X,0),U,5)=+Y

                   SET BDWLOCT(X)=""

 +5        QUIT

 +6       ;

HEAD      ;EP

 +1        IF 'BDWPG

               GOTO HEAD1

 +2        KILL DIR

           IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   WRITE !

                   SET DIR(0)="EO"

                   DO ^DIR

                   KILL DIR

                   IF Y=0!(Y="^")!($DATA(DTOUT))

                       SET BDWQ=1

                       QUIT

HEAD1     ;

 +1        IF $DATA(IOF)

               WRITE @IOF

           SET BDWPG=BDWPG+1

 +2        WRITE !?35,$$FMTE^XLFDT(DT),?70,"Page ",BDWPG

 +3        SET X="***** DATA WAREHOUSE EXPORT ERROR LISTING *****"

           WRITE !,?((80-$LENGTH(X))/2),X

 +4        SET X="Log Entry: "_BDWLOG_"  Dates: "_$$FMTE^XLFDT($PIECE(^BDWXLOG(BDWLOG,0),U,1))_" to "_$$FMTE^XLFDT($PIECE(^BDWXLOG(BDWLOG,0),U,2))

           WRITE !,$$CTR(X,80),!

 +5        IF '$DATA(BDWLOCT)

               SET X="ALL Locations/Facilities Included"

               WRITE $$CTR(X,80),!

 +6        IF $DATA(BDWLOCT)

               SET X="Selected Facilities/Locations Included"

               WRITE $$CTR(X,80),!

 +7        WRITE !,"Name",?22,"HRN",?29,"Visit Date/Time",?45,"Location",?57,"ERROR"

 +8        WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")

 +9        QUIT

LBLK(V,L) ;left blank fill

 +1        NEW %,I

 +2        SET %=$LENGTH(V)

           SET Z=L-%

           FOR I=1:1:Z

               SET V=" "_V

 +3        QUIT V

RBLK(V,L) ;EP right blank fill

 +1        NEW %,I

 +2        SET %=$LENGTH(V)

           SET Z=L-%

           FOR I=1:1:Z

               SET V=V_" "

 +3        QUIT V

CTR(X,Y)  ;EP - Center X in a field Y wide.

 +1        QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X

 +2       ;----------

EOP       ;EP - End of page.

 +1        IF $EXTRACT(IOST)'="C"

               QUIT

 +2        IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))

               QUIT

 +3        NEW DIR

 +4        KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 +5        SET DIR(0)="E"

           DO ^DIR

 +6        QUIT

 +7       ;----------

USR()     ;EP - Return name of current user from ^VA(200.

 +1        QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")

 +2       ;----------

BDWEPRN.m