AMHPHQO.m

AMHPHQO ; IHS/CMI/LAB - BROWSE VISITS ;

 ;;4.0;IHS BEHAVIORAL HEALTH;**6**;JUN 02, 2010;Build 10

 ;

 ;

START ;

 W:$D(IOF) @IOF

 D EN^XBVK("AMH")

 W !,$$CTR("PHQ-2, PHQ-9 and PHQ-9T Depression Outcomes - Scores for One Patient",80),!!

 W !,"This option is used to list PHQ2/PHQ9/PHQT Scores for one patient within",!,"a date range specified by the user.",!

 D DBHUSR^AMHUTIL

PAT ;

 S DFN=""

 S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DLAYGO,DIADD

 I Y<0 W !,"No Patient Selected." Q

 S DFN=+Y

 S Y=DFN D ^AUPNPAT

 I DFN,'$$ALLOWP^AMHUTIL(DUZ,DFN) D NALLOWP^AMHUTIL D PAUSE^AMHLEA G PAT

 I $G(AUPNDOD)]"" W !!?10,"***** PATIENT'S DATE OF DEATH IS ",$$FMTE^XLFDT(AUPNDOD),!! H 2

WHICH ;

 W !!,"Please note:  Only visits with PHQ2, PHQ9 and PHQ9T scores recorded will",!,"display on this list.",!

 S AMHQUIT=0

 S AMHW=""

 S (AMHBD,AMHED,AMHNUM)=""

 K DIR S DIR(0)="S^N:Patient's Last N Visits;D:Visits in a Date Range;A:All of this Patient's Visits"

 S DIR("A")="Browse which subset of visits for "_$P(^DPT(DFN,0),U),DIR("B")="N" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) Q

 S AMHW=Y

 D @AMHW Q:AMHQUIT

 ;

CP ;

 S AMHCP=""

 S DIR(0)="S^C:Visits to Selected Clinics;P:Visits to Selected Providers;A:Include All Visits regardless of Clinic/Provider",DIR("A")="Limit by Clinic/Provider"

 S DIR("B")="A" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G WHICH

 S AMHCP=Y

 I AMHCP="A" K AMHPROV,AMHCLN G BROWSE

 I AMHCP="C" D CLIN I '$D(AMHCLN) G CP

 I AMHCP="P" D PROV I '$D(AMHPROV) G CP

BROWSE ;

 K ^TMP("AMHPHQO",$J)

 D GATHER

 D EN^VALM("AMH PHQ SCORES ONE PATIENT")

 K ^TMP("AMHPHQO",$J)

 D CLEAR^VALM1

 D FULL^VALM1

END ;

 K AMHP,AMHQUIT,AMHW,AMHV

 Q

 ;

EP(DFN) ;EP to list for one patient

 NEW AMHX,AMHY,AMHR0,AUPNPAT,AUPNDOB,AUPNDOD,AUPNDAYS,AUPNSEX,AMHV,AMHBD,AMHED

 D FULL^VALM1

 NEW D,R

 K AMHV

 I '$G(DFN) D PAT Q

 W:$D(IOF) @IOF

 W $$CTR("GAF Scores",80)

 S Y=DFN D ^AUPNPAT

 D WHICH

 Q

L ;get patients last visit

 ;AMHV array

 ;I '$D(^AMHREC("AE",DFN)) W !!,"No visits on file for this patient.",! S AMHQUIT=1 Q

 ;S D=$O(^AMHREC("AE",DFN,"")),R=$O(^AMHREC("AE",DFN,D,""))

 S (C,D)=0 F  S D=$O(^AMHREC("AE",DFN,D)) Q:D'=+D!(C>0)  S V=0 F  S V=$O(^AMHREC("AE",DFN,D,V)) Q:V'=+V!(C>0)  I $$ALLOWVI^AMHUTIL(DUZ,V) S C=C+1,AMHV(D,V)=""

 ;I R S AMHV(D,R)=""

 Q

N ;patients last N visits

 S AMHNUM=""

 S DIR(0)="N^1:99:0",DIR("A")="How many visits should be displayed",DIR("B")="5" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) S AMHQUIT=1 Q

 S AMHNUM=Y,AMHBD=0,AMHED=DT

 Q

