AMHRSB1P ; IHS/CMI/LAB - list refusals ;
;;4.0;IHS BEHAVIORAL HEALTH;**8**;JUN 02, 2010;Build 7
;
;
PRINT ;EP - called from xbdbque
D PRINT1
D DONE
Q
PRINT1 ;
S AMHRPG=0 K AMHRQUIT
K AMHRLSTP
;I '$D(^XTMP("AMHRSB1",AMHRJ,AMHRH)) D HEADER W !!,"No data to report.",! G DONE
D HEADER W "COUNT OF PATIENTS",!?40,"Number",?60,"Percent",!?40,"------",?60,"-------",!
W !,"Patients screened for alcohol use",?40,$J($$COM(AMHTPTSR,0),8),!
W !,"Patients screened Positive",!," (at least once)",?40,$J($$COM(AMHTPTPO,0),8),?60,$J($$PER(AMHTPTPO,AMHTPTSR),7),!
W !,"Patients Screened Positive w/",!
W " BNI/BI on same day as screen",?40,$J($$COM(AMHTPT0,0),8),?60,$J($$PER(AMHTPT0,AMHTPTPO),7),!
W !,"Patients Screened Positive w/",!
W " BNI/BI 1-3 days after screen",?40,$J($$COM(AMHTPT1,0),8),?60,$J($$PER(AMHTPT1,AMHTPTPO),7),!
W !,"Patients Screened Positive w/",!
W " BNI/BI 4-7 days after screen",?40,$J($$COM(AMHTPT4,0),8),?60,$J($$PER(AMHTPT4,AMHTPTPO),7),!
W !,"Patients Screened Positive referred",!
W " for treatment w/in 7 days",?40,$J($$COM(AMHTPTT,0),8),?60,$J($$PER(AMHTPTT,AMHTPTPO),7),!
I $D(AMHRLIST) D LIST
Q
SCRC I $Y>(IOSL-5) D HEADER Q:$D(AMHRQUIT)
W !,"COUNT OF SCREENS",!?40,"Number",?60,"Percent",!?40,"------",?60,"-------",!
W !,"Screenings for alcohol use",?40,$J($$COM(AMHTSCRS,0),8),!
W !,"Positive Screens",?40,$J($$COM(AMHTSCRP,0),8),?60,$J($$PER(AMHTSCRP,AMHTSCRS),7),!
W !,"Patients Screened Positive w/",!
W " BNI/BI on same day as screen",?40,$J($$COM(AMHTSCR0,0),8),?60,$J($$PER(AMHTSCR0,AMHTSCRP),7),!
W !,"Patients Screened Positive w/",!
W " BNI/BI 1-3 days after screen",?40,$J($$COM(AMHTSCR1,0),8),?60,$J($$PER(AMHTSCR1,AMHTSCRP),7),!
W !,"Patients Screened Positive w/",!
W " BNI/BI 4-7 days after screen",?40,$J($$COM(AMHTSCR4,0),8),?60,$J($$PER(AMHTSCR4,AMHTSCRP),7),!
W !,"Patients Screened Positive referred",!
W " for treatment w/in 7 days",?40,$J($$COM(AMHTSCRT,0),8),?60,$J($$PER(AMHTSCRT,AMHTSCRP),7),!
I $D(AMHRLIST) D LIST
Q
PER(N,D) ;return % of n/d
I 'D Q "0%"
NEW Z
S Z=N/D,Z=Z*100,Z=$J(Z,5,1)
Q $$STRIP^XLFSTR(Z," ")_"%"
COM(X,X2,X3) ;
D COMMA^%DTC
Q $$STRIP^XLFSTR(X," ")
END() ;
I $Y<(IOSL-3) Q 0
D HEADER
I $D(AMHRQUIT) Q 1
Q 0
ENDL() ;
I $Y<(IOSL-8) Q 0
D HEADER
I $D(AMHRQUIT) Q 1
Q 0
G:'AMHRPG HEADER1
K DIR 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
W:$D(IOF) @IOF S AMHRPG=AMHRPG+1
W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",AMHRPG,!
W !,$$CTR("SCREENING, BRIEF INTERVENTION, AND REFERRAL TO TREATMENT (SBIRT)",80),!
S X="Screening Dates: "_$$FMTE^XLFDT(AMHRBD)_" to "_$$FMTE^XLFDT(AMHRED) W $$CTR(X,80),!
I $G(AMHRLSTP) W !,$$CTR(AMHRSHD),!,"PATIENT NAME",?32,"HRN",?40,"DOB",?55,"GENDER",!,?2,"DATE SCREEN",?15,"SCREEN",?38,"DATE BNI/RT",?51,"BNI/RT",?75,"#DAYS"
W !,$TR($J("",80)," ","-")
Q
DONE ;
K ^TMP($J)
K ^XTMP("AMHRSB1",AMHRJ,AMHRH)
D EOP
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:IO'=IO(0)
Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
W !
S DIR("A")="End of Report. Press Enter",DIR(0)="E" D ^DIR
Q
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
LIST ;EP - called from xbdbque
S AMHRPG=0 K AMHRQUIT
S AMHRLSTP=1
I $D(AMHRLIST(1)) D LIST1 Q:$D(AMHRQUIT)
I $D(AMHRLIST(2)) D LIST2 Q:$D(AMHRQUIT)
I $D(AMHRLIST(3)) D LIST3 Q:$D(AMHRQUIT)
Q
LIST1 ;
S AMHRSHD="PATIENTS WITH POSITIVE ALCOHOL SCREEN DURING THE REPORT TIME FRAME",AMHZZ="LIST1"
D PLIST
Q
LIST2 ;
S AMHRSHD="PATIENTS WITH POSITIVE ALCOHOL SCREEN W/BNI OR REFERRAL FOR TX",AMHZZ="LIST2"
D PLIST
Q
LIST3 ;
S AMHRSHD="PATIENTS WITH POSITIVE ALCOHOL WITHOUT BNI OR REFERRAL FOR TX",AMHZZ="LIST3"
D PLIST
Q
PLIST ;
D HEADER Q:$D(AMHRQUIT)
;resort by sort item
S AMHRSORV="" F S AMHRSORV=$O(^XTMP("AMHRSB1",AMHRJ,AMHRH,AMHZZ,AMHRSORV)) Q:AMHRSORV=""!($D(AMHRQUIT)) D
.S DFN=0 F S DFN=$O(^XTMP("AMHRSB1",AMHRJ,AMHRH,AMHZZ,AMHRSORV,DFN)) Q:DFN'=+DFN!($D(AMHRQUIT)) D
..Q:$$ENDL
..W !,$E($P(^DPT(DFN,0),U),1,30),?32,$$HRN^AUPNPAT(DFN,DUZ(2)),?40,$$FMTE^XLFDT($$DOB^AUPNPAT(DFN)),?55,$$VAL^XBDIQ1(2,DFN,.02),!
..S AMHD=0 F S AMHD=$O(^XTMP("AMHRSB1",AMHRJ,AMHRH,AMHZZ,AMHRSORV,DFN,AMHD)) Q:AMHD=""!($D(AMHRQUIT)) D
...S AMHRY=^XTMP("AMHRSB1",AMHRJ,AMHRH,AMHZZ,AMHRSORV,DFN,AMHD)
...W ?2,$P(AMHRY,U,1),?15,$P(AMHRY,U,2),": ",$P(AMHRY,U,3),?38,$P(AMHRY,U,6) I $P(AMHRY,U,5)]"" W ?51,$P(AMHRY,U,5),": ",$P(AMHRY,U,7),?74,$P(AMHRY,U,8)
...W !
Q
H ;
S AMHRSORV=$$HRN^AUPNPAT(DFN,DUZ(2))
Q
N ;
S AMHRSORV=$P(^DPT(DFN,0),U)
Q
P ;
S AMHRSORV=$P(AMHRY,U,2)
Q
R ;
S AMHRSORV=$P(AMHRY,U,3)
Q
D ;
S AMHRSORV=$P(AMHRY,U,7)
Q
A S AMHRSORV=$P(AMHRY,U,5)
Q
G ;
S AMHRSORV=$P(AMHRY,U,6)
Q
C ;
S AMHRSORV=$P(AMHRY,U,9)
Q
T ;
S %=$$HRN^AUPNPAT(DFN,DUZ(2))
S %=%+10000000,%=$E(%,7,8)_"-"_+$E(%,2,8)
S AMHRSORV=%
Q
DT(D) ;EP
I D="" Q ""
Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
;
AMHRSB1P ; IHS/CMI/LAB - list refusals ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**8**;JUN 02, 2010;Build 7
+2 ;
+3 ;
PRINT ;EP - called from xbdbque
+1 DO PRINT1
+2 DO DONE
+3 QUIT
PRINT1 ;
+1 SET AMHRPG=0
KILL AMHRQUIT
+2 KILL AMHRLSTP
+3 ;I '$D(^XTMP("AMHRSB1",AMHRJ,AMHRH)) D HEADER W !!,"No data to report.",! G DONE
+4 DO HEADER
WRITE "COUNT OF PATIENTS",!?40,"Number",?60,"Percent",!?40,"------",?60,"-------",!
+5 WRITE !,"Patients screened for alcohol use",?40,$JUSTIFY($$COM(AMHTPTSR,0),8),!
+6 WRITE !,"Patients screened Positive",!," (at least once)",?40,$JUSTIFY($$COM(AMHTPTPO,0),8),?60,$JUSTIFY($$PER(AMHTPTPO,AMHTPTSR),7),!
+7 WRITE !,"Patients Screened Positive w/",!
+8 WRITE " BNI/BI on same day as screen",?40,$JUSTIFY($$COM(AMHTPT0,0),8),?60,$JUSTIFY($$PER(AMHTPT0,AMHTPTPO),7),!
+9 WRITE !,"Patients Screened Positive w/",!
+10 WRITE " BNI/BI 1-3 days after screen",?40,$JUSTIFY($$COM(AMHTPT1,0),8),?60,$JUSTIFY($$PER(AMHTPT1,AMHTPTPO),7),!
+11 WRITE !,"Patients Screened Positive w/",!
+12 WRITE " BNI/BI 4-7 days after screen",?40,$JUSTIFY($$COM(AMHTPT4,0),8),?60,$JUSTIFY($$PER(AMHTPT4,AMHTPTPO),7),!
+13 WRITE !,"Patients Screened Positive referred",!
+14 WRITE " for treatment w/in 7 days",?40,$JUSTIFY($$COM(AMHTPTT,0),8),?60,$JUSTIFY($$PER(AMHTPTT,AMHTPTPO),7),!
+15 IF $DATA(AMHRLIST)
DO LIST
+16 QUIT
SCRC IF $Y>(IOSL-5)
DO HEADER
IF $DATA(AMHRQUIT)
QUIT
+1 WRITE !,"COUNT OF SCREENS",!?40,"Number",?60,"Percent",!?40,"------",?60,"-------",!
+2 WRITE !,"Screenings for alcohol use",?40,$JUSTIFY($$COM(AMHTSCRS,0),8),!
+3 WRITE !,"Positive Screens",?40,$JUSTIFY($$COM(AMHTSCRP,0),8),?60,$JUSTIFY($$PER(AMHTSCRP,AMHTSCRS),7),!
+4 WRITE !,"Patients Screened Positive w/",!
+5 WRITE " BNI/BI on same day as screen",?40,$JUSTIFY($$COM(AMHTSCR0,0),8),?60,$JUSTIFY($$PER(AMHTSCR0,AMHTSCRP),7),!
+6 WRITE !,"Patients Screened Positive w/",!
+7 WRITE " BNI/BI 1-3 days after screen",?40,$JUSTIFY($$COM(AMHTSCR1,0),8),?60,$JUSTIFY($$PER(AMHTSCR1,AMHTSCRP),7),!
+8 WRITE !,"Patients Screened Positive w/",!
+9 WRITE " BNI/BI 4-7 days after screen",?40,$JUSTIFY($$COM(AMHTSCR4,0),8),?60,$JUSTIFY($$PER(AMHTSCR4,AMHTSCRP),7),!
+10 WRITE !,"Patients Screened Positive referred",!
+11 WRITE " for treatment w/in 7 days",?40,$JUSTIFY($$COM(AMHTSCRT,0),8),?60,$JUSTIFY($$PER(AMHTSCRT,AMHTSCRP),7),!
+12 IF $DATA(AMHRLIST)
DO LIST
+13 QUIT
PER(N,D) ;return % of n/d
+1 IF 'D
QUIT "0%"
+2 NEW Z
+3 SET Z=N/D
SET Z=Z*100
SET Z=$JUSTIFY(Z,5,1)
+4 QUIT $$STRIP^XLFSTR(Z," ")_"%"
COM(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT $$STRIP^XLFSTR(X," ")
END() ;
+1 IF $Y<(IOSL-3)
QUIT 0
+2 DO HEADER
+3 IF $DATA(AMHRQUIT)
QUIT 1
+4 QUIT 0
ENDL() ;
+1 IF $Y<(IOSL-8)
QUIT 0
+2 DO HEADER
+3 IF $DATA(AMHRQUIT)
QUIT 1
+4 QUIT 0
+1 IF 'AMHRPG
GOTO HEADER1
+2 KILL DIR
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
+1 IF $DATA(IOF)
WRITE @IOF
SET AMHRPG=AMHRPG+1
+2 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",AMHRPG,!
+3 WRITE !,$$CTR("SCREENING, BRIEF INTERVENTION, AND REFERRAL TO TREATMENT (SBIRT)",80),!
+4 SET X="Screening Dates: "_$$FMTE^XLFDT(AMHRBD)_" to "_$$FMTE^XLFDT(AMHRED)
WRITE $$CTR(X,80),!
+5 IF $GET(AMHRLSTP)
WRITE !,$$CTR(AMHRSHD),!,"PATIENT NAME",?32,"HRN",?40,"DOB",?55,"GENDER",!,?2,"DATE SCREEN",?15,"SCREEN",?38,"DATE BNI/RT",?51,"BNI/RT",?75,"#DAYS"
+6 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+7 QUIT
DONE ;
+1 KILL ^TMP($JOB)
+2 KILL ^XTMP("AMHRSB1",AMHRJ,AMHRH)
+3 DO EOP
+4 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF IO'=IO(0)
QUIT
+3 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+4 NEW DIR
+5 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+6 WRITE !
+7 SET DIR("A")="End of Report. Press Enter"
SET DIR(0)="E"
DO ^DIR
+8 QUIT
+9 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
LIST ;EP - called from xbdbque
+1 SET AMHRPG=0
KILL AMHRQUIT
+2 SET AMHRLSTP=1
+3 IF $DATA(AMHRLIST(1))
DO LIST1
IF $DATA(AMHRQUIT)
QUIT
+4 IF $DATA(AMHRLIST(2))
DO LIST2
IF $DATA(AMHRQUIT)
QUIT
+5 IF $DATA(AMHRLIST(3))
DO LIST3
IF $DATA(AMHRQUIT)
QUIT
+6 QUIT
LIST1 ;
+1 SET AMHRSHD="PATIENTS WITH POSITIVE ALCOHOL SCREEN DURING THE REPORT TIME FRAME"
SET AMHZZ="LIST1"
+2 DO PLIST
+3 QUIT
LIST2 ;
+1 SET AMHRSHD="PATIENTS WITH POSITIVE ALCOHOL SCREEN W/BNI OR REFERRAL FOR TX"
SET AMHZZ="LIST2"
+2 DO PLIST
+3 QUIT
LIST3 ;
+1 SET AMHRSHD="PATIENTS WITH POSITIVE ALCOHOL WITHOUT BNI OR REFERRAL FOR TX"
SET AMHZZ="LIST3"
+2 DO PLIST
+3 QUIT
PLIST ;
+1 DO HEADER
IF $DATA(AMHRQUIT)
QUIT
+2 ;resort by sort item
+3 SET AMHRSORV=""
FOR
SET AMHRSORV=$ORDER(^XTMP("AMHRSB1",AMHRJ,AMHRH,AMHZZ,AMHRSORV))
IF AMHRSORV=""!($DATA(AMHRQUIT))
QUIT
Begin DoDot:1
+4 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("AMHRSB1",AMHRJ,AMHRH,AMHZZ,AMHRSORV,DFN))
IF DFN'=+DFN!($DATA(AMHRQUIT))
QUIT
Begin DoDot:2
+5 IF $$ENDL
QUIT
+6 WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),U),1,30),?32,$$HRN^AUPNPAT(DFN,DUZ(2)),?40,$$FMTE^XLFDT($$DOB^AUPNPAT(DFN)),?55,$$VAL^XBDIQ1(2,DFN,.02),!
+7 SET AMHD=0
FOR
SET AMHD=$ORDER(^XTMP("AMHRSB1",AMHRJ,AMHRH,AMHZZ,AMHRSORV,DFN,AMHD))
IF AMHD=""!($DATA(AMHRQUIT))
QUIT
Begin DoDot:3
+8 SET AMHRY=^XTMP("AMHRSB1",AMHRJ,AMHRH,AMHZZ,AMHRSORV,DFN,AMHD)
+9 WRITE ?2,$PIECE(AMHRY,U,1),?15,$PIECE(AMHRY,U,2),": ",$PIECE(AMHRY,U,3),?38,$PIECE(AMHRY,U,6)
IF $PIECE(AMHRY,U,5)]""
WRITE ?51,$PIECE(AMHRY,U,5),": ",$PIECE(AMHRY,U,7),?74,$PIECE(AMHRY,U,8)
+10 WRITE !
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
H ;
+1 SET AMHRSORV=$$HRN^AUPNPAT(DFN,DUZ(2))
+2 QUIT
N ;
+1 SET AMHRSORV=$PIECE(^DPT(DFN,0),U)
+2 QUIT
P ;
+1 SET AMHRSORV=$PIECE(AMHRY,U,2)
+2 QUIT
R ;
+1 SET AMHRSORV=$PIECE(AMHRY,U,3)
+2 QUIT
D ;
+1 SET AMHRSORV=$PIECE(AMHRY,U,7)
+2 QUIT
A SET AMHRSORV=$PIECE(AMHRY,U,5)
+1 QUIT
G ;
+1 SET AMHRSORV=$PIECE(AMHRY,U,6)
+2 QUIT
C ;
+1 SET AMHRSORV=$PIECE(AMHRY,U,9)
+2 QUIT
T ;
+1 SET %=$$HRN^AUPNPAT(DFN,DUZ(2))
+2 SET %=%+10000000
SET %=$EXTRACT(%,7,8)_"-"_+$EXTRACT(%,2,8)
+3 SET AMHRSORV=%
+4 QUIT
DT(D) ;EP
+1 IF D=""
QUIT ""
+2 QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)
+3 ;
