Routine: AMHEXDI3

AMHEXDI3 ; IHS/CMI/LAB - initialization part III AUGUST 14, 1992 ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

INFORM ;EP - INFORM OPERATOR WHAT IS GOING TO HAPPEN

 Q:$D(ZTQUEUED)

 W !!,"This routine will generate BH transactions to be sent to HQ.",!,"The transactions are for records posted since the last time you did an",!,"export up until yesterday.",!

 W !,"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 AMH("RUN BEGIN")=""

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

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

 Q:AMH("QFLG")

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

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

 S AMH("RUN END")=Y

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

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

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

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

FIRSTRUN ; FIRST RUN EVER (NO LOG ENTRY)

 I $D(ZTQUEUED),$D(AMHO("SCHEDULED")) S AMH("QFLG")=12 Q

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

FRLP ;

 S DIR(0)="D^::EP",DIR("A")="Enter beginning date for this run" K DA D ^DIR K DIR

 I Y=""!($D(DIRUT)) S AMH("QFLG")=99 Q

 S AMH("X")=Y

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

 S AMH("RUN BEGIN")=Y

 S AMH("FIRST RUN")=1

DATECHK ;

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

 S %DT="PX",X=AMH("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=""

ERRBULL ;ENTRY POINT - ERROR BULLETIN

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

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

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

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

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

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

 S XMDUZ=.5 D ^XMB

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

AMHEXDI3  ; IHS/CMI/LAB - initialization part III AUGUST 14, 1992 ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

INFORM    ;EP - INFORM OPERATOR WHAT IS GOING TO HAPPEN

 +1        IF $DATA(ZTQUEUED)

               QUIT

 +2        WRITE !!,"This routine will generate BH transactions to be sent to HQ.",!,"The transactions are for records posted since the last time you did an",!,"export 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 AMH("RUN BEGIN")=""

 +2        IF AMH("LAST LOG")

               SET X1=$PIECE(^AMHXLOG(AMH("LAST LOG"),0),U,2)

               SET X2=1

               DO C^%DTC

               SET AMH("RUN BEGIN")=X

               SET Y=X

               DO DD^%DT

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

               DO FIRSTRUN

 +4        IF AMH("QFLG")

               QUIT

 +5        SET X1=DT

           SET X2=-2

           DO C^%DTC

           SET Y=X

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

               IF '$DATA(ZTQUEUED)

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

               SET AMH("QFLG")=18

               QUIT

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

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

           XECUTE ^DD("DD")

           SET AMH("X")=Y

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

           XECUTE ^DD("DD")

           SET AMH("Y")=Y

 +10       IF '$DATA(ZTQUEUED)

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

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

 +12       QUIT

 +13      ;

FIRSTRUN  ; FIRST RUN EVER (NO LOG ENTRY)

 +1        IF $DATA(ZTQUEUED)

               IF $DATA(AMHO("SCHEDULED"))

                   SET AMH("QFLG")=12

                   QUIT

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

FRLP      ;

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

           SET DIR("A")="Enter beginning date for this run"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF Y=""!($DATA(DIRUT))

               SET AMH("QFLG")=99

               QUIT

 +3        SET AMH("X")=Y

 +4        DO DATECHK

           IF AMH("QFLG")

               QUIT

           IF Y=""

               GOTO FRLP

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

 +6        SET AMH("FIRST RUN")=1

 +7        QUIT

 +8       ;

DATECHK   ;

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

               SET AMH("QFLG")=99

               QUIT

 +2        SET %DT="PX"

           SET X=AMH("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        SET AMH("QFLG1")=$ORDER(^AMHDTEC("B",AMH("QFLG"),""))

           SET AMH("QFLG DES")=$PIECE(^AMHDTEC(AMH("QFLG1"),0),U,2)

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

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

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

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

               SET XMB(5)="<UNKNOWN>"

               GOTO ERRBULL1

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

           DO DD^%DT

           SET XMB(5)=Y

ERRBULL1   SET Y=DT

           DO DD^%DT

           SET XMB(1)=Y

           SET XMB="AMH BH TRANSMISSION ERROR"

 +1        SET XMDUZ=.5

           DO ^XMB

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

 +3        QUIT

AMHEXDI3.m