Routine: BDWRDRI3

BDWRDRI3 ; IHS/CMI/LAB - INIT CONT DW ;

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

INFORM ;EP - INFORM OPERATOR WHAT IS GOING TO HAPPEN

 Q:$D(ZTQUEUED)

 W !!,"This routine will generate IHS Data Warehouse records"

 W !,"for visits posted between a specified range of dates.  You may ""^"" out at any",!,"prompt and will be ask to confirm your entries prior to generating transactions."

CURRUN ;EP - COMPUTE DATES FOR CURRENT RUN

 S BDW("RUN BEGIN")=""

 I BDW("LAST LOG") S X1=$P(^BDWXLOG(BDW("LAST LOG"),0),U,2),X2=1 D C^%DTC S BDW("RUN BEGIN")=X,Y=X D DD^%DT

 I BDW("RUN BEGIN")="" D FIRSTRUN

 Q:BDW("QFLG")

 S X1=DT,X2=$P(^BDWSITE(1,0),U,3)*-1 D C^%DTC S Y=X

 I Y<BDW("RUN BEGIN") W:'$D(ZTQUEUED) !!,"  Ending date cannot be before beginning date!",$C(7) S BDW("QFLG")=18 Q

 S BDW("RUN END")=Y

 S Y=BDW("RUN BEGIN") X ^DD("DD") S BDW("X")=Y

 S Y=BDW("RUN END") X ^DD("DD") S BDW("Y")=Y

 W:'$D(ZTQUEUED) !!,"The inclusive dates for this run are ",BDW("X")," through ",BDW("Y"),"."

 K %,%H,%I,BDW("RDFN"),BDW("X"),BDW("Y"),BDW("LAST LOG"),BDW("LAST BEGIN"),BDW("Z"),BDW("DATE")

FIRSTRUN ; FIRST RUN EVER (NO LOG ENTRY)

 I $D(ZTQUEUED),$D(BDWO("SCHEDULED")) S BDW("QFLG")=12 Q

 W !!,"No log entry.  First run ever assumed (excluding date range re-exports).",!

 S BDW("RUN BEGIN")=$O(^AUPNVSIT("ADWO",0))

 S BDW("FIRST RUN")=1

ERRBULL ;ENTRY POINT - ERROR BULLETIN

 S BDW("QFLG1")=$O(^BDWERRC("B",BDW("QFLG"),"")),BDW("QFLG DES")=$P(^BDWERRC(BDW("QFLG1"),0),U,2)

 S XMB(2)=BDW("QFLG"),XMB(3)=BDW("QFLG DES")

 S XMB(4)=$S($D(BDW("RUN LOG")):BDW("RUN LOG"),1:"< NONE >")

 I '$D(BDW("RUN BEGIN")) S XMB(5)="<UNKNOWN>" G ERRBULL1

 S Y=BDW("RUN BEGIN") D DD^%DT S XMB(5)=Y

ERRBULL1 S Y=DT D DD^%DT S XMB(1)=Y,XMB="BDW DATA WAREHOUSE TRANSMISSION ERROR"

 S XMDUZ=.5 D ^XMB

 K XMB,XM1,XMA,XMDT,XMM,BDW("QFLG1"),BDW("QFLG DES"),XMDUZ

BDWRDRI3  ; IHS/CMI/LAB - INIT CONT DW ;

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

INFORM    ;EP - INFORM OPERATOR WHAT IS GOING TO HAPPEN

 +1        IF $DATA(ZTQUEUED)

               QUIT

 +2        WRITE !!,"This routine will generate IHS Data Warehouse records"

 +3        WRITE !,"for visits posted between a specified range of dates.  You may ""^"" out at any",!,"prompt and will be ask to confirm your entries prior to generating transactions."

 +4        QUIT

 +5       ;

CURRUN    ;EP - COMPUTE DATES FOR CURRENT RUN

 +1        SET BDW("RUN BEGIN")=""

 +2        IF BDW("LAST LOG")

               SET X1=$PIECE(^BDWXLOG(BDW("LAST LOG"),0),U,2)

               SET X2=1

               DO C^%DTC

               SET BDW("RUN BEGIN")=X

               SET Y=X

               DO DD^%DT

 +3        IF BDW("RUN BEGIN")=""

               DO FIRSTRUN

 +4        IF BDW("QFLG")

               QUIT

 +5        SET X1=DT

           SET X2=$PIECE(^BDWSITE(1,0),U,3)*-1

           DO C^%DTC

           SET Y=X

 +6        IF Y<BDW("RUN BEGIN")

               IF '$DATA(ZTQUEUED)

                   WRITE !!,"  Ending date cannot be before beginning date!",$CHAR(7)

               SET BDW("QFLG")=18

               QUIT

 +7        SET BDW("RUN END")=Y

 +8        SET Y=BDW("RUN BEGIN")

           XECUTE ^DD("DD")

           SET BDW("X")=Y

 +9        SET Y=BDW("RUN END")

           XECUTE ^DD("DD")

           SET BDW("Y")=Y

 +10       IF '$DATA(ZTQUEUED)

               WRITE !!,"The inclusive dates for this run are ",BDW("X")," through ",BDW("Y"),"."

 +11       KILL %,%H,%I,BDW("RDFN"),BDW("X"),BDW("Y"),BDW("LAST LOG"),BDW("LAST BEGIN"),BDW("Z"),BDW("DATE")

 +12       QUIT

 +13      ;

FIRSTRUN  ; FIRST RUN EVER (NO LOG ENTRY)

 +1        IF $DATA(ZTQUEUED)

               IF $DATA(BDWO("SCHEDULED"))

                   SET BDW("QFLG")=12

                   QUIT

 +2        WRITE !!,"No log entry.  First run ever assumed (excluding date range re-exports).",!

 +3        SET BDW("RUN BEGIN")=$ORDER(^AUPNVSIT("ADWO",0))

 +4        SET BDW("FIRST RUN")=1

 +5        QUIT

 +6       ;

 +7       ;

ERRBULL   ;ENTRY POINT - ERROR BULLETIN

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

           SET BDW("QFLG DES")=$PIECE(^BDWERRC(BDW("QFLG1"),0),U,2)

 +2        SET XMB(2)=BDW("QFLG")

           SET XMB(3)=BDW("QFLG DES")

 +3        SET XMB(4)=$SELECT($DATA(BDW("RUN LOG")):BDW("RUN LOG"),1:"< NONE >")

 +4        IF '$DATA(BDW("RUN BEGIN"))

               SET XMB(5)="<UNKNOWN>"

               GOTO ERRBULL1

 +5        SET Y=BDW("RUN BEGIN")

           DO DD^%DT

           SET XMB(5)=Y

ERRBULL1   SET Y=DT

           DO DD^%DT

           SET XMB(1)=Y

           SET XMB="BDW DATA WAREHOUSE TRANSMISSION ERROR"

 +1        SET XMDUZ=.5

           DO ^XMB

 +2        KILL XMB,XM1,XMA,XMDT,XMM,BDW("QFLG1"),BDW("QFLG DES"),XMDUZ

 +3        QUIT

BDWRDRI3.m