BDWSRP5.m

BDWSRP5 ; IHS/CMI/LAB - DW REPORT PRINT CONT ;

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

 I $Y>(IOSL-10) D HEAD^BDWSRP Q:$D(BDWSR("QUIT"))

 W !!!,"DATA WAREHOUSE RECORDS EXPORTED"

 I '$P(^BDWXLOG(BDWSR("LOG"),0),U,18) W !,"There were NO DATA WAREHOUSE VISIT transactions generated.",!! G EOJ

 W !,"Following is a breakdown of all encounters that generated DATA WAREHOUSE",!,"transactions by Visit Date, Type, Location, Service Category, Clinic and",!,"Primary Provider Discipline."

INPT ;

 S BDWSR("INPT CNT")=0

 S X=0 F  S X=$O(^BDWXLOG(BDWSR("LOG"),21,X)) Q:X'=+X  I $D(^AUPNVSIT(X,0)) S V=^AUPNVSIT(X,0) I $P(^BDWXLOG(BDWSR("LOG"),21,X,0),U,2),$P(V,U,7)="H",$P(V,U,6)=DUZ(2) S BDWSR("INPT CNT")=BDWSR("INPT CNT")+1

 I $Y>(IOSL-4) D HEAD^BDWSRP Q:$D(BDWSR("QUIT"))

 W !!,"Total # of Hospitalization Encounters to this Facility that were exported: ",BDWSR("INPT CNT"),!

VD ;

 ;

 S BDWSR("PTR")=0,BDWSR("T")="By Visit Date:",BDWSR("1")="V DATE STATDB",BDWSR("2")="V DATE STATDB",BDWSR("WC")=0

 D PROC Q:$D(BDWSR("QUIT"))

TYPE ;

 S BDWSR("PTR")=0,BDWSR("T")="By Type:",BDWSR("1")="TYPE STATDB",BDWSR("2")="TYPE STATDB CC",BDWSR("WC")=0

 D PROC Q:$D(BDWSR("QUIT"))

LOC ;

 S BDWSR("PTR")=1,BDWSR("T")="By Location:",BDWSR("1")="LOC STATDB",BDWSR("2")="LOC STATDB CC",BDWSR("WC")=0,BDWSR("GLOBAL")="^DIC(4,",BDWSR("PIECE")=1

 D PROC Q:$D(BDWSR("QUIT"))

SC ;

 S BDWSR("PTR")=0,BDWSR("T")="By Service Category:",BDWSR("1")="SC STATDB",BDWSR("2")="SC STATDB CC",BDWSR("WC")=0

 D PROC Q:$D(BDWSR("QUIT"))

CLINIC ;

 S BDWSR("PTR")=0,BDWSR("T")="By Clinic Type:",BDWSR("1")="CLINIC STATDB",BDWSR("2")="CLINIC STATDB CC",BDWSR("WC")=0

 D PROC Q:$D(BDWSR("QUIT"))

PROVDISC ;

 S BDWSR("PTR")=0,BDWSR("T")="By Provider Type (Primary Provider only):",BDWSR("1")="PROV STATDB",BDWSR("2")="PROV STATDB CC",BDWSR("WC")=0

 D PROC Q:$D(BDWSR("QUIT"))

