BCHEXRE1.m

BCHEXRE1 ; IHS/CMI/LAB - CONT. OF REDO CHR EXPORT ; 

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

 ;IHS/CMI/LAB - added $J to ^TMP

 ;

INIT ;EP

 D CHKOLD^BCHEXDI2

 Q:BCH("QFLG")

 S DIC="^BCHXLOG(",DIC(0)="AEQ",DIC("S")="I $D(^(21)),$P(^(0),U,9)=DUZ(2)" D ^DIC K DIC

 I Y<0 S BCH("QFLG")=99 Q

 S BCH("RUN LOG")=+Y

 ;

 S X=^BCHXLOG(BCH("RUN LOG"),0),BCH("RUN BEGIN")=$P(X,U),BCH("RUN END")=$P(X,U,2),BCH("COUNT")=$P(X,U,6),BCH("ORIG TX DATE")=$P($P(X,U,3),"."),BCH("BATCH")=$P(X,U,17)

 S Y=BCH("RUN BEGIN") X ^DD("DD") S BCH("PRINT BEGIN")=Y

 S Y=BCH("RUN END") X ^DD("DD") S BCH("PRINT END")=Y

 S BCH("RECS")=$P(^BCHXLOG(BCH("RUN LOG"),21,0),U,4)

 W !!,"Log entry ",BCH("RUN LOG"),"  was for date range ",BCH("PRINT BEGIN")," through ",BCH("PRINT END"),!,"and generated ",BCH("COUNT")," transactions from ",BCH("RECS")," records."

 ;

 W !!!,$C(7),$C(7),"This routine will generate CHR transactions.",!

RDD ;

 S DIR(0)="Y",DIR("A")="Do you want to regenerate the transactions for this run",DIR("B")="N" K DA D ^DIR K DIR

 I $D(DIRUT) S BCH("QFLG")=99 Q

 I 'Y S BCH("QFLG")=99 Q

 Q

DELETES ;EP

 S BCHRTYPE="D"

 S BCHR="" F  S BCHR=$O(^BCHEXDEL("AD",BCH("ORIG TX DATE"),BCHR)) Q:BCHR=""  D DELETES2 Q:BCH("QFLG")

 Q

DELETES2 ;

 S BCHTX=""

 S BCHV("TX GENERATED")=0,^TMP("BCHREDO",$J,"DELETES",BCH("MAIN TX DATE"),BCHR)=BCH("MAIN TX DATE")

 X BCHCNT

 S X=$P(^BCHEXDEL(BCHR,0),U),X=$$LBLK^BCHEXD2(X,6) D TX^BCHEXD2

 S X=$P(^BCHEXDEL(BCHR,0),U,2) S X=$$LBLK^BCHEXD2(X,7) D TX^BCHEXD2

 S X=$P(^BCHEXDEL(BCHR,0),U,3) S X=$$LBLK^BCHEXD2(X,7) D TX^BCHEXD2

 S X=$P(^BCHEXDEL(BCHR,0),U,4) S X=$$LZERO^BCHEXD2(X,3) D TX^BCHEXD2

 S $E(BCHTX,68)=BCHRTYPE

 D CNTBUILD^BCHEXRE

 Q

BCHEXRE1  ; IHS/CMI/LAB - CONT. OF REDO CHR EXPORT ; 

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

 +2       ;IHS/CMI/LAB - added $J to ^TMP

 +3       ;

INIT      ;EP

 +1        DO CHKOLD^BCHEXDI2

 +2        IF BCH("QFLG")

               QUIT 

 +3        SET DIC="^BCHXLOG("

           SET DIC(0)="AEQ"

           SET DIC("S")="I $D(^(21)),$P(^(0),U,9)=DUZ(2)"

           DO ^DIC

           KILL DIC

 +4        IF Y<0

               SET BCH("QFLG")=99

               QUIT 

 +5        SET BCH("RUN LOG")=+Y

 +6       ;

 +7        SET X=^BCHXLOG(BCH("RUN LOG"),0)

           SET BCH("RUN BEGIN")=$PIECE(X,U)

           SET BCH("RUN END")=$PIECE(X,U,2)

           SET BCH("COUNT")=$PIECE(X,U,6)

           SET BCH("ORIG TX DATE")=$PIECE($PIECE(X,U,3),".")

           SET BCH("BATCH")=$PIECE(X,U,17)

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

           XECUTE ^DD("DD")

           SET BCH("PRINT BEGIN")=Y

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

           XECUTE ^DD("DD")

           SET BCH("PRINT END")=Y

 +10       SET BCH("RECS")=$PIECE(^BCHXLOG(BCH("RUN LOG"),21,0),U,4)

 +11       WRITE !!,"Log entry ",BCH("RUN LOG"),"  was for date range ",BCH("PRINT BEGIN")," through ",BCH("PRINT END"),!,"and generated ",BCH("COUNT")," transactions from ",BCH("RECS")," records."

 +12      ;

 +13       WRITE !!!,$CHAR(7),$CHAR(7),"This routine will generate CHR transactions.",!

RDD       ;

 +1        SET DIR(0)="Y"

           SET DIR("A")="Do you want to regenerate the transactions for this run"

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)

               SET BCH("QFLG")=99

               QUIT 

 +3        IF 'Y

               SET BCH("QFLG")=99

               QUIT 

 +4        QUIT 

DELETES   ;EP

 +1        SET BCHRTYPE="D"

 +2        SET BCHR=""

           FOR 

               SET BCHR=$ORDER(^BCHEXDEL("AD",BCH("ORIG TX DATE"),BCHR))

               IF BCHR=""

                   QUIT 

               DO DELETES2

               IF BCH("QFLG")

                   QUIT 

 +3        QUIT 

DELETES2  ;

 +1        SET BCHTX=""

 +2        SET BCHV("TX GENERATED")=0

           SET ^TMP("BCHREDO",$JOB,"DELETES",BCH("MAIN TX DATE"),BCHR)=BCH("MAIN TX DATE")

 +3        XECUTE BCHCNT

 +4        SET X=$PIECE(^BCHEXDEL(BCHR,0),U)

           SET X=$$LBLK^BCHEXD2(X,6)

           DO TX^BCHEXD2

 +5        SET X=$PIECE(^BCHEXDEL(BCHR,0),U,2)

           SET X=$$LBLK^BCHEXD2(X,7)

           DO TX^BCHEXD2

 +6        SET X=$PIECE(^BCHEXDEL(BCHR,0),U,3)

           SET X=$$LBLK^BCHEXD2(X,7)

           DO TX^BCHEXD2

 +7        SET X=$PIECE(^BCHEXDEL(BCHR,0),U,4)

           SET X=$$LZERO^BCHEXD2(X,3)

           DO TX^BCHEXD2

 +8        SET $EXTRACT(BCHTX,68)=BCHRTYPE

 +9        DO CNTBUILD^BCHEXRE

 +10       QUIT