- 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