ERRS ;

 I $Y>(IOSL-3) D HEAD^BDWSRP Q:$D(BDWSR("QUIT"))

 W !!?18,"Number of encounters skipped:",?50,$$VAL^XBDIQ1(90213,BDWSR("LOG"),.05)

 I $Y>(IOSL-3) D HEAD^BDWSRP Q:$D(BDWSR("QUIT"))

 I $P($G(^BDWXLOG(BDWSR("LOG"),31)),U,3) W !?20,"Deleted encounters skipped:",?50,$$VAL^XBDIQ1(90213,BDWSR("LOG"),3103)

 I $Y>(IOSL-3) D HEAD^BDWSRP Q:$D(BDWSR("QUIT"))

 I $P($G(^BDWXLOG(BDWSR("LOG"),31)),U,2) W !?17,"Zero dep entry visits skipped:",?50,$$VAL^XBDIQ1(90213,BDWSR("LOG"),3102)

 I $Y>(IOSL-3) D HEAD^BDWSRP Q:$D(BDWSR("QUIT"))

 I $P($G(^BDWXLOG(BDWSR("LOG"),31)),U,11) W !?28,"MFI visits skipped:",?50,$$VAL^XBDIQ1(90213,BDWSR("LOG"),3111)

 I $Y>(IOSL-3) D HEAD^BDWSRP Q:$D(BDWSR("QUIT"))

 I $P($G(^BDWXLOG(BDWSR("LOG"),31)),U,4) W !?17,"NO PATIENT encounters skipped:",?50,$$VAL^XBDIQ1(90213,BDWSR("LOG"),3104)

 I $Y>(IOSL-3) D HEAD^BDWSRP Q:$D(BDWSR("QUIT"))

 I $P($G(^BDWXLOG(BDWSR("LOG"),31)),U,5) W !?13,"NO LOCATION of encounters skipped:",?50,$$VAL^XBDIQ1(90213,BDWSR("LOG"),3105)

 I $Y>(IOSL-3) D HEAD^BDWSRP Q:$D(BDWSR("QUIT"))

 I $P($G(^BDWXLOG(BDWSR("LOG"),31)),U,6) W !?11,"NO TYPE OF VISIT encounters skipped:",?50,$$VAL^XBDIQ1(90213,BDWSR("LOG"),3106)

 I $Y>(IOSL-3) D HEAD^BDWSRP Q:$D(BDWSR("QUIT"))

 I $P($G(^BDWXLOG(BDWSR("LOG"),31)),U,7) W !?8,"NO SERVICE CATEGORY encounters skipped:",?50,$$VAL^XBDIQ1(90213,BDWSR("LOG"),3107)

 I $Y>(IOSL-3) D HEAD^BDWSRP Q:$D(BDWSR("QUIT"))

 I $P($G(^BDWXLOG(BDWSR("LOG"),31)),U,1) W !?15,"DEMO PATIENT encounters skipped:",?50,$$VAL^XBDIQ1(90213,BDWSR("LOG"),3101)

TEXT ;

 I $Y>(IOSL-3) D HEAD^BDWSRP Q:$D(BDWSR("QUIT"))

 W !!,"To list the encounters that were skipped, use option DWER."

 ;show trailer report

 I $Y>(IOSL-3) D HEAD^BDWSRP Q:$D(BDWSR("QUIT"))

 W !!,"The following 'trailer report' was included with the export ",!,"to the Data Warehouse:",!

 S BDWX=0 F  S BDWX=$O(^BDWXLOG(BDWSR("LOG"),99,BDWX)) Q:BDWX'=+BDWX!($D(BDWSR("QUIT")))  D

 .I $Y>(IOSL-3) D HEAD^BDWSRP Q:$D(BDWSR("QUIT"))

 .W !?3,^BDWXLOG(BDWSR("LOG"),99,BDWX,0)

EOJ ;

 Q

PROC ;

 I $Y>(IOSL-9) D HEAD^BDWSRP Q:$D(BDWSR("QUIT"))

 W !!?10,BDWSR("T")

 S BDWSR("N")=0 F  S BDWSR("N")=$O(^XTMP("BDWSR",BDWJOB,BDWBTH,"GEN",BDWSR("2"),BDWSR("N"))) Q:BDWSR("N")=""!($D(BDWSR("QUIT")))  D PROC1

 Q

