- 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,!