R ;on program

 S N=""

 S DIR(0)="9002011,.02",DIR("A")="Visits to Which Program",DIR("B")="M" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) S AMHQUIT=1 Q

 S N=Y

 S D=0 F  S D=$O(^AMHREC("AE",DFN,D)) Q:D'=+D  S V=0 F  S V=$O(^AMHREC("AE",DFN,D,V)) Q:V'=+V  I $P(^AMHREC(V,0),U,2)=N,$$ALLOWVI^AMHUTIL(DUZ,V) S AMHV(D,V)=""

 Q

A ;all visits

 S AMHNUM=9999999

 S AMHBD=""

 S AMHED=DT

 Q

D ;date range

 K AMHED,AMHBD

 K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Date of Visit"

 D ^DIR S:Y<1 AMHQUIT=1 Q:Y<1  S AMHBD=Y

 K DIR S DIR(0)="DO^::EXP",DIR("A")="Enter Ending Date of Visit"

 D ^DIR S:Y<1 AMHQUIT=1 Q:Y<1  S AMHED=Y

 ;

 I AMHED<AMHBD D  G D

 . W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."

 S AMHNUM=99999999

 Q

P ;

 S N=""

 S DIR(0)="9002011.02,.01",DIR("A")="Visits to Which Provider",DIR("B")=$P(^VA(200,DUZ,0),U) KILL DA D ^DIR KILL DIR

 I $D(DIRUT) S AMHQUIT=1 Q

 S N=+Y

 S D=0 F  S D=$O(^AMHREC("AF",DFN,D)) Q:D'=+D  S V=0 F  S V=$O(^AMHREC("AF",DFN,D,V)) Q:V'=+V  I $$ALLOWVI^AMHUTIL(DUZ,V),$P(^AMHREC(V,0),U,14)]"",$$PPINT^AMHUTIL(V)=N S AMHV(D,V)=""

 Q

CLIN ;

 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" Q

 D PEP^AMQQGTX0(+Y,"AMHCLN(")

 I '$D(AMHCLN) Q

 I $D(AMHCLN("*")) K AMHCLN

 Q

PROV ;

 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" Q

 D PEP^AMQQGTX0(+Y,"AMHPROV(")

 I '$D(AMHPROV) Q

 I $D(AMHPROV("*")) K AMHPROV

 Q

HASPHQ(V) ;EP - does this visit have a phq measurement

 NEW X,Y,Z

 S (X,Z)=0

 F  S X=$O(^AMHRMSR("AD",V,X)) Q:X'=+X  S Y=$$VAL^XBDIQ1(9002011.12,X,.01) I Y="PHQ2"!(Y="PHQ9")!(Y="PHQT") S Z=1

 Q Z

HASPHQV(V) ;EP

 NEW X,Y,Z

 S (X,Z)=0

 F  S X=$O(^AUPNVMSR("AD",V,X)) Q:X'=+X  S Y=$$VAL^XBDIQ1(9000010.01,X,.01) I Y="PHQ2"!(Y="PHQ9")!(Y="PHQT") S Z=1

 Q Z

