- AMHRAP2P ; IHS/CMI/LAB - print all visit report ;
- ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
- PRINT ;
- D NOW^%DTC S Y=X D DD^%DT S AMHDT=Y
- S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y
- D COVPAGE^AMHRPTCP
- S (AMHTOT,AMHPG,AMHPTOT,AMHTTOT,AMHNTOT)=0 D HEAD
- K AMHQUIT
- D SORT
- G:$D(AMHQUIT) DONE
- I $Y>(IOSL-5) D HEAD G:$D(AMHQUIT) DONE
- W !?42,"------",?50,"------",?59,"-------",?70,"------",!
- ;W ?28,"Totals:",?40,$J(AMHTOT,8),?48,$J(AMHPTOT,8) S X=AMHTTOT,X=$J((X/60),6,1) W ?58,$J(X,8)
- W ?28,"Totals:",?40,$J(AMHTOT,8) S X=AMHTTOT,X=$J((X/60),6,1) W ?58,$J(X,8)
- W ?68,$J(AMHNTOT,8)
- DONE ;
- D DONE^AMHLEIN,^AMHEKL
- K ^XTMP("AMHRAP2",AMHJOB,AMHBTH)
- K AMHBT,AMHET
- Q
- SORT ;
- I $Y>(IOSL-6) D HEAD Q:$D(AMHQUIT)
- S AMHSORT="" F S AMHSORT=$O(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TOTAL",AMHSORT)) Q:AMHSORT=""!($D(AMHQUIT)) D P
- Q
- P ;
- I $Y>(IOSL-5) D HEAD Q:$D(AMHQUIT)
- S AMHSRT2=$O(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TOTAL",AMHSORT,""))
- S AMHPRNT=AMHSORT I AMHRPROC="DATE" S Y=AMHPRNT D DD^%DT S AMHPRNT=Y
- W !,$E(AMHPRNT,1,23),?26,$E(AMHSRT2,1,12),?40,$J(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TOTAL",AMHSORT,AMHSRT2),8)
- W ?48,$S($D(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"PATIENT",AMHSORT,AMHSRT2)):$J(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"PATIENT",AMHSORT,AMHSRT2),8),1:$J(0,8))
- I $D(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TIME TOTAL",AMHSORT,AMHSRT2)) S X=^(AMHSRT2),X=$J((X/60),1,1) W ?58,$J(X,8)
- W ?68,$S($D(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"# SERVED",AMHSORT,AMHSRT2)):$J(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"# SERVED",AMHSORT,AMHSRT2),8),1:$J(0,8))
- S AMHTOT=AMHTOT+^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TOTAL",AMHSORT,AMHSRT2)
- S AMHPTOT=AMHPTOT+$S($D(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"PATIENT",AMHSORT,AMHSRT2)):^(AMHSRT2),1:0)
- S AMHNTOT=AMHNTOT+$S($D(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"# SERVED",AMHSORT,AMHSRT2)):^(AMHSRT2),1:0)
- S AMHTTOT=AMHTTOT+$S($D(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TIME TOTAL",AMHSORT,AMHSRT2)):^(AMHSRT2),1:0)
- Q
- HEAD 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 !
- W ?58,AMHDT,?72,"Page ",AMHPG,!
- W ?17,"RECORD DATES: ",AMHBDD," TO ",AMHEDD,!
- S AMHLENG=30+$L(AMHTITL)
- W ?((80-AMHLENG)/2),"NUMBER OF ACTIVITY RECORDS BY ",AMHTITL,!
- W !,AMHHD1,?26,$E(AMHHD2,1,13),?42,"# RECS",?50,"# PATS",?60,"ACTIVITY",?70,"# SERVED",!,?60,"TIME",!
- W !,$TR($J(" ",80)," ","-")
- Q
- AMHRAP2P ; IHS/CMI/LAB - print all visit report ;
- +1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
- PRINT ;
- +1 DO NOW^%DTC
- SET Y=X
- DO DD^%DT
- SET AMHDT=Y
- +2 SET Y=AMHBD
- DO DD^%DT
- SET AMHBDD=Y
- SET Y=AMHED
- DO DD^%DT
- SET AMHEDD=Y
- +3 DO COVPAGE^AMHRPTCP
- +4 SET (AMHTOT,AMHPG,AMHPTOT,AMHTTOT,AMHNTOT)=0
- DO HEAD
- +5 KILL AMHQUIT
- +6 DO SORT
- +7 IF $DATA(AMHQUIT)
- GOTO DONE
- +8 IF $Y>(IOSL-5)
- DO HEAD
- IF $DATA(AMHQUIT)
- GOTO DONE
- +9 WRITE !?42,"------",?50,"------",?59,"-------",?70,"------",!
- +10 ;W ?28,"Totals:",?40,$J(AMHTOT,8),?48,$J(AMHPTOT,8) S X=AMHTTOT,X=$J((X/60),6,1) W ?58,$J(X,8)
- +11 WRITE ?28,"Totals:",?40,$JUSTIFY(AMHTOT,8)
- SET X=AMHTTOT
- SET X=$JUSTIFY((X/60),6,1)
- WRITE ?58,$JUSTIFY(X,8)
- +12 WRITE ?68,$JUSTIFY(AMHNTOT,8)
- DONE ;
- +1 DO DONE^AMHLEIN
- DO ^AMHEKL
- +2 KILL ^XTMP("AMHRAP2",AMHJOB,AMHBTH)
- +3 KILL AMHBT,AMHET
- +4 QUIT
- SORT ;
- +1 IF $Y>(IOSL-6)
- DO HEAD
- IF $DATA(AMHQUIT)
- QUIT
- +2 SET AMHSORT=""
- FOR
- SET AMHSORT=$ORDER(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TOTAL",AMHSORT))
- IF AMHSORT=""!($DATA(AMHQUIT))
- QUIT
- DO P
- +3 QUIT
- P ;
- +1 IF $Y>(IOSL-5)
- DO HEAD
- IF $DATA(AMHQUIT)
- QUIT
- +2 SET AMHSRT2=$ORDER(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TOTAL",AMHSORT,""))
- +3 SET AMHPRNT=AMHSORT
- IF AMHRPROC="DATE"
- SET Y=AMHPRNT
- DO DD^%DT
- SET AMHPRNT=Y
- +4 WRITE !,$EXTRACT(AMHPRNT,1,23),?26,$EXTRACT(AMHSRT2,1,12),?40,$JUSTIFY(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TOTAL",AMHSORT,AMHSRT2),8)
- +5 WRITE ?48,$SELECT($DATA(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"PATIENT",AMHSORT,AMHSRT2)):$JUSTIFY(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"PATIENT",AMHSORT,AMHSRT2),8),1:$JUSTIFY(0,8))
- +6 IF $DATA(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TIME TOTAL",AMHSORT,AMHSRT2))
- SET X=^(AMHSRT2)
- SET X=$JUSTIFY((X/60),1,1)
- WRITE ?58,$JUSTIFY(X,8)
- +7 WRITE ?68,$SELECT($DATA(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"# SERVED",AMHSORT,AMHSRT2)):$JUSTIFY(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"# SERVED",AMHSORT,AMHSRT2),8),1:$JUSTIFY(0,8))
- +8 SET AMHTOT=AMHTOT+^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TOTAL",AMHSORT,AMHSRT2)
- +9 SET AMHPTOT=AMHPTOT+$SELECT($DATA(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"PATIENT",AMHSORT,AMHSRT2)):^(AMHSRT2),1:0)
- +10 SET AMHNTOT=AMHNTOT+$SELECT($DATA(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"# SERVED",AMHSORT,AMHSRT2)):^(AMHSRT2),1:0)
- +11 SET AMHTTOT=AMHTTOT+$SELECT($DATA(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TIME TOTAL",AMHSORT,AMHSRT2)):^(AMHSRT2),1:0)
- +12 QUIT
- HEAD IF 'AMHPG
- GOTO HEAD1
- +1 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 !
- +3 WRITE ?58,AMHDT,?72,"Page ",AMHPG,!
- +4 WRITE ?17,"RECORD DATES: ",AMHBDD," TO ",AMHEDD,!
- +5 SET AMHLENG=30+$LENGTH(AMHTITL)
- +6 WRITE ?((80-AMHLENG)/2),"NUMBER OF ACTIVITY RECORDS BY ",AMHTITL,!
- +7 WRITE !,AMHHD1,?26,$EXTRACT(AMHHD2,1,13),?42,"# RECS",?50,"# PATS",?60,"ACTIVITY",?70,"# SERVED",!,?60,"TIME",!
- +8 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
- +9 QUIT
