Routine: AMHEYC

AMHEYC ; IHS/CMI/LAB - MAIN DRIVER FOR PCC EXPORT RECORD CHECK ;

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

START ;

 D INFORM

 S AMH("QFLG")=0

 D GETLOG^AMHEYDI2

 I AMH("QFLG") G EOJ

CURRUN ;EP - COMPUTE DATES FOR CURRENT RUN

 S AMHBD=""

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

 I AMHBD="" D FIRSTRUN

 Q:AMH("QFLG")

 S Y=DT

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

 S AMHED=Y

 S Y=AMHBD X ^DD("DD") S AMH("X")=Y

 S Y=AMHED X ^DD("DD") S AMH("Y")=Y

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

 K %,%H,%I,AMH("RDFN"),AMH("X"),AMH("Y"),AMH("LAST LOG"),AMH("LAST BEGIN"),AMH("Z"),AMH("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="^AMHEYCP",XBRC="^AMHEYC1",XBRX="EOJ^AMHEYC",XBNS="AMH"

 D ^XBDBQUE

 D EOJ

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 AMH("QFLG")=99 Q

 S AMHBD=Y

 S AMH("FIRST RUN")=1

EOJ ;

 K AMHR,AMH,AMHBD,AMHBDD,AMHED,AMHEDD,AMHPAT,AMHPROG,AMHCAT,AMHACT,AMHHRCN,AMHSD,DFN,AMH80D,AMH80E,AMHAFF,AMHBT,AMHBTH,AMHC,AMHCOM,AMHDATE,AMHDISC,AMHDUZ2,AMHE,AMHINI,AMHJOB,AMHLOC,AMHNAME,AMHO,AMHODAT,AMHPG,AMHQUIT,AMHRCNT

 K AMHREC,AMHTMP,AMHTX,AMHX,X,Y,AMHLENG,Z

 K DIR,DIC,DA,D0

INFORM ;

 W:$D(IOF) @(IOF)

 W !!,"This program will review all records that have been posted to the BH",!,"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.",!!

AMHEYC    ; IHS/CMI/LAB - MAIN DRIVER FOR PCC EXPORT RECORD CHECK ;

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

 +2       ;

 +3       ;

 +4       ;

START     ;

 +1        DO INFORM

 +2        SET AMH("QFLG")=0

 +3        DO GETLOG^AMHEYDI2

 +4        IF AMH("QFLG")

               GOTO EOJ

CURRUN    ;EP - COMPUTE DATES FOR CURRENT RUN

 +1        SET AMHBD=""

 +2        IF AMH("LAST LOG")

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

               SET X2=1

               DO C^%DTC

               SET AMHBD=X

               SET Y=X

               DO DD^%DT

 +3        IF AMHBD=""

               DO FIRSTRUN

 +4        IF AMH("QFLG")

               QUIT

 +5        SET Y=DT

 +6        IF Y<AMHBD

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

               SET AMH("QFLG")=18

               QUIT

 +7        SET AMHED=Y

 +8        SET Y=AMHBD

           XECUTE ^DD("DD")

           SET AMH("X")=Y

 +9        SET Y=AMHED

           XECUTE ^DD("DD")

           SET AMH("Y")=Y

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

 +11       KILL %,%H,%I,AMH("RDFN"),AMH("X"),AMH("Y"),AMH("LAST LOG"),AMH("LAST BEGIN"),AMH("Z"),AMH("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="^AMHEYCP"

           SET XBRC="^AMHEYC1"

           SET XBRX="EOJ^AMHEYC"

           SET XBNS="AMH"

 +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 AMH("QFLG")=99

               QUIT

 +3        SET AMHBD=Y

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

 +5        QUIT

 +6       ;

EOJ       ;

 +1        KILL AMHR,AMH,AMHBD,AMHBDD,AMHED,AMHEDD,AMHPAT,AMHPROG,AMHCAT,AMHACT,AMHHRCN,AMHSD,DFN,AMH80D,AMH80E,AMHAFF,AMHBT,AMHBTH,AMHC,AMHCOM,AMHDATE,AMHDISC,AMHDUZ2,AMHE,AMHINI,AMHJOB,AMHLOC,AMHNAME,AMHO,AMHODAT,AMHPG,AMHQUIT,AMHRCNT

 +2        KILL AMHREC,AMHTMP,AMHTX,AMHX,X,Y,AMHLENG,Z

 +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 BH",!,"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

AMHEYC.m