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