Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMHRSB1P

AMHRSB1P.m

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