PROC1 ;

 I BDWSR("2")["DATE" D PRNT Q

 S BDWSR("D")=0 F  S BDWSR("D")=$O(^XTMP("BDWSR",BDWJOB,BDWBTH,"GEN",BDWSR("2"),BDWSR("N"),BDWSR("D"))) Q:BDWSR("D")=""  D PRNT

 Q

PRNTDATE ;

 S Y=BDWSR("N") D DD^%DT W !?13,Y,?45,$J(^XTMP("BDWSR",BDWJOB,BDWBTH,"GEN",BDWSR("2"),BDWSR("N")),7) S BDWSR("WC")=BDWSR("WC")+1

 Q

PRNT ;

 I $Y>(IOSL-5) D HEAD^BDWSRP Q:$D(BDWSR("QUIT"))  W !!?10,BDWSR("T") W:BDWSR("WC")>0 " (cont.)"

 I BDWSR("1")="V DATE STATDB" D PRNTDATE Q

 S X=^XTMP("BDWSR",BDWJOB,BDWBTH,"GEN",BDWSR("2"),BDWSR("N"),BDWSR("D"))

 I BDWSR("PTR")=1 D PRNTPTR Q

 W !?13,BDWSR("D"),?45,$J(X,7) S BDWSR("WC")=BDWSR("WC")+1

 Q

PRNTPTR ;

 S G=BDWSR("GLOBAL")_BDWSR("D")_")"

 W !

 I $D(@G@(0)) W ?13,$P(@G@(0),U,BDWSR("PIECE"))

 W ?45,$J(X,7)

 S BDWSR("WC")=BDWSR("WC")+1

 I BDWSR("1")="LOC STATDB" W ?55,"(IHS CODE: ",$P(^AUTTLOC(BDWSR("D"),0),U,10),")"

 K G

 Q

BDWSRP5   ; IHS/CMI/LAB - DW REPORT PRINT CONT ;

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

 +2        IF $Y>(IOSL-10)

               DO HEAD^BDWSRP

               IF $DATA(BDWSR("QUIT"))

                   QUIT 

 +3        WRITE !!!,"DATA WAREHOUSE RECORDS EXPORTED"

 +4        IF '$PIECE(^BDWXLOG(BDWSR("LOG"),0),U,18)

               WRITE !,"There were NO DATA WAREHOUSE VISIT transactions generated.",!!

               GOTO EOJ

 +5        WRITE !,"Following is a breakdown of all encounters that generated DATA WAREHOUSE",!,"transactions by Visit Date, Type, Location, Service Category, Clinic and",!,"Primary Provider Discipline."

INPT      ;

 +1        SET BDWSR("INPT CNT")=0

 +2        SET X=0

           FOR 

               SET X=$ORDER(^BDWXLOG(BDWSR("LOG"),21,X))

               IF X'=+X

                   QUIT 

               IF $DATA(^AUPNVSIT(X,0))

                   SET V=^AUPNVSIT(X,0)

                   IF $PIECE(^BDWXLOG(BDWSR("LOG"),21,X,0),U,2)

                       IF $PIECE(V,U,7)="H"

                           IF $PIECE(V,U,6)=DUZ(2)

                               SET BDWSR("INPT CNT")=BDWSR("INPT CNT")+1

 +3        IF $Y>(IOSL-4)

               DO HEAD^BDWSRP

               IF $DATA(BDWSR("QUIT"))

                   QUIT 

 +4        WRITE !!,"Total # of Hospitalization Encounters to this Facility that were exported: ",BDWSR("INPT CNT"),!

VD        ;

 +1       ;

 +2        SET BDWSR("PTR")=0

           SET BDWSR("T")="By Visit Date:"

           SET BDWSR("1")="V DATE STATDB"

           SET BDWSR("2")="V DATE STATDB"

           SET BDWSR("WC")=0

 +3        DO PROC

           IF $DATA(BDWSR("QUIT"))

               QUIT 

TYPE      ;

 +1        SET BDWSR("PTR")=0

           SET BDWSR("T")="By Type:"

           SET BDWSR("1")="TYPE STATDB"

           SET BDWSR("2")="TYPE STATDB CC"

           SET BDWSR("WC")=0

 +2        DO PROC

           IF $DATA(BDWSR("QUIT"))

               QUIT 

LOC       ;

 +1        SET BDWSR("PTR")=1

           SET BDWSR("T")="By Location:"

           SET BDWSR("1")="LOC STATDB"

           SET BDWSR("2")="LOC STATDB CC"

           SET BDWSR("WC")=0

           SET BDWSR("GLOBAL")="^DIC(4,"

           SET BDWSR("PIECE")=1

 +2        DO PROC

           IF $DATA(BDWSR("QUIT"))

               QUIT 

SC        ;

 +1        SET BDWSR("PTR")=0

           SET BDWSR("T")="By Service Category:"

           SET BDWSR("1")="SC STATDB"

           SET BDWSR("2")="SC STATDB CC"

           SET BDWSR("WC")=0

 +2        DO PROC

           IF $DATA(BDWSR("QUIT"))

               QUIT 

CLINIC    ;

 +1        SET BDWSR("PTR")=0

           SET BDWSR("T")="By Clinic Type:"

           SET BDWSR("1")="CLINIC STATDB"

           SET BDWSR("2")="CLINIC STATDB CC"

           SET BDWSR("WC")=0

 +2        DO PROC

           IF $DATA(BDWSR("QUIT"))

               QUIT 

PROVDISC  ;

 +1        SET BDWSR("PTR")=0

           SET BDWSR("T")="By Provider Type (Primary Provider only):"

           SET BDWSR("1")="PROV STATDB"

           SET BDWSR("2")="PROV STATDB CC"

           SET BDWSR("WC")=0

 +2        DO PROC

           IF $DATA(BDWSR("QUIT"))

               QUIT 

ERRS      ;

 +1        IF $Y>(IOSL-3)

               DO HEAD^BDWSRP

               IF $DATA(BDWSR("QUIT"))

                   QUIT 

 +2        WRITE !!?18,"Number of encounters skipped:",?50,$$VAL^XBDIQ1(90213,BDWSR("LOG"),.05)

 +3        IF $Y>(IOSL-3)

               DO HEAD^BDWSRP

               IF $DATA(BDWSR("QUIT"))

                   QUIT 

 +4        IF $PIECE($GET(^BDWXLOG(BDWSR("LOG"),31)),U,3)

               WRITE !?20,"Deleted encounters skipped:",?50,$$VAL^XBDIQ1(90213,BDWSR("LOG"),3103)

 +5        IF $Y>(IOSL-3)

               DO HEAD^BDWSRP

               IF $DATA(BDWSR("QUIT"))

                   QUIT 

 +6        IF $PIECE($GET(^BDWXLOG(BDWSR("LOG"),31)),U,2)

               WRITE !?17,"Zero dep entry visits skipped:",?50,$$VAL^XBDIQ1(90213,BDWSR("LOG"),3102)

 +7        IF $Y>(IOSL-3)

               DO HEAD^BDWSRP

               IF $DATA(BDWSR("QUIT"))

                   QUIT 

 +8        IF $PIECE($GET(^BDWXLOG(BDWSR("LOG"),31)),U,11)

               WRITE !?28,"MFI visits skipped:",?50,$$VAL^XBDIQ1(90213,BDWSR("LOG"),3111)

 +9        IF $Y>(IOSL-3)

               DO HEAD^BDWSRP

               IF $DATA(BDWSR("QUIT"))

                   QUIT 

 +10       IF $PIECE($GET(^BDWXLOG(BDWSR("LOG"),31)),U,4)

               WRITE !?17,"NO PATIENT encounters skipped:",?50,$$VAL^XBDIQ1(90213,BDWSR("LOG"),3104)

 +11       IF $Y>(IOSL-3)

               DO HEAD^BDWSRP

               IF $DATA(BDWSR("QUIT"))

                   QUIT 

 +12       IF $PIECE($GET(^BDWXLOG(BDWSR("LOG"),31)),U,5)

               WRITE !?13,"NO LOCATION of encounters skipped:",?50,$$VAL^XBDIQ1(90213,BDWSR("LOG"),3105)

 +13       IF $Y>(IOSL-3)

               DO HEAD^BDWSRP

               IF $DATA(BDWSR("QUIT"))

                   QUIT 

 +14       IF $PIECE($GET(^BDWXLOG(BDWSR("LOG"),31)),U,6)

               WRITE !?11,"NO TYPE OF VISIT encounters skipped:",?50,$$VAL^XBDIQ1(90213,BDWSR("LOG"),3106)

 +15       IF $Y>(IOSL-3)

               DO HEAD^BDWSRP

               IF $DATA(BDWSR("QUIT"))

                   QUIT 

 +16       IF $PIECE($GET(^BDWXLOG(BDWSR("LOG"),31)),U,7)

               WRITE !?8,"NO SERVICE CATEGORY encounters skipped:",?50,$$VAL^XBDIQ1(90213,BDWSR("LOG"),3107)

 +17       IF $Y>(IOSL-3)

               DO HEAD^BDWSRP

               IF $DATA(BDWSR("QUIT"))

                   QUIT 

 +18       IF $PIECE($GET(^BDWXLOG(BDWSR("LOG"),31)),U,1)

               WRITE !?15,"DEMO PATIENT encounters skipped:",?50,$$VAL^XBDIQ1(90213,BDWSR("LOG"),3101)

TEXT      ;

 +1        IF $Y>(IOSL-3)

               DO HEAD^BDWSRP

               IF $DATA(BDWSR("QUIT"))

                   QUIT 

 +2        WRITE !!,"To list the encounters that were skipped, use option DWER."

 +3       ;show trailer report

 +4        IF $Y>(IOSL-3)

               DO HEAD^BDWSRP

               IF $DATA(BDWSR("QUIT"))

                   QUIT 

 +5        WRITE !!,"The following 'trailer report' was included with the export ",!,"to the Data Warehouse:",!

 +6        SET BDWX=0

           FOR 

               SET BDWX=$ORDER(^BDWXLOG(BDWSR("LOG"),99,BDWX))

               IF BDWX'=+BDWX!($DATA(BDWSR("QUIT")))

                   QUIT 

               Begin DoDot:1

 +7                IF $Y>(IOSL-3)

                       DO HEAD^BDWSRP

                       IF $DATA(BDWSR("QUIT"))

                           QUIT 

 +8                WRITE !?3,^BDWXLOG(BDWSR("LOG"),99,BDWX,0)

               End DoDot:1

EOJ       ;

 +1        QUIT 

PROC      ;

 +1        IF $Y>(IOSL-9)

               DO HEAD^BDWSRP

               IF $DATA(BDWSR("QUIT"))

                   QUIT 

 +2        WRITE !!?10,BDWSR("T")

 +3        SET BDWSR("N")=0

           FOR 

               SET BDWSR("N")=$ORDER(^XTMP("BDWSR",BDWJOB,BDWBTH,"GEN",BDWSR("2"),BDWSR("N")))

               IF BDWSR("N")=""!($DATA(BDWSR("QUIT")))

                   QUIT 

               DO PROC1

 +4        QUIT 

PROC1     ;

 +1        IF BDWSR("2")["DATE"

               DO PRNT

               QUIT 

 +2        SET BDWSR("D")=0

           FOR 

               SET BDWSR("D")=$ORDER(^XTMP("BDWSR",BDWJOB,BDWBTH,"GEN",BDWSR("2"),BDWSR("N"),BDWSR("D")))

               IF BDWSR("D")=""

                   QUIT 

               DO PRNT

 +3        QUIT 

PRNTDATE  ;

 +1        SET Y=BDWSR("N")

           DO DD^%DT

           WRITE !?13,Y,?45,$JUSTIFY(^XTMP("BDWSR",BDWJOB,BDWBTH,"GEN",BDWSR("2"),BDWSR("N")),7)

           SET BDWSR("WC")=BDWSR("WC")+1

 +2        QUIT 

PRNT      ;

 +1        IF $Y>(IOSL-5)

               DO HEAD^BDWSRP

               IF $DATA(BDWSR("QUIT"))

                   QUIT 

               WRITE !!?10,BDWSR("T")

               IF BDWSR("WC")>0

                   WRITE " (cont.)"

 +2        IF BDWSR("1")="V DATE STATDB"

               DO PRNTDATE

               QUIT 

 +3        SET X=^XTMP("BDWSR",BDWJOB,BDWBTH,"GEN",BDWSR("2"),BDWSR("N"),BDWSR("D"))

 +4        IF BDWSR("PTR")=1

               DO PRNTPTR

               QUIT 

 +5        WRITE !?13,BDWSR("D"),?45,$JUSTIFY(X,7)

           SET BDWSR("WC")=BDWSR("WC")+1

 +6        QUIT 

PRNTPTR   ;

 +1        SET G=BDWSR("GLOBAL")_BDWSR("D")_")"

 +2        WRITE !

 +3        IF $DATA(@G@(0))

               WRITE ?13,$PIECE(@G@(0),U,BDWSR("PIECE"))

 +4        WRITE ?45,$JUSTIFY(X,7)

 +5        SET BDWSR("WC")=BDWSR("WC")+1

 +6        IF BDWSR("1")="LOC STATDB"

               WRITE ?55,"(IHS CODE: ",$PIECE(^AUTTLOC(BDWSR("D"),0),U,10),")"

 +7        KILL G

 +8        QUIT