BCHEXDI3.m

BCHEXDI3 ; IHS/CMI/LAB - initialization part III ; 

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

 ;

 ;CHR export initialization for new export.

 ;

INFORM ;EP - INFORM OPERATOR WHAT IS GOING TO HAPPEN

 Q:$D(ZTQUEUED)

 W !!,"This routine will generate CHR records to be sent to HQ.",!,"The data transmitted will include everything entered since the last time",!,"data was exported up until yesterday."

 W !,"You may ""^"" out at any prompt and will be",!,"ask to confirm your entries prior to generating transactions."

 Q

 ;

CURRUN ;EP - COMPUTE DATES FOR CURRENT RUN

 S BCH("RUN BEGIN")=""

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

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

 Q:BCH("QFLG")

 S X1=DT,X2=-1 D C^%DTC S Y=X

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

 S BCH("RUN END")=Y

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

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

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

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

 Q

 ;

FIRSTRUN ; FIRST RUN EVER (NO LOG ENTRY)

 I $D(ZTQUEUED),$D(BCHO("SCHEDULED")) S BCH("RUN BEGIN")=2950101,BCH("FIRST RUN")=1 Q

 W !!,"No log entry.  First run ever assumed.",!

FRLP ;

 K DIR W ! S DIR(0)="D^::EP",DIR("A")="Enter Beginning Date for this Run" K DA D ^DIR K DIR

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

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

 S BCH("X")=Y

 D DATECHK Q:BCH("QFLG")  G:Y="" FRLP

 S BCH("RUN BEGIN")=Y

 S BCH("FIRST RUN")=1

 Q

 ;

DATECHK ;

 I BCH("X")="^" S BCH("QFLG")=99 Q

 S %DT="PX",X=BCH("X") D ^%DT I X="?" S Y="" Q

 I Y<0!(Y>DT)!(Y=DT) W !!,$S(Y>DT!(Y=DT):"  Current or future date not allowed!",1:"  Invalid date!"),$C(7) S Y=""

 Q

 ;

ERRBULL ;ENTRY POINT - ERROR BULLETIN

 Q:BCH("QFLG")=22  ;if error is 22, no visits don't send bulletin

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

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

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

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

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

ERRBULL1 S Y=DT D DD^%DT S XMB(1)=Y,XMB="BCH CHR TRANSMISSION ERROR"

 S XMDUZ=.5 D ^XMB

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

 Q

BCHEXDI3  ; IHS/CMI/LAB - initialization part III ; 

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

 +2       ;

 +3       ;CHR export initialization for new export.

 +4       ;

INFORM    ;EP - INFORM OPERATOR WHAT IS GOING TO HAPPEN

 +1        IF $DATA(ZTQUEUED)

               QUIT 

 +2        WRITE !!,"This routine will generate CHR records to be sent to HQ.",!,"The data transmitted will include everything entered since the last time",!,"data was exported up until yesterday."

 +3        WRITE !,"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 BCH("RUN BEGIN")=""

 +2        IF BCH("LAST LOG")

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

               SET X2=1

               DO C^%DTC

               SET BCH("RUN BEGIN")=X

               SET Y=X

               DO DD^%DT

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

               DO FIRSTRUN

 +4        IF BCH("QFLG")

               QUIT 

 +5        SET X1=DT

           SET X2=-1

           DO C^%DTC

           SET Y=X

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

               IF '$DATA(ZTQUEUED)

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

               SET BCH("QFLG")=18

               QUIT 

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

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

           XECUTE ^DD("DD")

           SET BCH("X")=Y

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

           XECUTE ^DD("DD")

           SET BCH("Y")=Y

 +10       IF '$DATA(ZTQUEUED)

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

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

 +12       QUIT 

 +13      ;

FIRSTRUN  ; FIRST RUN EVER (NO LOG ENTRY)

 +1        IF $DATA(ZTQUEUED)

               IF $DATA(BCHO("SCHEDULED"))

                   SET BCH("RUN BEGIN")=2950101

                   SET BCH("FIRST RUN")=1

                   QUIT 

 +2        WRITE !!,"No log entry.  First run ever assumed.",!

FRLP      ;

 +1        KILL DIR

           WRITE !

           SET DIR(0)="D^::EP"

           SET DIR("A")="Enter Beginning Date for this Run"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)

               SET BCH("QFLG")=99

               QUIT 

 +3        IF Y=""

               SET BCH("QFLG")=99

               QUIT 

 +4        SET BCH("X")=Y

 +5        DO DATECHK

           IF BCH("QFLG")

               QUIT 

           IF Y=""

               GOTO FRLP

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

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

 +8        QUIT 

 +9       ;

DATECHK   ;

 +1        IF BCH("X")="^"

               SET BCH("QFLG")=99

               QUIT 

 +2        SET %DT="PX"

           SET X=BCH("X")

           DO ^%DT

           IF X="?"

               SET Y=""

               QUIT 

 +3        IF Y<0!(Y>DT)!(Y=DT)

               WRITE !!,$SELECT(Y>DT!(Y=DT):"  Current or future date not allowed!",1:"  Invalid date!"),$CHAR(7)

               SET Y=""

 +4        QUIT 

 +5       ;

ERRBULL   ;ENTRY POINT - ERROR BULLETIN

 +1       ;if error is 22, no visits don't send bulletin

           IF BCH("QFLG")=22

               QUIT 

 +2        SET BCH("QFLG1")=$ORDER(^BCHDTER("B",BCH("QFLG"),""))

           SET BCH("QFLG DES")=$PIECE(^BCHDTER(BCH("QFLG1"),0),U,2)

 +3        SET XMB(2)=BCH("QFLG")

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

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

 +5        IF '$DATA(BCH("RUN BEGIN"))

               SET XMB(5)="<UNKNOWN>"

               GOTO ERRBULL1

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

           DO DD^%DT

           SET XMB(5)=Y

ERRBULL1   SET Y=DT

           DO DD^%DT

           SET XMB(1)=Y

           SET XMB="BCH CHR TRANSMISSION ERROR"

 +1        SET XMDUZ=.5

           DO ^XMB

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

 +3        QUIT