PRINT ;EP - called from xbdbque

 S AMHQUIT=0

 ;gather up all visit records in ^TMP("AMHPHQO",$J

 D GATHER

 D PRINT1

 K ^TMP("AMHPHQO",$J)

 Q

 ;

PRINT1 ;

 W:$D(IOF) @IOF

 NEW AMHX

 S AMHX=0 F  S AMHX=$O(^TMP("AMHPHQO",$J,AMHX)) Q:AMHX'=+AMHX!(AMHQUIT)  D

 .I $Y>(IOSL-5) D FF Q:AMHQUIT

 .W !,^TMP("AMHPHQO",$J,AMHX,0)

 .Q

 Q

GATHER ;

 K ^TMP("AMHPHQO",$J)

 NEW AMHX,AMHI,AMHJ,AMHY,AMHZ,AMHC,AMHD

 S AMHC=0

 S X="Patient Name: "_$P(^DPT(DFN,0),U),$E(X,45)="DOB: "_$$FMTE^XLFDT($P(^DPT(DFN,0),U,3)) D S(X)

 S X="HRN: "_$$HRN^AUPNPAT(DFN,DUZ(2)) D S(X)

 S X=$TR($J("",80)," ","*") D S(X)

 S X="Date",$E(X,11)="PHQ2",$E(X,16)="PHQ9",$E(X,21)="PHQT",$E(X,26)="PROVIDER",$E(X,41)="CLINIC",$E(X,55)="Diagnosis/POV" D S(X)

 S X="",$E(X,1)=$$REPEAT^XLFSTR("-",78) D S(X)

 S AMHV=0,AMHD=0,AMHRCNT=0

 F  S AMHV=$O(^AMHREC("C",DFN,AMHV)) Q:AMHV'=+AMHV  D

 .Q:'$$HASPHQ(AMHV)

 .Q:AMHBD>$P($P(^AMHREC(AMHV,0),U),".")

 .Q:AMHED<$P($P(^AMHREC(AMHV,0),U),".")

 .I $D(AMHCLN) Q:$P(^AMHREC(AMHV,0),U,25)=""

 .I $D(AMHCLN),'$D(AMHCLN($P(^AMHREC(AMHV,0),U,25))) Q

 .I $D(AMHPROV) S G=0 D  Q:'G

 ..S X=0 F  S X=$O(^AMHRPROV("AD",AMHV,X)) Q:X'=+X  D

 ...S Y=$P($G(^AMHRPROV(X,0)),U)

 ...Q:Y=""

 ...Q:'$D(AMHPROV(Y))

 ...S G=1,AMHRCNT=AMHRCNT+1

 .S AMHV((9999999-$P($P(^AMHREC(AMHV,0),U),".")),"BH",AMHV)="",AMHRCNT=AMHRCNT+1

 ;

 ;NOW get pcc visits

 S AMHV=0 F  S AMHV=$O(^AUPNVSIT("AC",DFN,AMHV)) Q:AMHV'=+AMHV  D

 .Q:'$$HASPHQV(AMHV)

 .Q:$D(^AMHREC("AVISIT",AMHV))  ;already in BH

 .Q:AMHBD>$P($P(^AUPNVSIT(AMHV,0),U),".")

 .Q:AMHED<$P($P(^AUPNVSIT(AMHV,0),U),".")

 .I $D(AMHCLN) Q:$P(^AUPNVSIT(AMHV,0),U,8)=""

 .I $D(AMHCLN),'$D(AMHCLN($P(^AUPNVSIT(AMHV,0),U,8))) Q

 .I $D(AMHPROV) S G=0 D  Q:'G

 ..S X=0 F  S X=$O(^AUPNVPRV("AD",AMHV,X)) Q:X'=+X  D

 ...S Y=$P($G(^AUPNVPRV(X,0)),U)

 ...Q:Y=""

 ...Q:'$D(AMHPROV(Y))

 ...S G=1

 .S AMHV((9999999-$P($P(^AUPNVSIT(AMHV,0),U),".")),"PCC",AMHV)="",AMHRCNT=AMHRCNT+1

 S AMHD=0,AMHCNT=0 F  S AMHD=$O(AMHV(AMHD)) Q:AMHD=""!(AMHCNT>AMHNUM)  D

 .S AMHT="" F  S AMHT=$O(AMHV(AMHD,AMHT)) Q:AMHT=""!(AMHCNT>AMHNUM)  D

 ..S AMHV=0 F  S AMHV=$O(AMHV(AMHD,AMHT,AMHV)) Q:AMHV'=+AMHV!(AMHCNT>AMHNUM)  D

 ...S AMHCNT=AMHCNT+1

 ...Q:AMHCNT>AMHNUM

 ...I AMHT="BH" D

 ....S AMHR0=^AMHREC(AMHV,0)

 ....S AMHX=$$D^AMHRPEC($P(AMHR0,U))

 ....S (X,Z)=0 S (Z,N,J)=""

 ....F  S X=$O(^AMHRMSR("AD",AMHV,X)) Q:X'=+X  S Y=$$VAL^XBDIQ1(9002011.12,X,.01) D

 .....I Y="PHQ2" S Z=Z_$P(^AMHRMSR(X,0),U,4)_" "

 .....I Y="PHQ9" S N=N_$P(^AMHRMSR(X,0),U,4)_" "

 .....I Y="PHQT" S J=J_$P(^AMHRMSR(X,0),U,4)_" "

 ....S $E(AMHX,11)=Z

 ....S $E(AMHX,16)=N

 ....S $E(AMHX,21)=J

 ....S $E(AMHX,26)=$E($$PPNAME^AMHUTIL(AMHV),1,14)

 ....S $E(AMHX,41)=$E($$VAL^XBDIQ1(9002011,AMHV,.25),1,13)

 ....S X=$O(^AMHRPRO("AD",AMHV,0))

 ....I X S $E(AMHX,55)=$$VAL^XBDIQ1(9002011.01,X,.01)_" - "_$E($$VAL^XBDIQ1(9002011.01,X,.04),1,25)

 ....D S(AMHX)

 ...I AMHT="PCC" D

 ....S AMHX=$$D^AMHRPEC($P(^AUPNVSIT(AMHV,0),U))

 ....S (X,Z)=0 S (Z,N,J)=""

 ....F  S X=$O(^AUPNVMSR("AD",AMHV,X)) Q:X'=+X  S Y=$$VAL^XBDIQ1(9000010.01,X,.01) D

 .....I Y="PHQ2" S Z=Z_$P(^AUPNVMSR(X,0),U,4)_" "

 .....I Y="PHQ9" S N=N_$P(^AUPNVMSR(X,0),U,4)_" "

 .....I Y="PHQT" S J=J_$P(^AUPNVMSR(X,0),U,4)_" "

 ....S $E(AMHX,11)=Z

 ....S $E(AMHX,16)=N

 ....S $E(AMHX,21)=J

 ....S $E(AMHX,26)=$E($$PRIMPROV^APCLV(AMHV,"N"),1,14)

 ....S $E(AMHX,41)=$E($$VAL^XBDIQ1(9000010,AMHV,.08),1,13)

 ....S X=$O(^AUPNVPOV("AD",AMHV,0))

 ....I X S $E(AMHX,55)=$$VAL^XBDIQ1(9000010.07,X,.01)_" - "_$E($$VAL^XBDIQ1(9000010.07,X,.04),1,25)

 ....D S(AMHX)

 I AMHCNT=0 S X="No Visits with PHQ2/PHQ9/PHQ9T measurements in the specified time frame." D S(X,1)

 Q

CTR(X,Y) ;EP - Center X in a field Y wide.

 Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X

 ;----------

FF ;EP

 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S AMHQUIT=1 Q

 I $E(IOST)'="C" Q:'$P(AMHR0,U,8)  W !!,$TR($J(" ",79)," ","*"),!,$P(^DPT($P(AMHR0,U,8),0),U),?32,"HRN: " D

 .S H=$P($G(^AUPNPAT($P(AMHR0,U,8),41,DUZ(2),0)),U,2)

 .W H,?46,"DOB: ",$$FMTE^XLFDT($P(^DPT($P(AMHR0,U,8),0),U,3),"2D"),?59,"SSN: ",$$SSN^AMHUTIL($P(AMHR0,U,8)),!

 W:$D(IOF) @IOF

 Q

HDR ; -- header code

 Q

 ;

S(Y,F,C,T) ;EP - set up array

 I '$G(F) S F=0

 I '$G(T) S T=0

 ;blank lines

 F F=1:1:F S X="" D S1

 S X=Y

 I $G(C) S L=$L(Y),T=(80-L)/2 D  D S1 Q

 .F %=1:1:(T-1) S X=" "_X

 F %=1:1:T S X=" "_Y

 D S1

 Q

S1 ;

 S AMHC=AMHC+1

 S ^TMP("AMHPHQO",$J,AMHC,0)=X

 Q

INIT ; -- init variables and list array

 S VALMCNT=$O(^TMP("AMHPHQO",$J,""),-1)

 Q

 ;

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 Q

 ;

EXPND ; -- expand code

 Q

AMHPHQO   ; IHS/CMI/LAB - BROWSE VISITS ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;**6**;JUN 02, 2010;Build 10

 +2       ;

 +3       ;

START     ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        DO EN^XBVK("AMH")

 +3        WRITE !,$$CTR("PHQ-2, PHQ-9 and PHQ-9T Depression Outcomes - Scores for One Patient",80),!!

 +4        WRITE !,"This option is used to list PHQ2/PHQ9/PHQT Scores for one patient within",!,"a date range specified by the user.",!

 +5        DO DBHUSR^AMHUTIL

PAT       ;

 +1        SET DFN=""

 +2        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC,DA,DR,DLAYGO,DIADD

 +3        IF Y<0

               WRITE !,"No Patient Selected."

               QUIT 

 +4        SET DFN=+Y

 +5        SET Y=DFN

           DO ^AUPNPAT

 +6        IF DFN

               IF '$$ALLOWP^AMHUTIL(DUZ,DFN)

                   DO NALLOWP^AMHUTIL

                   DO PAUSE^AMHLEA

                   GOTO PAT

 +7        IF $GET(AUPNDOD)]""

               WRITE !!?10,"***** PATIENT'S DATE OF DEATH IS ",$$DT_source.html#FMTE">FMTE^XLFDT(AUPNDOD),!!

               HANG 2

