BCHEXC.m

BCHEXC ; IHS/CMI/LAB - MAIN DRIVER FOR CHR EXPORT RECORD CHECK ; 

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

 ;

 ;Main routine for the export record check option.

 ;

 ;

START ;

 D INFORM

 S BCH("QFLG")=0

 D GETLOG^BCHEXDI2

 I BCH("QFLG") G EOJ

CURRUN ;EP - COMPUTE DATES FOR CURRENT RUN

 S BCHBD=""

 I BCH("LAST LOG") S X1=$P(^BCHXLOG(BCH("LAST LOG"),0),U,2),X2=1 D C^%DTC S BCHBD=X,Y=X D DD^%DT

 I BCHBD="" D FIRSTRUN

 Q:BCH("QFLG")

 S Y=DT

 I Y<BCHBD W !!,"  Ending date cannot be before beginning date!",$C(7) S BCH("QFLG")=18 Q

 S BCHED=Y

 S Y=BCHBD X ^DD("DD") S BCH("X")=Y

 S Y=BCHED X ^DD("DD") S BCH("Y")=Y

 W !!,"This report will review records that were posted between ",BCH("X"),!," and ",BCH("Y"),", inclusive."

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

 ;

 W !! S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 G:$D(DIRUT) EOJ

 I 'Y W !!,"okay, bye." G EOJ

ZIS ;

 S XBRP="^BCHEXCP",XBRC="^BCHEXC1",XBRX="EOJ^BCHEXC",XBNS="BCH"

 D ^XBDBQUE

 D EOJ

 Q

FIRSTRUN ; FIRST RUN EVER (NO LOG ENTRY)

FRLP ;

 S DIR(0)="D^:DT:EP",DIR("A")="Enter Beginning Posting Date to review records" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

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

 S BCHBD=Y

 S BCH("FIRST RUN")=1

 Q

 ;

EOJ ;

 K BCHR,BCH,BCHBD,BCHBDD,BCHED,BCHEDD,BCHPAT,BCHPROG,BCHCAT,BCHACT,BCHHRCN,BCHSD,DFN,BCH80D,BCH80E,BCHAFF,BCHBT,BCHBTH,BCHC,BCHCOM,BCHDATE,BCHDISC,BCHDUZ2,BCHE,BCHINI,BCHJOB,BCHLOC,BCHNAME,BCHO,BCHODAT,BCHPG,BCHQUIT,BCHRCNT

 K BCHREC,BCHTMP,BCHTX,BCHX,X,Y,BCHLENG,Z,CLS,BCHCPOV,BCHAGE,BCHPOVD

 K DIR,DIC,DA,D0

 Q

INFORM ;

 W:$D(IOF) @(IOF)

 W !!,"This program will review all records that have been posted to the CHR",!,"database since that last export was done.  It will review all records that",!,"were posted from the day after the last date of that run up until 2 days ago.",!!

 Q

BCHEXC    ; IHS/CMI/LAB - MAIN DRIVER FOR CHR EXPORT RECORD CHECK ; 

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

 +2       ;

 +3       ;Main routine for the export record check option.

 +4       ;

 +5       ;

START     ;

 +1        DO INFORM

 +2        SET BCH("QFLG")=0

 +3        DO GETLOG^BCHEXDI2

 +4        IF BCH("QFLG")

               GOTO EOJ

CURRUN    ;EP - COMPUTE DATES FOR CURRENT RUN

 +1        SET BCHBD=""

 +2        IF BCH("LAST LOG")

               SET X1=$PIECE(^BCHXLOG(BCH("LAST LOG"),0),U,2)

               SET X2=1

               DO C^%DTC

               SET BCHBD=X

               SET Y=X

               DO DD^%DT

 +3        IF BCHBD=""

               DO FIRSTRUN

 +4        IF BCH("QFLG")

               QUIT 

 +5        SET Y=DT

 +6        IF Y<BCHBD

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

               SET BCH("QFLG")=18

               QUIT 

 +7        SET BCHED=Y

 +8        SET Y=BCHBD

           XECUTE ^DD("DD")

           SET BCH("X")=Y

 +9        SET Y=BCHED

           XECUTE ^DD("DD")

           SET BCH("Y")=Y

 +10       WRITE !!,"This report will review records that were posted between ",BCH("X"),!," and ",BCH("Y"),", inclusive."

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

 +12      ;

 +13       WRITE !!

           SET DIR(0)="Y"

           SET DIR("A")="Do you want to continue"

           SET DIR("B")="Y"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +14       IF $DATA(DIRUT)

               GOTO EOJ

 +15       IF 'Y

               WRITE !!,"okay, bye."

               GOTO EOJ

ZIS       ;

 +1        SET XBRP="^BCHEXCP"

           SET XBRC="^BCHEXC1"

           SET XBRX="EOJ^BCHEXC"

           SET XBNS="BCH"

 +2        DO ^XBDBQUE

 +3        DO EOJ

 +4        QUIT 

FIRSTRUN  ; FIRST RUN EVER (NO LOG ENTRY)

FRLP      ;

 +1        SET DIR(0)="D^:DT:EP"

           SET DIR("A")="Enter Beginning Posting Date to review records"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               SET BCH("QFLG")=99

               QUIT 

 +3        SET BCHBD=Y

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

 +5        QUIT 

 +6       ;

EOJ       ;

 +1        KILL BCHR,BCH,BCHBD,BCHBDD,BCHED,BCHEDD,BCHPAT,BCHPROG,BCHCAT,BCHACT,BCHHRCN,BCHSD,DFN,BCH80D,BCH80E,BCHAFF,BCHBT,BCHBTH,BCHC,BCHCOM,BCHDATE,BCHDISC,BCHDUZ2,BCHE,BCHINI,BCHJOB,BCHLOC,BCHNAME,BCHO,BCHODAT,BCHPG,BCHQUIT,BCHRCNT

 +2        KILL BCHREC,BCHTMP,BCHTX,BCHX,X,Y,BCHLENG,Z,CLS,BCHCPOV,BCHAGE,BCHPOVD

 +3        KILL DIR,DIC,DA,D0

 +4        QUIT 

INFORM    ;

 +1        IF $DATA(IOF)

               WRITE @(IOF)

 +2        WRITE !!,"This program will review all records that have been posted to the CHR",!,"database since that last export was done.  It will review all records that",!,"were posted from the day after the last date of that run up until 2 days ago.",!!

 +3        QUIT