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

AMHPHQM.m

Go to the documentation of this file. 
  1. AMHPHQM ; IHS/CMI/LAB - PHQ - MULTIPLE PATS 10 Dec 2008 9:28 AM ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;**4,6,8**;JUN 02, 2010;Build 7
  1.  ;
  1.  ;
  1. START ;
  1.  W:$D(IOF) @IOF
  1.  D EN^XBVK("AMH")
  1.  W !,$$CTR^AMHLEIN("PHQ-2, PHQ-9 and PHQ-9T Depression Outcomes - Scores for Multiple Patients",80),!!
  1.  W !,"This option is used to list PHQ-2, PHQ-9 and PHQ-9T Scores for multiple "
  1.  W !,"patients sorted by patient.",!
  1. WHICH ;
  1.  W !!,"Please note:  Only visits with PHQ-2/PHQ-9/PHQ-9T scores recorded will display",!,"on this list.",!
  1.  D DBHUSR^AMHUTIL
  1. DATES ;
  1.  K AMHED,AMHBD
  1.  K DIR W ! S DIR(0)="D^::EXP",DIR("A")="Enter Beginning Date of Visit"
  1.  D ^DIR
  1.  G:$D(DIRUT) XIT
  1.  S AMHBD=Y
  1.  K DIR S DIR(0)="D^::EXP",DIR("A")="Enter Ending Date of Visit"
  1.  D ^DIR
  1.  G:$D(DIRUT) DATES
  1.  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. CLINIC ;
  1.  K AMHRCLNT
  1.  S DIR(0)="S^C:Visits to Selected Clinics;A:Visits to All Clinics",DIR("A")="Clinic Selection",DIR("B")="A" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G DATES
  1.  I Y="A" K AMHRCLNT G PROV
  1. CLINIC1 ;
  1.  S X="CLINIC",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,"AMHRCLNT(")
  1.  I '$D(AMHRCLNT) G CLINIC
  1.  I $D(AMHRCLNT("*")) K AMHRCLNT
  1. PROV ;
  1.  K AMHPROVT
  1.  S DIR(0)="S^C:Visits to Selected Providers;A:Visits to All Providers",DIR("A")="Provider Selection",DIR("B")="A" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G CLINIC
  1.  I Y="A" K AMHPROVT G DEMO
  1. PROV1 ;
  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,"AMHPROVT(")
  1.  I '$D(AMHPROVT) G CLINIC
  1.  I $D(AMHPROVT("*")) K AMHPROVT
  1. DEMO ;
  1.  D DEMOCHK^AMHUTIL1(.AMHDEMO)
  1.  I AMHDEMO=-1 G PROV
  1. ZIS ;
  1.  S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to ",DIR("B")="P" K DA D ^DIR K DIR
  1.  I $D(DIRUT) G XIT
  1.  I $G(Y)="B" D BROWSE,XIT Q
  1.  S XBRC="PROC^AMHPHQM",XBRP="PRINT^AMHPHQM",XBNS="AMH",XBRX="XIT^AMHPHQM"
  1.  D ^XBDBQUE
  1. XIT ;
  1.  K ZTSK,Y,AMHBD,AMHED,IO("Q")
  1.  D EN^XBVK("AMH")
  1.  Q
  1.  ;
  1. BROWSE ;
  1.  S XBRP="VIEWR^XBLM(""PRINT^AMHPHQM"")"
  1.  S XBNS="AMH",XBRC="PROC^AMHPHQM",XBRX="XIT^AMHPHQM",XBIOP=0 D ^XBDBQUE
  1.  Q
  1.  ;
  1. PROC ;
  1.  ;loop through visits and check PHQ score
  1.  D XTMP^AMHUTIL("AMHPHQM","BH - PHQ SCORES MULT PATS")
  1.  S (AMHBT,AMHBTH)=$H,AMHJOB=$J
  1.  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.  ..S DFN=$P(AMHV0,U,8)
  1.  ..Q:DFN=""
  1.  ..I '$$HASPHQ^AMHPHQO(AMHVIEN) Q  ;no PHQ score
  1.  ..Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHVIEN)
  1.  ..Q:$$DEMO^AMHUTIL1(DFN,$G(AMHDEMO))
  1.  ..S AMHVPP=$$PPINT^AMHUTIL(AMHVIEN)
  1.  ..I AMHVPP="",$D(AMHPROVT) Q  ;PRIM PROV blank and want certain PRIM PROVS
  1.  ..I $D(AMHPROVT),'$D(AMHPROVT(AMHVPP)) Q  ;not a PRIM PROV we want
  1.  ..S AMHVCC=$P(^AMHREC(AMHVIEN,0),U,25)
  1.  ..I $D(AMHRCLNT),AMHVCC="" Q
  1.  ..I $D(AMHRCLNT),'$D(AMHRCLNT(AMHVCC)) Q
  1.  ..S ^XTMP("AMHPHQM",AMHJOB,AMHBTH,"PATS",$P(^DPT(DFN,0),U,1),DFN,$P((9999999-AMHSD),"."),"BH",AMHVIEN)=""
  1.  ..Q
  1.  .Q
  1.  ;now get all PCC Visits
  1.  S AMHSD=$$FMADD^XLFDT(AMHBD,-1)_".9999"
  1.  F  S AMHSD=$O(^AUPNVSIT("B",AMHSD)) Q:AMHSD=""!($P(AMHSD,".")>$P(AMHED,"."))  D
  1.  .S AMHVIEN=0 F  S AMHVIEN=$O(^AUPNVSIT("B",AMHSD,AMHVIEN)) Q:AMHVIEN'=+AMHVIEN  D
  1.  ..Q:'$$HASPHQV^AMHPHQO(AMHVIEN)
  1.  ..Q:$D(^AMHREC("AVISIT",AMHVIEN))
  1.  ..S DFN=$P(^AUPNVSIT(AMHVIEN,0),U,5)
  1.  ..Q:DFN=""
  1.  ..S AMHVPP=$$PRIMPROV^APCLV(AMHVIEN,"I")
  1.  ..I AMHVPP="",$D(AMHPROVT) Q
  1.  ..I $D(AMHPROVT),'$D(AMHPROVT(AMHVPP)) Q
  1.  ..S AMHVCC=$P(^AUPNVSIT(AMHVIEN,0),U,8)
  1.  ..I AMHVCC="",$D(AMHRCLNT) Q
  1.  ..I $D(AMHRCLNT),'$D(AMHRCLNT(AMHVCC)) Q
  1.  ..S ^XTMP("AMHPHQM",AMHJOB,AMHBTH,"PATS",$P(^DPT(DFN,0),U,1),DFN,$P((9999999-AMHSD),"."),"PCC",AMHVIEN)=""
  1.  Q
  1. PRINT ;EP - called from xbdbque
  1.  S AMHPG=0 K AMHQ D HEADER
  1.  I '$D(^XTMP("AMHPHQM",AMHJOB,AMHBTH)) W !!,"NO PATIENTS/PHQ SCORES TO REPORT" G DONE
  1.  S AMHNAME="" F  S AMHNAME=$O(^XTMP("AMHPHQM",AMHJOB,AMHBTH,"PATS",AMHNAME)) Q:AMHNAME=""!($D(AMHQ))  D
  1.  .S DFN=0 F  S DFN=$O(^XTMP("AMHPHQM",AMHJOB,AMHBTH,"PATS",AMHNAME,DFN)) Q:DFN'=+DFN!($D(AMHQ))  D
  1.  ..W ! S AMHDATE="" F  S AMHDATE=$O(^XTMP("AMHPHQM",AMHJOB,AMHBTH,"PATS",AMHNAME,DFN,AMHDATE)) Q:AMHDATE=""!($D(AMHQ))  D
  1.  ...S AMHT="" F  S AMHT=$O(^XTMP("AMHPHQM",AMHJOB,AMHBTH,"PATS",AMHNAME,DFN,AMHDATE,AMHT)) Q:AMHT=""!($D(AMHQ))  D
  1.  ....S AMHV=0 F  S AMHV=$O(^XTMP("AMHPHQM",AMHJOB,AMHBTH,"PATS",AMHNAME,DFN,AMHDATE,AMHT,AMHV)) Q:AMHV'=+AMHV!($D(AMHQ))  D PRINT1
  1. DONE ;
  1.  K ^XTMP("AMHPHQM",AMHJOB,AMHBTH),AMHJOB,AMHBTH
  1.  I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report.  PRESS RETURN" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  Q
  1.  ;
  1. PRINT1 ;
  1.  I $Y>(IOSL-3) D HEADER Q:$D(AMHQ)
  1.  W !,$E(AMHNAME,1,15),?17,$$HRN^AUPNPAT(DFN,DUZ(2)) ;$$D^AMHLEIN((9999999-AMHDATE))
  1.  I AMHT="BH" W ?24,$$D^AMHLEIN($P($P(^AMHREC(AMHV,0),U,1),"."))
  1.  I AMHT="PCC" W ?24,$$D^AMHLEIN($$VD^APCLV(AMHV))
  1.  S X=0,Y="",Z="",T="",J=""
  1.  I AMHT="BH" D
  1.  .F  S X=$O(^AMHRMSR("AD",AMHV,X)) Q:X'=+X  D
  1.  ..S Y=$$VAL^XBDIQ1(9002011.12,X,.01)
  1.  ..I Y="PHQ2" S T=T_$P(^AMHRMSR(X,0),U,4)_" "
  1.  ..I Y="PHQ9" S Z=Z_$P(^AMHRMSR(X,0),U,4)_" "
  1.  ..I Y="PHQT" S J=J_$P(^AMHRMSR(X,0),U,4)_" "
  1.  I AMHT="PCC" D
  1.  .F  S X=$O(^AUPNVMSR("AD",AMHV,X)) Q:X'=+X  D
  1.  ..S Y=$$VAL^XBDIQ1(9000010.01,X,.01) D
  1.  ..I Y="PHQ2" S T=T_$P(^AUPNVMSR(X,0),U,4)_" "
  1.  ..I Y="PHQ9" S Z=Z_$P(^AUPNVMSR(X,0),U,4)_" "
  1.  ..I Y="PHQT" S J=J_$P(^AUPNVMSR(X,0),U,4)_" "
  1.  W ?34,T,?38,Z,?43,J
  1.  I AMHT="BH" D
  1.  .W ?48,$E($$PPNAME^AMHUTIL(AMHV),1,9),?58,$E($$VAL^XBDIQ1(9002011,AMHV,.25),1,5)
  1.  .S X=$O(^AMHRPRO("AD",AMHV,0))
  1.  .I X W ?65,$$VAL^XBDIQ1(9002011.01,X,.01)_"-"_$E($$VAL^XBDIQ1(9002011.01,X,.04),1,6)
  1.  I AMHT="PCC" D
  1.  .W ?48,$E($$PRIMPROV^APCLV(AMHV),1,9),?58,$E($$VAL^XBDIQ1(9000010,AMHV,.08),1,5)
  1.  .S X=$O(^AUPNVPOV("AD",AMHV,0))
  1.  .I X W ?65,$$VAL^XBDIQ1(9000010.07,X,.01)_"-"_$E($$VAL^XBDIQ1(9000010.07,X,.04),1,6)
  1.  Q
  1.  ;----------
  1.  G:'AMHPG 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 AMHQ="" Q
  1. HEADER1 ;
  1.  W:$D(IOF) @IOF S AMHPG=AMHPG+1
  1.  W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",AMHPG,!
  1.  W !,$$CTR^AMHLEIN("PHQ-2, PHQ-9 and PHQ-9T SCORES FOR MULTIPLE PATIENTS",80),!
  1.  S X="Visit Dates: "_$$FMTE^XLFDT(AMHBD)_" to "_$$FMTE^XLFDT(AMHED) W $$CTR^AMHLEIN(X,80),!
  1.  S X=$S($D(AMHRCLNT):"Clinics:  Selected",1:"Clinic: ALL Clinics") W $$CTR^AMHLEIN(X,80),!
  1.  S X=$S($D(AMHPROVT):"Providers: Selected",1:"Providers: ALL Providers") W $$CTR^AMHLEIN(X,80),!
  1.  W !,"PATIENT NAME",?17,"HRN",?24,"Date",?33,"PHQ2",?38,"PHQ9",?43,"PHQT",?48,"Provider",?58,"CLINIC",?65,"Diagnosis/POV"
  1.  ;W !?33,"-2",?37,"-9",?41,"-T"
  1.  W !,$TR($J("",80)," ","-")
  1.  Q