AMHEYDI3.m

AMHEYDI3 ; 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.",!,"Both BH visit records and Suicide forms will be exported.",!

 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 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")

 Q

 ;

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

 Q

 ;

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=""

 Q

 ;

ERRBULL ;ENTRY POINT - ERROR BULLETIN

 S AMH("QFLG1")=$O(^AMHDTER("B",AMH("QFLG"),"")),AMH("QFLG DES")=$P(^AMHDTER(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

 Q

AMHEYDI3  ; 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.",!,"Both BH visit records and Suicide forms will be exported.",!

 +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(^AMHDTER("B",AMH("QFLG"),""))

           SET AMH("QFLG DES")=$PIECE(^AMHDTER(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