AMHEXCP.m

AMHEXCP ; IHS/CMI/LAB - PRNT RECORD REVIEW ;

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

 ;

START ;

 S AMH80E="==============================================================================="

 S AMH80D="-------------------------------------------------------------------------------"

 S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y

 S AMHPG=0 D HEAD I '$D(^XTMP("AMHEXC",AMHJOB,AMHBT)) W !,"No errors to report",! G DONE

 S AMHR=0 K AMHQUIT

 F  S AMHR=$O(^XTMP("AMHEXC",AMHJOB,AMHBT,"ERRORS",AMHR)) Q:AMHR=""!($D(AMHQUIT))  S AMHREC=^AMHREC(AMHR,0) D PROC

 G:$D(AMHQUIT) DONE

 I $Y>(IOSL-6) D HEAD G:$D(AMHQUIT) DONE

DONE ;

 D DONE^AMHLEIN

 K ^XTMP("AMHEXC",AMHJOB,AMHBT)

 Q

PROC ;

 I $Y>(IOSL-5) D HEAD Q:$D(AMHQUIT)

 S Y=$P(AMHREC,U) D DD^%DT S AMHDATE=Y

 S AMHNAME=$P(^AMHREC(AMHR,0),U,8) I AMHNAME]"" S AMHNAME=$E($P(^DPT(AMHNAME,0),U),1,20)

 S AMHHRCN="" I $P(^AMHREC(AMHR,0),U,8) S AMHHRCN=$S($D(^AUPNPAT($P(^AMHREC(AMHR,0),U,8),41,DUZ(2),0)):$P(^(0),U,2),1:"<none>")

 S AMHPROG=$P(^AMHREC(AMHR,0),U,2)

 K ^UTILITY("DIQ1",$J)

 K DIQ,DIC,DA,DR

 S DIC="^AMHREC(",DR=".07",DA=AMHR,DIQ(0)="E" D EN^DIQ1 K DIC,DA,DR,DIQ

 S AMHCAT=$E(^UTILITY("DIQ1",$J,9002011,AMHR,.07,"E"),1,14)

 K ^UTILITY("DIQ1",$J)

 K DIQ,DIC,DA,DR

 S DIC="^AMHREC(",DR=".06",DA=AMHR,DIQ(0)="E" D EN^DIQ1 K DIC,DA,DR,DIQ

 S AMHACT=$E(^UTILITY("DIQ1",$J,9002011,AMHR,.06,"E"),1,7)

 K ^UTILITY("DIQ1",$J)

 W !!,AMHDATE,?22,AMHNAME,?43,AMHHRCN,?52,AMHPROG,?56,AMHCAT,?74,AMHACT,!,^XTMP("AMHEXC",AMHJOB,AMHBT,"ERRORS",AMHR)

 Q

CHKDISC ;

 Q:'$D(^VA(200,AMHAP))

 S AMHDISC=$$PPCLSC^AMHUTIL(AMHRPROC)

 S AMHINI=$$PPINI^AMHUTIL(AMHRPROC)

 Q

HEAD ;ENTRY POINT

 I 'AMHPG G HEAD1

 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S AMHQUIT="" Q

HEAD1 ;

 W:$D(IOF) @IOF S AMHPG=AMHPG+1

 W ?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),?72,"Page ",AMHPG,!

 S AMHLENG=26

 W ?((80-AMHLENG)/2),"BH EXPORT RECORD REVIEW",!

 W ?15,"Record Posting Dates:  ",AMHBDD," and ",AMHEDD,!

 W !!,"RECORD DATE",?22,"PATIENT",?43,"HRN",?51,"PGM",?56,"TYPE",?72,"ACT TYPE"

 W !,AMH80D

 Q

AMHEXCP   ; IHS/CMI/LAB - PRNT RECORD REVIEW ;

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

 +2       ;

START     ;

 +1        SET AMH80E="==============================================================================="

 +2        SET AMH80D="-------------------------------------------------------------------------------"

 +3        SET Y=AMHBD

           DO DD^%DT

           SET AMHBDD=Y

           SET Y=AMHED

           DO DD^%DT

           SET AMHEDD=Y

 +4        SET AMHPG=0

           DO HEAD

           IF '$DATA(^XTMP("AMHEXC",AMHJOB,AMHBT))

               WRITE !,"No errors to report",!

               GOTO DONE

 +5        SET AMHR=0

           KILL AMHQUIT

 +6        FOR 

               SET AMHR=$ORDER(^XTMP("AMHEXC",AMHJOB,AMHBT,"ERRORS",AMHR))

               IF AMHR=""!($DATA(AMHQUIT))

                   QUIT 

               SET AMHREC=^AMHREC(AMHR,0)

               DO PROC

 +7        IF $DATA(AMHQUIT)

               GOTO DONE

 +8        IF $Y>(IOSL-6)

               DO HEAD

               IF $DATA(AMHQUIT)

                   GOTO DONE

