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

AMHRPPA.m

Go to the documentation of this file. 
  1. AMHRPPA ; IHS/CMI/LAB - TALLY PREVENTION ACTIVITIES ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;**1**;JUN 18, 2010;Build 8
  1.  ;
  1. START ;
  1.  D XIT
  1.  I '$D(IOF) D HOME^%ZIS
  1.  W @(IOF),!!
  1.  D INFORM
  1. DATES K AMHED,AMHBD
  1.  K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Visit Date"
  1.  D ^DIR G:Y<1 XIT S AMHBD=Y
  1.  K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Visit Date"
  1.  D ^DIR G:Y<1 XIT  S AMHED=Y
  1.  ;
  1.  I AMHED<AMHBD D  G DATES
  1.  . W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
  1.  S AMHSD=$$FMADD^XLFDT(AMHBD,-1)_".9999"
  1.  ;
  1. PROG ;
  1.  S AMHPROG=""
  1.  S DIR(0)="S^O:ONE Program;A:ALL Programs",DIR("A")="Run the Report for which PROGRAM",DIR("B")="A" KILL DA D ^DIR KILL DIR
  1.  G:$D(DIRUT) DATES
  1.  I Y="A" G PROV
  1.  S DIR(0)="9002011,.02",DIR("A")="Which PROGRAM" KILL DA D ^DIR KILL DIR
  1.  G:$D(DIRUT) PROG
  1.  I X="" G PROG
  1.  S AMHPROG=Y
  1. PROV ;
  1.  K AMHQ
  1.  W !!,$G(IORVON)_"Please enter the Providers whose Prevention activities you want to tally."_$G(IORVOFF),!
  1.  S AMHPRVT=""
  1.  K AMHPRVS
  1.  S DIR(0)="S^A:ALL Providers;S:Selected set or Taxonomy of Providers;O:ONE Provider",DIR("A")="Include Visits to Which Providers",DIR("B")="A"
  1.  S DIR("A")="Enter a code indicating which providers are of interest",DIR("B")="A" K DA D ^DIR K DIR,DA
  1.  G:$D(DIRUT) PROG
  1.  S AMHPRVT=Y
  1.  I AMHPRVT="A" G DEMO
  1.  D @(AMHPRVT_"PRV")
  1.  G:$D(AMHQ) PROV
  1. DEMO ;
  1.  D DEMOCHK^AMHUTIL1(.AMHDEMO)
  1.  I AMHDEMO=-1 G PROV
  1. ZIS ;call xbdbque
  1.  S XBRC="DRIVER^AMHRPPA",XBRP="PRINT^AMHRPPA",XBRX="XIT^AMHRPPA",XBNS="AMH"
  1.  D ^XBDBQUE
  1.  D XIT
  1.  Q
  1. DRIVER ;EP entry point for taskman
  1.  D PROCESS
  1.  S AMHET=$H
  1.  Q
  1. XIT ;
  1.  K DIR
  1.  D EN^XBVK("AMH")  ;clean up AMH variables
  1.  D ^XBFMK  ;clean up fileman variables
  1.  Q
  1.  ;
  1. PROCESS ;
  1.  D XTMP^AMHUTIL("AMHRPPA","BH - PREVENTION ACTIVITIES")
  1.  S (AMHBT,AMHBTH)=$H,AMHJOB=$J
  1.  S AMHSD=$P(AMHBD,".")-1,AMHSD=AMHSD_".9999"
  1.  K AMHPRAT,AMHTARG S AMHGRTA=0,AMHGRTT=0,AMHGTPA=0
  1.  S (AMHRCNT,AMHVIEN)=0 F  S AMHSD=$O(^AMHREC("B",AMHSD)) Q:AMHSD=""!($P(AMHSD,".")>$P(AMHED,"."))  D
  1.  .S AMHVIEN=0 F  S AMHVIEN=$O(^AMHREC("B",AMHSD,AMHVIEN)) Q:AMHVIEN'=+AMHVIEN  D
  1.  ..S AMHV0=$G(^AMHREC(AMHVIEN,0))
  1.  ..Q:AMHV0=""
  1.  ..Q:'$D(^AMHRPA("AD",AMHVIEN))  ;no prevention activities
  1.  ..Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHVIEN)
  1.  ..I $P(AMHV0,U,8) Q:$$DEMO^AMHUTIL1($P(AMHV0,U,8),$G(AMHDEMO))
  1.  ..I AMHPROG]"",$P(^AMHREC(AMHVIEN,0),U,2)'=AMHPROG Q  ;not correct program visit
  1.  ..S AMHVPP=$$PPINT^AMHUTIL(AMHVIEN)
  1.  ..I AMHVPP="",$D(AMHPRVS) Q  ;PRIM PROV blank and want certain PRIM PROVS
  1.  ..I $D(AMHPRVS),'$D(AMHPRVS(AMHVPP)) Q  ;not a PRIM PROV we want
  1.  ..S AMHTAR=$$VAL^XBDIQ1(9002011,AMHVIEN,1106)
  1.  ..I AMHTAR]"" S AMHGRTT=AMHGRTT+1,AMHTARG(AMHTAR)=$G(AMHTARG(AMHTAR))+1
  1.  ..I AMHTAR="" S AMHGRTT=AMHGRTT+1,AMHTARG("NOT RECORDED")=$G(AMHTARG("NOT RECORDED"))+1
  1.  ..S AMHGRTA=AMHGRTA+1
  1.  ..S AMHX=0 F  S AMHX=$O(^AMHRPA("AD",AMHVIEN,AMHX)) Q:AMHX'=+AMHX  D
  1.  ...S X=$$VAL^XBDIQ1(9002011.09,AMHX,.01)
  1.  ...I X="OTHER" S Y=$E($$UP^XLFSTR($$VAL^XBDIQ1(9002011.09,AMHX,.04)),1,40) S X=$S(Y]"":Y,1:"OTHER - NO DETAIL GIVEN")
  1.  ...S AMHPRAT(X)=$G(AMHPRAT(X))+1
  1.  ...I AMHTAR]"" S AMHPRAT(X,AMHTAR)=$G(AMHPRAT(X,AMHTAR))+1
  1.  ...I AMHTAR="" S AMHPRAT(X,"NOT RECORDED")=$G(AMHPRAT(X,"NOT RECORDED"))+1
  1.  ...S AMHGTPA=AMHGTPA+1
  1.  ..Q
  1.  .Q
  1.  S AMHET=$H
  1.  Q
  1.  ;
  1. PRINT ;EP - called from xbdbque
  1.  S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y
  1.  S AMHPG=0
  1.  K AMHQUIT
  1.  D PRINT1
  1. DONE I $D(AMHET) S AMHDVTS=(86400*($P(AMHET,",")-$P(AMHBT,",")))+($P(AMHET,",",2)-$P(AMHBT,",",2)),AMHDVH=$P(AMHDVTS/3600,".") S:AMHDVH="" AMHDVH=0
  1.  S AMHDVTS=AMHDVTS-(AMHDVH*3600),AMHDVM=$P(AMHDVTS/60,".") S:AMHDVM="" AMHDVM=0 S AMHDVTS=AMHDVTS-(AMHDVM*60),AMHDVS=AMHDVTS W !!,"RUN TIME (H.M.S): ",AMHDVH,".",AMHDVM,".",AMHDVS
  1.  I $E(IOST)="C",IO=IO(0) S DIR(0)="E" D ^DIR K DIR
  1.  W:$D(IOF) @IOF
  1.  Q
  1. PRINT1 ;
  1.  D HEAD
  1.  I '$D(AMHPRAT) W !!,"There are no visits with Prevention Activities Recorded." Q
  1.  W !!,"Total # Visits w/Prevention Activity: ",?45,$$C(AMHGRTA,0)
  1.  W !,"Total # of Prevention Activities recorded: ",?45,$$C(AMHGTPA,0)
  1.  S AMHS="" F  S AMHS=$O(AMHPRAT(AMHS)) Q:AMHS=""!($D(AMHQUIT))  D
  1.  .I $Y>(IOSL-3) D HEAD Q:$D(AMHQUIT)
  1.  .S AMHX=AMHPRAT(AMHS)
  1.  .W !!?1,AMHS,?45,$$C(AMHX,0),?60,$J(((AMHX/AMHGRTA)*100),5,1)
  1.  .S AMHY="" F  S AMHY=$O(AMHPRAT(AMHS,AMHY)) Q:AMHY=""!($D(AMHQUIT))  D
  1.  ..I $Y>(IOSL-3) D HEAD Q:$D(AMHQUIT)
  1.  ..W !?4,AMHY
  1.  ..S AMHZ=AMHPRAT(AMHS,AMHY)
  1.  ..W ?20,$$C(AMHZ,0),?28,$J(((AMHZ/AMHX)*100),5,1)
  1.  Q:$D(AMHQUIT)
  1.  I $Y>(IOSL-3) D HEAD Q:$D(AMHQUIT)
  1.  W !!,"TARGET TOTALS",!
  1.  S AMHX="" F  S AMHX=$O(AMHTARG(AMHX)) Q:AMHX=""!($D(AMHQUIT))  D
  1.  .I $Y>(IOSL-3) D HEAD Q:$D(AMHQUIT)
  1.  .W !?4,AMHX,?20,$$C(AMHTARG(AMHX),0),?28,$J(((AMHTARG(AMHX)/AMHGRTT)*100),5,1)
  1.  Q
  1.  I 'AMHPG G HEAD1
  1.  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
  1. HEAD1 ;
  1.  W:$D(IOF) @IOF S AMHPG=AMHPG+1
  1.  W !,$$FMTE^XLFDT(DT),?70,"Page: ",AMHPG
  1.  W !?29,"Behavioral Health"
  1.  W !,$$CTR($$REPEAT^XLFSTR("*",36),80)
  1.  W !,$$CTR("*   TALLY OF PREVENTION ACTIVITIES  *",80)
  1.  W !,$$CTR($$REPEAT^XLFSTR("*",36),80)
  1.  S X="VISIT Date Range: "_AMHBDD_" through "_AMHEDD W !,$$CTR(X,80)
  1.  I AMHPROG]"" S X="Program: "_$$EXTSET^XBFUNC(9002011,.02,AMHPROG) W !,$$CTR(X,80),!
  1.  W !?5,"PREVENTION ACTIVITY",?45,"# of visits",?60,"% of visits"
  1.  W !,$$REPEAT^XLFSTR("-",80)
  1.  Q
  1. C(X,X2,X3) ;
  1.  D COMMA^%DTC
  1.  Q $$STRIP^XLFSTR(X," ")
  1. D(D) ;
  1.  I $G(D)="" Q ""
  1.  Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
  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:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
  1.  NEW DIR
  1.  K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  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. INFORM ;inform user what this report is all about
  1.  W !,$$CTR($$LOC)
  1.  W !!,$$CTR("BEHAVIORAL HEALTH PREVENTION ACTIVITIES")
  1.  W !!,"This report will produce a count of all visits with a prevention"
  1.  W !,"activity entered.  It will also produce a tally/count of those"
  1.  W !,"prevention activities with Target Audience subtotals."
  1.  W !
  1.  D DBHUSR^AMHUTIL
  1.  Q
  1. OPRV ;one PROVIDER
  1.  S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Which PROVIDER: " D ^DIC K DIC
  1.  I Y=-1 S AMHQ="" Q
  1.  S AMHPRVS(+Y)=""
  1.  Q
  1. SPRV ;taxonomy of PROVIDERS
  1.  S X="PRIMARY PROVIDER",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" G XIT
  1.  D PEP^AMQQGTX0(+Y,"AMHPRVS(")
  1.  I '$D(AMHPRVS) S AMHQ="" Q
  1.  I $D(AMHPRVS("*")) S AMHPRVT="A" K AMHPRVS W !!,"**** all PROVIDERS will be included ****",! Q
  1.  Q
  1.  ;