WHICH     ;

 +1        WRITE !!,"Please note:  Only visits with PHQ2, PHQ9 and PHQ9T scores recorded will",!,"display on this list.",!

 +2        SET AMHQUIT=0

 +3        SET AMHW=""

 +4        SET (AMHBD,AMHED,AMHNUM)=""

 +5        KILL DIR

           SET DIR(0)="S^N:Patient's Last N Visits;D:Visits in a Date Range;A:All of this Patient's Visits"

 +6        SET DIR("A")="Browse which subset of visits for "_$PIECE(^DPT(DFN,0),U)

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +7        IF $DATA(DIRUT)

               QUIT 

 +8        SET AMHW=Y

 +9        DO @AMHW

           IF AMHQUIT

               QUIT 

 +10      ;

CP        ;

 +1        SET AMHCP=""

 +2        SET DIR(0)="S^C:Visits to Selected Clinics;P:Visits to Selected Providers;A:Include All Visits regardless of Clinic/Provider"

           SET DIR("A")="Limit by Clinic/Provider"

 +3        SET DIR("B")="A"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               GOTO WHICH

 +5        SET AMHCP=Y

 +6        IF AMHCP="A"

               KILL AMHPROV,AMHCLN

               GOTO BROWSE

 +7        IF AMHCP="C"

               DO CLIN

               IF '$DATA(AMHCLN)

                   GOTO CP

 +8        IF AMHCP="P"

               DO PROV

               IF '$DATA(AMHPROV)

                   GOTO CP