DONE      ;

 +1        DO DONE^AMHLEIN

 +2        KILL ^XTMP("AMHEXC",AMHJOB,AMHBT)

 +3        QUIT 

PROC      ;

 +1        IF $Y>(IOSL-5)

               DO HEAD

               IF $DATA(AMHQUIT)

                   QUIT 

 +2        SET Y=$PIECE(AMHREC,U)

           DO DD^%DT

           SET AMHDATE=Y

 +3        SET AMHNAME=$PIECE(^AMHREC(AMHR,0),U,8)

           IF AMHNAME]""

               SET AMHNAME=$EXTRACT($PIECE(^DPT(AMHNAME,0),U),1,20)

 +4        SET AMHHRCN=""

           IF $PIECE(^AMHREC(AMHR,0),U,8)

               SET AMHHRCN=$SELECT($DATA(^AUPNPAT($PIECE(^AMHREC(AMHR,0),U,8),41,DUZ(2),0)):$PIECE(^(0),U,2),1:"<none>")

 +5        SET AMHPROG=$PIECE(^AMHREC(AMHR,0),U,2)

 +6        KILL ^UTILITY("DIQ1",$JOB)

 +7        KILL DIQ,DIC,DA,DR

 +8        SET DIC="^AMHREC("

           SET DR=".07"

           SET DA=AMHR

           SET DIQ(0)="E"

           DO EN^DIQ1

           KILL DIC,DA,DR,DIQ

 +9        SET AMHCAT=$EXTRACT(^UTILITY("DIQ1",$JOB,9002011,AMHR,.07,"E"),1,14)

 +10       KILL ^UTILITY("DIQ1",$JOB)

 +11       KILL DIQ,DIC,DA,DR

 +12       SET DIC="^AMHREC("

           SET DR=".06"

           SET DA=AMHR

           SET DIQ(0)="E"

           DO EN^DIQ1

           KILL DIC,DA,DR,DIQ

 +13       SET AMHACT=$EXTRACT(^UTILITY("DIQ1",$JOB,9002011,AMHR,.06,"E"),1,7)

 +14       KILL ^UTILITY("DIQ1",$JOB)

 +15       WRITE !!,AMHDATE,?22,AMHNAME,?43,AMHHRCN,?52,AMHPROG,?56,AMHCAT,?74,AMHACT,!,^XTMP("AMHEXC",AMHJOB,AMHBT,"ERRORS",AMHR)

 +16       QUIT 

CHKDISC   ;

 +1        IF '$DATA(^VA(200,AMHAP))

               QUIT 

 +2        SET AMHDISC=$$PPCLSC^AMHUTIL(AMHRPROC)

 +3        SET AMHINI=$$PPINI^AMHUTIL(AMHRPROC)

 +4        QUIT 

HEAD      ;ENTRY POINT

 +1        IF 'AMHPG

               GOTO HEAD1

 +2        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   WRITE !

                   SET DIR(0)="EO"

                   DO ^DIR

                   KILL DIR

                   IF Y=0!(Y="^")!($DATA(DTOUT))

                       SET AMHQUIT=""

                       QUIT 

HEAD1     ;

 +1        IF $DATA(IOF)

               WRITE @IOF

           SET AMHPG=AMHPG+1

 +2        WRITE ?(80-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))/2),$PIECE(^DIC(4,DUZ(2),0),U),?72,"Page ",AMHPG,!

 +3        SET AMHLENG=26

 +4        WRITE ?((80-AMHLENG)/2),"BH EXPORT RECORD REVIEW",!

 +5        WRITE ?15,"Record Posting Dates:  ",AMHBDD," and ",AMHEDD,!

 +6        WRITE !!,"RECORD DATE",?22,"PATIENT",?43,"HRN",?51,"PGM",?56,"TYPE",?72,"ACT TYPE"

 +7        WRITE !,AMH80D

 +8        QUIT