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