BROWSE    ;

 +1        KILL ^TMP("AMHPHQO",$JOB)

 +2        DO GATHER

 +3        DO EN^VALM("AMH PHQ SCORES ONE PATIENT")

 +4        KILL ^TMP("AMHPHQO",$JOB)

 +5        DO CLEAR^VALM1

 +6        DO FULL^VALM1

END       ;

 +1        KILL AMHP,AMHQUIT,AMHW,AMHV

 +2        QUIT 

 +3       ;

EP(DFN)   ;EP to list for one patient

 +1        NEW AMHX,AMHY,AMHR0,AUPNPAT,AUPNDOB,AUPNDOD,AUPNDAYS,AUPNSEX,AMHV,AMHBD,AMHED

 +2        DO FULL^VALM1

 +3        NEW D,R

 +4        KILL AMHV

 +5        IF '$GET(DFN)

               DO PAT

               QUIT 

 +6        IF $DATA(IOF)

               WRITE @IOF

 +7        WRITE $$CTR("GAF Scores",80)

 +8        SET Y=DFN

           DO ^AUPNPAT

 +9        DO WHICH

 +10       QUIT 

L         ;get patients last visit

 +1       ;AMHV array

 +2       ;I '$D(^AMHREC("AE",DFN)) W !!,"No visits on file for this patient.",! S AMHQUIT=1 Q

 +3       ;S D=$O(^AMHREC("AE",DFN,"")),R=$O(^AMHREC("AE",DFN,D,""))

 +4        SET (C,D)=0

           FOR 

               SET D=$ORDER(^AMHREC("AE",DFN,D))

               IF D'=+D!(C>0)

                   QUIT 

               SET V=0

               FOR 

                   SET V=$ORDER(^AMHREC("AE",DFN,D,V))

                   IF V'=+V!(C>0)

                       QUIT 

                   IF $$ALLOWVI^AMHUTIL(DUZ,V)

                       SET C=C+1

                       SET AMHV(D,V)=""

 +5       ;I R S AMHV(D,R)=""

 +6        QUIT 

