Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMHEXCP

AMHEXCP.m

Go to the documentation of this file.
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
 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