- AMHRPSP ; IHS/CMI/LAB - ;
- ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
- ;
- PRINT ;EP ;PRINT RECORD BY AGE/SEX
- S AMHR132S="",$P(AMHR132S,"-",132)=""
- D NOW^%DTC S Y=X D DD^%DT S AMHRDT=Y
- S AMHRPG=0,AMHSORT="",AMHRSEX=""
- K AMHQUIT
- I '$D(^XTMP("AMHRPS",AMHJOB,AMHBTH,"AGE")) D HEAD W !!,"No data to report.",! G DONE
- F S AMHRSEX=$O(^XTMP("AMHRPS",AMHJOB,AMHBTH,"AGE",AMHRSEX)) Q:AMHRSEX=""!($D(AMHQUIT)) D SORT
- DONE ;
- D DONE^AMHLEIN,^AMHEKL
- K ^XTMP("AMHRPS",AMHJOB,AMHBTH)
- Q
- SORT ;
- I AMHRSEX="B" D HEAD Q:$D(AMHQUIT) G SORT1
- I $Y>(IOSL-8) D HEAD Q:$D(AMHQUIT) G SORT1
- W !! D HEAD2
- SORT1 S AMHSORT=""
- F S AMHSORT=$O(^XTMP("AMHRPS",AMHJOB,AMHBTH,"AGE",AMHRSEX,AMHSORT)) Q:AMHSORT=""!($D(AMHQUIT)) D
- .I $Y>(IOSL-5) D HEAD Q:$D(AMHQUIT)
- .S AMHSORTP=$O(^AMHPROB("B",AMHSORT,"")),AMHSORTP=AMHSORT_" - "_$P(^AMHPROB(AMHSORTP,0),U,2)
- .W !,$E(AMHSORTP,1,30) S AMHRSRT2=$O(^XTMP("AMHRAGS",AMHJOB,AMHBTH,"AGE",AMHRSEX,AMHSORT,"")) W ?32,$E(AMHRSRT2,1,9)
- .N I,J,K S J=39 F I=1:1:$L(AMHRBIN,";") S K=$S($D(^XTMP("AMHRPS",AMHJOB,AMHBTH,"AGE",AMHRSEX,AMHSORT,I)):^(I),1:".") W ?J,$J(K,6) S J=J+9
- .W ?J,$J(^XTMP("AMHRPS",AMHJOB,AMHBTH,"TOTAL SORT",AMHRSEX,AMHSORT),6)
- .Q
- Q:$D(AMHQUIT)
- I $Y>(IOSL-5) D HEAD Q:$D(AMHQUIT)
- S T=0 W !,"TOTAL:" S J=39 F I=1:1:$L(AMHRBIN,";") S K=$S($D(^XTMP("AMHRPS",AMHJOB,AMHBTH,"TOTAL",AMHRSEX,I)):^(I),1:".") W ?J,$J(K,6) S J=J+9,T=T+K
- W ?J,$J(T,6)
- 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 AMHQUIT="" Q
- HEAD1 ;
- W:$D(IOF) @IOF S AMHRPG=AMHRPG+1
- W ?50,"BEHAVIORAL HEALTH",?100,AMHRDT,?123,"Page",AMHRPG,!
- S AMHRLENG=15+$L(AMHTITLE) W ?((132-AMHRLENG)/2),AMHTITLE," BY AGE AND SEX",!
- W ?46,"VISIT DATES: ",AMHBDD," TO ",AMHEDD,!
- HEAD2 W !?61,"SEX: ",$S(AMHRSEX="M":"MALE",AMHRSEX="F":"FEMALE",1:"BOTH")
- W !,"PROB CODE NARRATIVE" S J=41 F I=1:1:$L(AMHRBIN,";") S K=$P(AMHRBIN,";",I) Q:K="" W ?J,K S J=J+9
- W ?J,"TOTAL"
- W !,AMHR132S
- Q
- ;
- LIST ;
- S %=AMHRBIN
- F I=1:1 S X=$P(%,";",I) Q:X="" W !,$P(X,"-")," - ",$P(X,"-",2)
- W !
- Q
- ;
- SETBIN ;
- S AMHRBIN="0-0;1-4;5-14;15-19;20-24;25-44;45-64;65-125"
- Q
- AMHRPSP ; IHS/CMI/LAB - ;
- +1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
- +2 ;
- PRINT ;EP ;PRINT RECORD BY AGE/SEX
- +1 SET AMHR132S=""
- SET $PIECE(AMHR132S,"-",132)=""
- +2 DO NOW^%DTC
- SET Y=X
- DO DD^%DT
- SET AMHRDT=Y
- +3 SET AMHRPG=0
- SET AMHSORT=""
- SET AMHRSEX=""
- +4 KILL AMHQUIT
- +5 IF '$DATA(^XTMP("AMHRPS",AMHJOB,AMHBTH,"AGE"))
- DO HEAD
- WRITE !!,"No data to report.",!
- GOTO DONE
- +6 FOR
- SET AMHRSEX=$ORDER(^XTMP("AMHRPS",AMHJOB,AMHBTH,"AGE",AMHRSEX))
- IF AMHRSEX=""!($DATA(AMHQUIT))
- QUIT
- DO SORT
- DONE ;
- +1 DO DONE^AMHLEIN
- DO ^AMHEKL
- +2 KILL ^XTMP("AMHRPS",AMHJOB,AMHBTH)
- +3 QUIT
- SORT ;
- +1 IF AMHRSEX="B"
- DO HEAD
- IF $DATA(AMHQUIT)
- QUIT
- GOTO SORT1
- +2 IF $Y>(IOSL-8)
- DO HEAD
- IF $DATA(AMHQUIT)
- QUIT
- GOTO SORT1
- +3 WRITE !!
- DO HEAD2
- SORT1 SET AMHSORT=""
- +1 FOR
- SET AMHSORT=$ORDER(^XTMP("AMHRPS",AMHJOB,AMHBTH,"AGE",AMHRSEX,AMHSORT))
- IF AMHSORT=""!($DATA(AMHQUIT))
- QUIT
- Begin DoDot:1
- +2 IF $Y>(IOSL-5)
- DO HEAD
- IF $DATA(AMHQUIT)
- QUIT
- +3 SET AMHSORTP=$ORDER(^AMHPROB("B",AMHSORT,""))
- SET AMHSORTP=AMHSORT_" - "_$PIECE(^AMHPROB(AMHSORTP,0),U,2)
- +4 WRITE !,$EXTRACT(AMHSORTP,1,30)
- SET AMHRSRT2=$ORDER(^XTMP("AMHRAGS",AMHJOB,AMHBTH,"AGE",AMHRSEX,AMHSORT,""))
- WRITE ?32,$EXTRACT(AMHRSRT2,1,9)
- +5 NEW I,J,K
- SET J=39
- FOR I=1:1:$LENGTH(AMHRBIN,";")
- SET K=$SELECT($DATA(^XTMP("AMHRPS",AMHJOB,AMHBTH,"AGE",AMHRSEX,AMHSORT,I)):^(I),1:".")
- WRITE ?J,$JUSTIFY(K,6)
- SET J=J+9
- +6 WRITE ?J,$JUSTIFY(^XTMP("AMHRPS",AMHJOB,AMHBTH,"TOTAL SORT",AMHRSEX,AMHSORT),6)
- +7 QUIT
- End DoDot:1
- +8 IF $DATA(AMHQUIT)
- QUIT
- +9 IF $Y>(IOSL-5)
- DO HEAD
- IF $DATA(AMHQUIT)
- QUIT
- +10 SET T=0
- WRITE !,"TOTAL:"
- SET J=39
- FOR I=1:1:$LENGTH(AMHRBIN,";")
- SET K=$SELECT($DATA(^XTMP("AMHRPS",AMHJOB,AMHBTH,"TOTAL",AMHRSEX,I)):^(I),1:".")
- WRITE ?J,$JUSTIFY(K,6)
- SET J=J+9
- SET T=T+K
- +11 WRITE ?J,$JUSTIFY(T,6)
- +12 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 AMHQUIT=""
- QUIT
- HEAD1 ;
- +1 IF $DATA(IOF)
- WRITE @IOF
- SET AMHRPG=AMHRPG+1
- +2 WRITE ?50,"BEHAVIORAL HEALTH",?100,AMHRDT,?123,"Page",AMHRPG,!
- +3 SET AMHRLENG=15+$LENGTH(AMHTITLE)
- WRITE ?((132-AMHRLENG)/2),AMHTITLE," BY AGE AND SEX",!
- +4 WRITE ?46,"VISIT DATES: ",AMHBDD," TO ",AMHEDD,!
- HEAD2 WRITE !?61,"SEX: ",$SELECT(AMHRSEX="M":"MALE",AMHRSEX="F":"FEMALE",1:"BOTH")
- +1 WRITE !,"PROB CODE NARRATIVE"
- SET J=41
- FOR I=1:1:$LENGTH(AMHRBIN,";")
- SET K=$PIECE(AMHRBIN,";",I)
- IF K=""
- QUIT
- WRITE ?J,K
- SET J=J+9
- +2 WRITE ?J,"TOTAL"
- +3 WRITE !,AMHR132S
- +4 QUIT
- +5 ;
- LIST ;
- +1 SET %=AMHRBIN
- +2 FOR I=1:1
- SET X=$PIECE(%,";",I)
- IF X=""
- QUIT
- WRITE !,$PIECE(X,"-")," - ",$PIECE(X,"-",2)
- +3 WRITE !
- +4 QUIT
- +5 ;
- SETBIN ;
- +1 SET AMHRBIN="0-0;1-4;5-14;15-19;20-24;25-44;45-64;65-125"
- +2 QUIT