N         ;patients last N visits

 +1        SET AMHNUM=""

 +2        SET DIR(0)="N^1:99:0"

           SET DIR("A")="How many visits should be displayed"

           SET DIR("B")="5"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               SET AMHQUIT=1

               QUIT 

 +4        SET AMHNUM=Y

           SET AMHBD=0

           SET AMHED=DT

 +5        QUIT 

R         ;on program

 +1        SET N=""

 +2        SET DIR(0)="9002011,.02"

           SET DIR("A")="Visits to Which Program"

           SET DIR("B")="M"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               SET AMHQUIT=1

               QUIT 

 +4        SET N=Y

 +5        SET D=0

           FOR 

               SET D=$ORDER(^AMHREC("AE",DFN,D))

               IF D'=+D

                   QUIT 

               SET V=0

               FOR 

                   SET V=$ORDER(^AMHREC("AE",DFN,D,V))

                   IF V'=+V

                       QUIT 

                   IF $PIECE(^AMHREC(V,0),U,2)=N

                       IF $$ALLOWVI^AMHUTIL(DUZ,V)

                           SET AMHV(D,V)=""

 +6        QUIT 

A         ;all visits

 +1        SET AMHNUM=9999999

 +2        SET AMHBD=""

 +3        SET AMHED=DT

 +4        QUIT 

D         ;date range

 +1        KILL AMHED,AMHBD

 +2        KILL DIR

           WRITE !

           SET DIR(0)="DO^::EXP"

           SET DIR("A")="Enter Beginning Date of Visit"

 +3        DO ^DIR

           IF Y<1

               SET AMHQUIT=1

           IF Y<1

               QUIT 

           SET AMHBD=Y

 +4        KILL DIR

           SET DIR(0)="DO^::EXP"

           SET DIR("A")="Enter Ending Date of Visit"

 +5        DO ^DIR

           IF Y<1

               SET AMHQUIT=1

           IF Y<1

               QUIT 

           SET AMHED=Y

 +6       ;

 +7        IF AMHED<AMHBD

               Begin DoDot:1

 +8                WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."

               End DoDot:1

               GOTO D

 +9        SET AMHNUM=99999999

 +10       QUIT 

P         ;

 +1        SET N=""

 +2        SET DIR(0)="9002011.02,.01"

           SET DIR("A")="Visits to Which Provider"

           SET DIR("B")=$PIECE(^VA(200,DUZ,0),U)

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               SET AMHQUIT=1

               QUIT 

 +4        SET N=+Y

 +5        SET D=0

           FOR 

               SET D=$ORDER(^AMHREC("AF",DFN,D))

               IF D'=+D

                   QUIT 

               SET V=0

               FOR 

                   SET V=$ORDER(^AMHREC("AF",DFN,D,V))

                   IF V'=+V

                       QUIT 

                   IF $$ALLOWVI^AMHUTIL(DUZ,V)

                       IF $PIECE(^AMHREC(V,0),U,14)]""

                           IF $$PPINT^AMHUTIL(V)=N

                               SET AMHV(D,V)=""

 +6        QUIT 

CLIN      ;

 +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"

               QUIT 

 +2        DO PEP^AMQQGTX0(+Y,"AMHCLN(")

 +3        IF '$DATA(AMHCLN)

               QUIT 

 +4        IF $DATA(AMHCLN("*"))

               KILL AMHCLN

 +5        QUIT 

PROV      ;

 +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"

               QUIT 

 +2        DO PEP^AMQQGTX0(+Y,"AMHPROV(")

 +3        IF '$DATA(AMHPROV)

               QUIT 

 +4        IF $DATA(AMHPROV("*"))

               KILL AMHPROV

 +5        QUIT 

