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
Begin DoDot:3
+18 SET Y=$PIECE($GET(^AMHRPROV(X,0)),U)
+19 IF Y=""
QUIT
+20 IF '$DATA(AMHPROV(Y))
QUIT
+21 SET G=1
SET AMHRCNT=AMHRCNT+1
End DoDot:3
End DoDot:2
IF 'G
QUIT
+22 SET AMHV((9999999-$PIECE($PIECE(^AMHREC(AMHV,0),U),".")),"BH",AMHV)=""
SET AMHRCNT=AMHRCNT+1
End DoDot:1
+23 ;
+24 ;NOW get pcc visits
+25 SET AMHV=0
FOR
SET AMHV=$ORDER(^AUPNVSIT("AC",DFN,AMHV))
IF AMHV'=+AMHV
QUIT
Begin DoDot:1
+26 IF '$$HASPHQV(AMHV)
QUIT
+27 ;already in BH
IF $DATA(^AMHREC("AVISIT",AMHV))
QUIT
+28 IF AMHBD>$PIECE($PIECE(^AUPNVSIT(AMHV,0),U),".")
QUIT
+29 IF AMHED<$PIECE($PIECE(^AUPNVSIT(AMHV,0),U),".")
QUIT
+30 IF $DATA(AMHCLN)
IF $PIECE(^AUPNVSIT(AMHV,0),U,8)=""
QUIT
+31 IF $DATA(AMHCLN)
IF '$DATA(AMHCLN($PIECE(^AUPNVSIT(AMHV,0),U,8)))
QUIT
+32 IF $DATA(AMHPROV)
SET G=0
Begin DoDot:2
+33 SET X=0
FOR
SET X=$ORDER(^AUPNVPRV("AD",AMHV,X))
IF X'=+X
QUIT
Begin DoDot:3
+34 SET Y=$PIECE($GET(^AUPNVPRV(X,0)),U)
+35 IF Y=""
QUIT
+36 IF '$DATA(AMHPROV(Y))
QUIT
+37 SET G=1
End DoDot:3
End DoDot:2
IF 'G
QUIT
+38 SET AMHV((9999999-$PIECE($PIECE(^AUPNVSIT(AMHV,0),U),".")),"PCC",AMHV)=""
SET AMHRCNT=AMHRCNT+1
End DoDot:1
+39 SET AMHD=0
SET AMHCNT=0
FOR
SET AMHD=$ORDER(AMHV(AMHD))
IF AMHD=""!(AMHCNT>AMHNUM)
QUIT
Begin DoDot:1
+40 SET AMHT=""
FOR
SET AMHT=$ORDER(AMHV(AMHD,AMHT))
IF AMHT=""!(AMHCNT>AMHNUM)
QUIT
Begin DoDot:2
+41 SET AMHV=0
FOR
SET AMHV=$ORDER(AMHV(AMHD,AMHT,AMHV))
IF AMHV'=+AMHV!(AMHCNT>AMHNUM)
QUIT
Begin DoDot:3
+42 SET AMHCNT=AMHCNT+1
+43 IF AMHCNT>AMHNUM
QUIT
+44 IF AMHT="BH"
Begin DoDot:4
+45 SET AMHR0=^AMHREC(AMHV,0)
+46 SET AMHX=$$D^AMHRPEC($PIECE(AMHR0,U))
+47 SET (X,Z)=0
SET (Z,N,J)=""
+48 FOR
SET X=$ORDER(^AMHRMSR("AD",AMHV,X))
IF X'=+X
QUIT
SET Y=$$VAL^XBDIQ1(9002011.12,X,.01)
Begin DoDot:5
+49 IF Y="PHQ2"
SET Z=Z_$PIECE(^AMHRMSR(X,0),U,4)_" "
+50 IF Y="PHQ9"
SET N=N_$PIECE(^AMHRMSR(X,0),U,4)_" "
+51 IF Y="PHQT"
SET J=J_$PIECE(^AMHRMSR(X,0),U,4)_" "
End DoDot:5
+52 SET $EXTRACT(AMHX,11)=Z
+53 SET $EXTRACT(AMHX,16)=N
+54 SET $EXTRACT(AMHX,21)=J
+55 SET $EXTRACT(AMHX,26)=$EXTRACT($$PPNAME^AMHUTIL(AMHV),1,14)
+56 SET $EXTRACT(AMHX,41)=$EXTRACT($$VAL^XBDIQ1(9002011,AMHV,.25),1,13)
+57 SET X=$ORDER(^AMHRPRO("AD",AMHV,0))
+58 IF X
SET $EXTRACT(AMHX,55)=$$VAL^XBDIQ1(9002011.01,X,.01)_" - "_$EXTRACT($$VAL^XBDIQ1(9002011.01,X,.04),1,25)
+59 DO S(AMHX)
End DoDot:4
+60 IF AMHT="PCC"
Begin DoDot:4
+61 SET AMHX=$$D^AMHRPEC($PIECE(^AUPNVSIT(AMHV,0),U))
+62 SET (X,Z)=0
SET (Z,N,J)=""
+63 FOR
SET X=$ORDER(^AUPNVMSR("AD",AMHV,X))
IF X'=+X
QUIT
SET Y=$$VAL^XBDIQ1(9000010.01,X,.01)
Begin DoDot:5
+64 IF Y="PHQ2"
SET Z=Z_$PIECE(^AUPNVMSR(X,0),U,4)_" "
+65 IF Y="PHQ9"
SET N=N_$PIECE(^AUPNVMSR(X,0),U,4)_" "
+66 IF Y="PHQT"
SET J=J_$PIECE(^AUPNVMSR(X,0),U,4)_" "
End DoDot:5
+67 SET $EXTRACT(AMHX,11)=Z
+68 SET $EXTRACT(AMHX,16)=N
+69 SET $EXTRACT(AMHX,21)=J
+70 SET $EXTRACT(AMHX,26)=$EXTRACT($$PRIMPROV^APCLV(AMHV,"N"),1,14)
+71 SET $EXTRACT(AMHX,41)=$EXTRACT($$VAL^XBDIQ1(9000010,AMHV,.08),1,13)
+72 SET X=$ORDER(^AUPNVPOV("AD",AMHV,0))
+73 IF X
SET $EXTRACT(AMHX,55)=$$VAL^XBDIQ1(9000010.07,X,.01)_" - "_$EXTRACT($$VAL^XBDIQ1(9000010.07,X,.04),1,25)
+74 DO S(AMHX)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+75 IF AMHCNT=0
SET X="No Visits with PHQ2/PHQ9/PHQ9T measurements in the specified time frame."
DO S(X,1)
+76 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
FF ;EP
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET AMHQUIT=1
QUIT
+2 IF $EXTRACT(IOST)'="C"
IF '$PIECE(AMHR0,U,8)
QUIT
WRITE !!,$TRANSLATE($JUSTIFY(" ",79)," ","*"),!,$PIECE(^DPT($PIECE(AMHR0,U,8),0),U),?32,"HRN: "
Begin DoDot:1
+3 SET H=$PIECE($GET(^AUPNPAT($PIECE(AMHR0,U,8),41,DUZ(2),0)),U,2)
+4 WRITE H,?46,"DOB: ",$$FMTE^XLFDT($PIECE(^DPT($PIECE(AMHR0,U,8),0),U,3),"2D"),?59,"SSN: ",$$SSN^AMHUTIL($PIECE(AMHR0,U,8)),!
End DoDot:1
+5 IF $DATA(IOF)
WRITE @IOF
+6 QUIT
HDR ; -- header code
+1 QUIT
+2 ;
S(Y,F,C,T) ;EP - set up array
+1 IF '$GET(F)
SET F=0
+2 IF '$GET(T)
SET T=0
+3 ;blank lines
+4 FOR F=1:1:F
SET X=""
DO S1
+5 SET X=Y
+6 IF $GET(C)
SET L=$LENGTH(Y)
SET T=(80-L)/2
Begin DoDot:1
+7 FOR %=1:1:(T-1)
SET X=" "_X
End DoDot:1
DO S1
QUIT
+8 FOR %=1:1:T
SET X=" "_Y
+9 DO S1
+10 QUIT
S1 ;
+1 SET AMHC=AMHC+1
+2 SET ^TMP("AMHPHQO",$JOB,AMHC,0)=X
+3 QUIT
INIT ; -- init variables and list array
+1 SET VALMCNT=$ORDER(^TMP("AMHPHQO",$JOB,""),-1)
+2 QUIT
+3 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
EXPND ; -- expand code
+1 QUIT
