AMHRAT2P ; IHS/CMI/LAB - print all visit report ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
START ;
S AMHR132S="",$P(AMHR132S,"-",132)=""
D NOW^%DTC S Y=X D DD^%DT S AMHRDT=Y
D COVPAGE^AMHRPTCP
S (AMHRPG,AMHSORT)=0 D HEAD
K AMHRQUIT
F S AMHSORT=$O(^XTMP("AMHRAT2",AMHJOB,AMHBTH,AMHSORT)) Q:AMHSORT=""!($D(AMHRQUIT)) D SORT
G:$D(AMHRQUIT) DONE
I $Y>(IOSL-5) D HEAD G:$D(AMHRQUIT) DONE
W !?5,"TOTALS:" S AMHRTAB=18
F A="C","S","M" S AMHRTAB=AMHRTAB+5 D
.F B="REC TOTAL","PATIENT TOTAL","TIME TOTAL" D:B="TIME TOTAL" W ?AMHRTAB,$S($D(AMHRTOT(A,B)):$J(AMHRTOT(A,B),7),1:$J(".",7)) S AMHRTAB=AMHRTAB+11
..Q:'$D(AMHRTOT(A,B))
..S X=AMHRTOT(A,B),X=$J((X/60),1,1),AMHRTOT(A,B)=X
..Q
.Q
I $Y>(IOSL-5) D HEAD G:$D(AMHRQUIT) DONE
W !!,"**** Patient Count TOTAL is not an unduplicated count.",!
DONE ;
D DONE^AMHLEIN,^AMHEKL
K ^XTMP("AMHRAT2",AMHJOB,AMHBTH)
Q
SORT ;
I $Y>(IOSL-5) D HEAD Q:$D(AMHRQUIT)
W !,$E(AMHSORT,1,20) S AMHRTAB=18
F A="C","S","M" S AMHRTAB=AMHRTAB+5 D
.F B="REC TOTAL","PATIENT TOTAL","TIME TOTAL" D TOTALS D:B="TIME TOTAL" W ?AMHRTAB,$S($D(^XTMP("AMHRAT2",AMHJOB,AMHBTH,AMHSORT,A,B)):$J(^(B),7),1:$J(".",7)) S AMHRTAB=AMHRTAB+11
..Q:'$D(^XTMP("AMHRAT2",AMHJOB,AMHBTH,AMHSORT,A,B))
..S X=^XTMP("AMHRAT2",AMHJOB,AMHBTH,AMHSORT,A,B),X=$J((X/60),1,1),^(B)=X
..Q
.Q
Q
TOTALS ;
Q:'$D(^XTMP("AMHRAT2",AMHJOB,AMHBTH,AMHSORT,A,B))
S:'$D(AMHRTOT(A,B)) AMHRTOT(A,B)=0 S AMHRTOT(A,B)=AMHRTOT(A,B)+^XTMP("AMHRAT2",AMHJOB,AMHBTH,AMHSORT,A,B)
Q
HEAD I 'AMHRPG 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 AMHRQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF S AMHRPG=AMHRPG+1
W ?50,"MENTAL HEALTH AND SOCIAL SERVICE",?100,AMHRDT,?123,"Page ",AMHRPG,!
S AMHRLENG=62+$L(AMHTITL) W ?((132-AMHRLENG)/2),"ACTIVITY TIME, PATIENT AND RECORD COUNT REPORT BY PROGRAM AND ",AMHTITL,!
W ?45,"RECORD DATES: ",AMHBDD," TO ",AMHEDD,!
W !?20,"SOCIAL SERVICES AND MENTAL HEALTH COMB",?69,"SOCIAL SERVICE",?104,"MENTAL HEALTH",!
W ?23,"NO. OF",?34,"NO. OF",?46,"TOTAL",?62,"NO. OF",?73,"NO. OF",?85,"TOTAL",?99,"NO. OF",?109,"NO. OF",?121,"TOTAL",!
W $E(AMHHD1,1,20),?23,"RECORDS",?34,"PATIENTS",?44,"ACTIV TIME",?62,"RECORDS",?73,"PATIENTS",?83,"ACTIV TIME",?99,"RECORDS",?109,"PATIENTS",?119,"ACTIV TIME",!
W AMHR132S,!
AMHRAT2P ; IHS/CMI/LAB - print all visit report ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
START ;
+1 SET AMHR132S=""
SET $PIECE(AMHR132S,"-",132)=""
+2 DO NOW^%DTC
SET Y=X
DO DD^%DT
SET AMHRDT=Y
+3 DO COVPAGE^AMHRPTCP
+4 SET (AMHRPG,AMHSORT)=0
DO HEAD
+5 KILL AMHRQUIT
+6 FOR
SET AMHSORT=$ORDER(^XTMP("AMHRAT2",AMHJOB,AMHBTH,AMHSORT))
IF AMHSORT=""!($DATA(AMHRQUIT))
QUIT
DO SORT
+7 IF $DATA(AMHRQUIT)
GOTO DONE
+8 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(AMHRQUIT)
GOTO DONE
+9 WRITE !?5,"TOTALS:"
SET AMHRTAB=18
+10 FOR A="C","S","M"
SET AMHRTAB=AMHRTAB+5
Begin DoDot:1
+11 FOR B="REC TOTAL","PATIENT TOTAL","TIME TOTAL"
IF B="TIME TOTAL"
Begin DoDot:2
+12 IF '$DATA(AMHRTOT(A,B))
QUIT
+13 SET X=AMHRTOT(A,B)
SET X=$JUSTIFY((X/60),1,1)
SET AMHRTOT(A,B)=X
+14 QUIT
End DoDot:2
WRITE ?AMHRTAB,$SELECT($DATA(AMHRTOT(A,B)):$JUSTIFY(AMHRTOT(A,B),7),1:$JUSTIFY(".",7))
SET AMHRTAB=AMHRTAB+11
+15 QUIT
End DoDot:1
+16 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(AMHRQUIT)
GOTO DONE
+17 WRITE !!,"**** Patient Count TOTAL is not an unduplicated count.",!
DONE ;
+1 DO DONE^AMHLEIN
DO ^AMHEKL
+2 KILL ^XTMP("AMHRAT2",AMHJOB,AMHBTH)
+3 QUIT
SORT ;
+1 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(AMHRQUIT)
QUIT
+2 WRITE !,$EXTRACT(AMHSORT,1,20)
SET AMHRTAB=18
+3 FOR A="C","S","M"
SET AMHRTAB=AMHRTAB+5
Begin DoDot:1
+4 FOR B="REC TOTAL","PATIENT TOTAL","TIME TOTAL"
DO TOTALS
IF B="TIME TOTAL"
Begin DoDot:2
+5 IF '$DATA(^XTMP("AMHRAT2",AMHJOB,AMHBTH,AMHSORT,A,B))
QUIT
+6 SET X=^XTMP("AMHRAT2",AMHJOB,AMHBTH,AMHSORT,A,B)
SET X=$JUSTIFY((X/60),1,1)
SET ^(B)=X
+7 QUIT
End DoDot:2
WRITE ?AMHRTAB,$SELECT($DATA(^XTMP("AMHRAT2",AMHJOB,AMHBTH,AMHSORT,A,B)):$JUSTIFY(^(B),7),1:$JUSTIFY(".",7))
SET AMHRTAB=AMHRTAB+11
+8 QUIT
End DoDot:1
+9 QUIT
TOTALS ;
+1 IF '$DATA(^XTMP("AMHRAT2",AMHJOB,AMHBTH,AMHSORT,A,B))
QUIT
+2 IF '$DATA(AMHRTOT(A,B))
SET AMHRTOT(A,B)=0
SET AMHRTOT(A,B)=AMHRTOT(A,B)+^XTMP("AMHRAT2",AMHJOB,AMHBTH,AMHSORT,A,B)
+3 QUIT
HEAD IF 'AMHRPG
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 AMHRQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET AMHRPG=AMHRPG+1
+2 WRITE ?50,"MENTAL HEALTH AND SOCIAL SERVICE",?100,AMHRDT,?123,"Page ",AMHRPG,!
+3 SET AMHRLENG=62+$LENGTH(AMHTITL)
WRITE ?((132-AMHRLENG)/2),"ACTIVITY TIME, PATIENT AND RECORD COUNT REPORT BY PROGRAM AND ",AMHTITL,!
+4 WRITE ?45,"RECORD DATES: ",AMHBDD," TO ",AMHEDD,!
+5 WRITE !?20,"SOCIAL SERVICES AND MENTAL HEALTH COMB",?69,"SOCIAL SERVICE",?104,"MENTAL HEALTH",!
+6 WRITE ?23,"NO. OF",?34,"NO. OF",?46,"TOTAL",?62,"NO. OF",?73,"NO. OF",?85,"TOTAL",?99,"NO. OF",?109,"NO. OF",?121,"TOTAL",!
+7 WRITE $EXTRACT(AMHHD1,1,20),?23,"RECORDS",?34,"PATIENTS",?44,"ACTIV TIME",?62,"RECORDS",?73,"PATIENTS",?83,"ACTIV TIME",?99,"RECORDS",?109,"PATIENTS",?119,"ACTIV TIME",!
+8 WRITE AMHR132S,!