HASPHQ(V) ;EP - does this visit have a phq measurement

 +1        NEW X,Y,Z

 +2        SET (X,Z)=0

 +3        FOR 

               SET X=$ORDER(^AMHRMSR("AD",V,X))

               IF X'=+X

                   QUIT 

               SET Y=$$VAL^XBDIQ1(9002011.12,X,.01)

               IF Y="PHQ2"!(Y="PHQ9")!(Y="PHQT")

                   SET Z=1

 +4        QUIT Z

HASPHQV(V) ;EP

 +1        NEW X,Y,Z

 +2        SET (X,Z)=0

 +3        FOR 

               SET X=$ORDER(^AUPNVMSR("AD",V,X))

               IF X'=+X

                   QUIT 

               SET Y=$$VAL^XBDIQ1(9000010.01,X,.01)

               IF Y="PHQ2"!(Y="PHQ9")!(Y="PHQT")

                   SET Z=1

 +4        QUIT Z

PRINT     ;EP - called from xbdbque

 +1        SET AMHQUIT=0

 +2       ;gather up all visit records in ^TMP("AMHPHQO",$J

 +3        DO GATHER

 +4        DO PRINT1

 +5        KILL ^TMP("AMHPHQO",$JOB)

 +6        QUIT 

 +7       ;

PRINT1    ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        NEW AMHX

 +3        SET AMHX=0

           FOR 

               SET AMHX=$ORDER(^TMP("AMHPHQO",$JOB,AMHX))

               IF AMHX'=+AMHX!(AMHQUIT)

                   QUIT 

               Begin DoDot:1

 +4                IF $Y>(IOSL-5)

                       DO FF

                       IF AMHQUIT

                           QUIT 

 +5                WRITE !,^TMP("AMHPHQO",$JOB,AMHX,0)

 +6                QUIT 

               End DoDot:1

 +7        QUIT 

GATHER    ;

 +1        KILL ^TMP("AMHPHQO",$JOB)

 +2        NEW AMHX,AMHI,AMHJ,AMHY,AMHZ,AMHC,AMHD

 +3        SET AMHC=0

 +4        SET X="Patient Name: "_$PIECE(^DPT(DFN,0),U)

           SET $EXTRACT(X,45)="DOB: "_$$FMTE^XLFDT($PIECE(^DPT(DFN,0),U,3))

           DO S(X)

 +5        SET X="HRN: "_$$HRN^AUPNPAT(DFN,DUZ(2))

           DO S(X)

 +6        SET X=$TRANSLATE($JUSTIFY("",80)," ","*")

           DO S(X)

 +7        SET X="Date"

           SET $EXTRACT(X,11)="PHQ2"

           SET $EXTRACT(X,16)="PHQ9"

           SET $EXTRACT(X,21)="PHQT"

           SET $EXTRACT(X,26)="PROVIDER"

           SET $EXTRACT(X,41)="CLINIC"

           SET $EXTRACT(X,55)="Diagnosis/POV"

           DO S(X)

 +8        SET X=""

           SET $EXTRACT(X,1)=$$REPEAT^XLFSTR("-",78)

           DO S(X)

 +9        SET AMHV=0

           SET AMHD=0

           SET AMHRCNT=0

 +10       FOR 

               SET AMHV=$ORDER(^AMHREC("C",DFN,AMHV))

               IF AMHV'=+AMHV

                   QUIT 

               Begin DoDot:1

 +11               IF '$$HASPHQ(AMHV)

                       QUIT 

 +12               IF AMHBD>$PIECE($PIECE(^AMHREC(AMHV,0),U),".")

                       QUIT 

 +13               IF AMHED<$PIECE($PIECE(^AMHREC(AMHV,0),U),".")

                       QUIT 

 +14               IF $DATA(AMHCLN)

                       IF $PIECE(^AMHREC(AMHV,0),U,25)=""

                           QUIT 

 +15               IF $DATA(AMHCLN)

                       IF '$DATA(AMHCLN($PIECE(^AMHREC(AMHV,0),U,25)))

                           QUIT 

 +16               IF $DATA(AMHPROV)

                       SET G=0

                       Begin DoDot:2

 +17                       SET X=0

                           FOR 

                               SET X=$ORDER(^AMHRPROV("AD",AMHV,X))

                               IF X'=+X

                                   QUIT