AMHLELV ; IHS/CMI/LAB - MENTAL HLTH ROUTINE ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
START ;EP display patients last visit
K AMHQUIT
D GETPAT
I 'AMHPAT D XIT Q
D PROV
D GETREC
I 'AMHR,AMHLVPR W !!,"No visits to that provider." H 2 D XIT Q
I 'AMHR D XIT Q
D FORMAT
Q:AMHTYPE=""
ZIS ;
S XBRC="COMP^AMHLELV",XBRP=$S(AMHTYPE="E":"^AMHLEFP2",1:"EN1^AMHLELV"),XBNS="AMH",XBRX="XIT^AMHLELV"
D ^XBDBQUE
D XIT
Q
XIT ;
D KILL^AUPNPAT
K AMHVDFN,AMHVDG,AMHVDSH,AMHVFLE,AMHVI,AMHVIGR,AMHVL,AMHVNM,AMHX,AMHBRK,AMHTYPE,AMHDLAST
K ZTSK,Y,AMHBD,AMHED,IO("Q"),AMH80D,AMHBTH,AMHHRCN,AMHJOB,AMHLENG,AMHPCNT,AMHPG,AMHPROV,AMHX,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,XBNS,XBRC,XBRP,XBTX,D,AMHC
K AMHPRNM,AMHPRNT,AMHPROB,AMHPRV,AMHR,AMHRCNT,AMHRLOC,AMHSD,AMHTOT,AMHBDD,AMHBT,AMHEDD,AMHEDO,AMHBDO,AMHBT,AMHFOUND,AMHHIT,AMHID,AMHLINE,AMHP,AMHHRN,AMHODAT,AMHQUIT,AMHR0,AMHTICL,AMHTNRQ,AMHTQ,AMHTTXT
K AMHPAT
Q
EN2(AMHPAT) ;
NEW AMHR
I '$D(^AMHREC("AE",AMHPAT)) W !!,"No visits of file for this patient - "_$P(^DPT(AMHPAT,0),U),! H 2 Q
D PROV
D GETREC
I 'AMHR W !,"No visits for that patient." H 2 Q
D EN^AMHDVD
Q
EN1 ;EP - called from xbdbque
I $E(IOST)="C",IO=IO(0) D EN^AMHDVD Q
K ^TMP("AMHVDSG",$J)
D EP^AMHVDSG(AMHR)
S AMHPG=0
D PHD
S AMHX=0 F S AMHX=$O(^TMP("AMHVDSG",$J,AMHX)) Q:AMHX'=+AMHX D
.I $Y>(IOSL-3) D PHD
.W !,^TMP("AMHVDSG",$J,AMHX,0)
.Q
K AMHX
Q
PHD ;
I 'AMHPG G PHD1
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
PHD1 ;
S AMHPG=AMHPG+1 I AMHPG>1 W:$D(IOF) @IOF
W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
W !,$P(^VA(200,DUZ,0),U,2)," ",$$FMTE^XLFDT(DT),?20,"BEHAVIORAL HEALTH RECORD DISPLAY",?72,"Page ",AMHPG,!
Q
GETPAT ; GET PATIENT
S AMHPAT=""
S DIC("A")="Enter PATIENT (if known, otherwise press ENTER): ",DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC
Q:Y<0
S AMHPAT=+Y
I '$$ALLOWP^AMHUTIL(DUZ,AMHPAT) D NALLOWP^AMHUTIL S AMHPAT="" Q
I $G(AUPNDOD)]"" W !!?10,"***** PATIENT'S DATE OF DEATH IS ",$$FMTE^XLFDT(AUPNDOD),!! H 2
Q
;
GETREC ;
S AMHR=""
I '$D(^AMHREC("AE",AMHPAT)) W !!,"No visits on file for this patient.",! Q
;I AMHLVPR="" D
;.;S AMHDLAST=$O(^AMHREC("AE",AUPNPAT,"")),AMHR=$O(^AMHREC("AE",AUPNPAT,AMHDLAST,"")) Q
NEW D,%,P S (D,%)="" F S D=$O(^AMHREC("AE",AMHPAT,D)) Q:D'=+D!(AMHR) D
.S V=0 F S V=$O(^AMHREC("AE",AMHPAT,D,V)) Q:V'=+V D
..Q:'$$ALLOWVI^AMHUTIL(DUZ,V)
..I AMHLVPR="" S AMHR=V Q
..I $$PPINT^AMHUTIL(V)=AMHLVPR S AMHR=V
.Q
Q
PROV ;
S AMHLVPR=""
S DIR(0)="Y",DIR("A")="Do you want a particular provider's last visit",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) Q
I 'Y Q
S DIC=200,DIC(0)="AEMQ",DIC("B")=$P(^VA(200,DUZ,0),U) D ^DIC
I Y=-1 G PROV
S AMHLVPR=+Y
Q
FORMAT ;
S AMHTYPE=""
S DIR(0)="S^E:Encounter Form Format;S:Standard Display",DIR("A")="Select Print Format",DIR("B")="E" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
S AMHTYPE=Y
Q:AMHTYPE="S"
K AMHEFT
;W !! S DIR(0)="S^F:Full Encounter Form;S:Suppressed Encounter Form;B:Both",DIR("A")="What type of form do you want to print"
;S DIR("B")=$S($P(^AMHSITE(DUZ(2),0),U,23)]"":$P(^AMHSITE(DUZ(2),0),U,23),1:"B") K DA D ^DIR K DIR
D FORMDIR^AMHLEFP(AMHR)
I $D(DIRUT) G FORMAT
S AMHEFT=Y
Q
COMP ;
Q
AMHLELV ; IHS/CMI/LAB - MENTAL HLTH ROUTINE ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
START ;EP display patients last visit
+1 KILL AMHQUIT
+2 DO GETPAT
+3 IF 'AMHPAT
DO XIT
QUIT
+4 DO PROV
+5 DO GETREC
+6 IF 'AMHR
IF AMHLVPR
WRITE !!,"No visits to that provider."
HANG 2
DO XIT
QUIT
+7 IF 'AMHR
DO XIT
QUIT
+8 DO FORMAT
+9 IF AMHTYPE=""
QUIT
ZIS ;
+1 SET XBRC="COMP^AMHLELV"
SET XBRP=$SELECT(AMHTYPE="E":"^AMHLEFP2",1:"EN1^AMHLELV")
SET XBNS="AMH"
SET XBRX="XIT^AMHLELV"
+2 DO ^XBDBQUE
+3 DO XIT
+4 QUIT
XIT ;
+1 DO KILL^AUPNPAT
+2 KILL AMHVDFN,AMHVDG,AMHVDSH,AMHVFLE,AMHVI,AMHVIGR,AMHVL,AMHVNM,AMHX,AMHBRK,AMHTYPE,AMHDLAST
+3 KILL ZTSK,Y,AMHBD,AMHED,IO("Q"),AMH80D,AMHBTH,AMHHRCN,AMHJOB,AMHLENG,AMHPCNT,AMHPG,AMHPROV,AMHX,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,XBNS,XBRC,XBRP,XBTX,D,AMHC
+4 KILL AMHPRNM,AMHPRNT,AMHPROB,AMHPRV,AMHR,AMHRCNT,AMHRLOC,AMHSD,AMHTOT,AMHBDD,AMHBT,AMHEDD,AMHEDO,AMHBDO,AMHBT,AMHFOUND,AMHHIT,AMHID,AMHLINE,AMHP,AMHHRN,AMHODAT,AMHQUIT,AMHR0,AMHTICL,AMHTNRQ,AMHTQ,AMHTTXT
+5 KILL AMHPAT
+6 QUIT
EN2(AMHPAT) ;
+1 NEW AMHR
+2 IF '$DATA(^AMHREC("AE",AMHPAT))
WRITE !!,"No visits of file for this patient - "_$PIECE(^DPT(AMHPAT,0),U),!
HANG 2
QUIT
+3 DO PROV
+4 DO GETREC
+5 IF 'AMHR
WRITE !,"No visits for that patient."
HANG 2
QUIT
+6 DO EN^AMHDVD
+7 QUIT
EN1 ;EP - called from xbdbque
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
DO EN^AMHDVD
QUIT
+2 KILL ^TMP("AMHVDSG",$JOB)
+3 DO EP^AMHVDSG(AMHR)
+4 SET AMHPG=0
+5 DO PHD
+6 SET AMHX=0
FOR
SET AMHX=$ORDER(^TMP("AMHVDSG",$JOB,AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+7 IF $Y>(IOSL-3)
DO PHD
+8 WRITE !,^TMP("AMHVDSG",$JOB,AMHX,0)
+9 QUIT
End DoDot:1
+10 KILL AMHX
+11 QUIT
PHD ;
+1 IF 'AMHPG
GOTO PHD1
+2 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=""
QUIT
PHD1 ;
+1 SET AMHPG=AMHPG+1
IF AMHPG>1
IF $DATA(IOF)
WRITE @IOF
+2 WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
+3 WRITE !,$PIECE(^VA(200,DUZ,0),U,2)," ",$$FMTE^XLFDT(DT),?20,"BEHAVIORAL HEALTH RECORD DISPLAY",?72,"Page ",AMHPG,!
+4 QUIT
GETPAT ; GET PATIENT
+1 SET AMHPAT=""
+2 SET DIC("A")="Enter PATIENT (if known, otherwise press ENTER): "
SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+3 IF Y<0
QUIT
+4 SET AMHPAT=+Y
+5 IF '$$ALLOWP^AMHUTIL(DUZ,AMHPAT)
DO NALLOWP^AMHUTIL
SET AMHPAT=""
QUIT
+6 IF $GET(AUPNDOD)]""
WRITE !!?10,"***** PATIENT'S DATE OF DEATH IS ",$$FMTE^XLFDT(AUPNDOD),!!
HANG 2
+7 QUIT
+8 ;
GETREC ;
+1 SET AMHR=""
+2 IF '$DATA(^AMHREC("AE",AMHPAT))
WRITE !!,"No visits on file for this patient.",!
QUIT
+3 ;I AMHLVPR="" D
+4 ;.;S AMHDLAST=$O(^AMHREC("AE",AUPNPAT,"")),AMHR=$O(^AMHREC("AE",AUPNPAT,AMHDLAST,"")) Q
+5 NEW D,%,P
SET (D,%)=""
FOR
SET D=$ORDER(^AMHREC("AE",AMHPAT,D))
IF D'=+D!(AMHR)
QUIT
Begin DoDot:1
+6 SET V=0
FOR
SET V=$ORDER(^AMHREC("AE",AMHPAT,D,V))
IF V'=+V
QUIT
Begin DoDot:2
+7 IF '$$ALLOWVI^AMHUTIL(DUZ,V)
QUIT
+8 IF AMHLVPR=""
SET AMHR=V
QUIT
+9 IF $$PPINT^AMHUTIL(V)=AMHLVPR
SET AMHR=V
End DoDot:2
+10 QUIT
End DoDot:1
+11 QUIT
PROV ;
+1 SET AMHLVPR=""
+2 SET DIR(0)="Y"
SET DIR("A")="Do you want a particular provider's last visit"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
QUIT
+4 IF 'Y
QUIT
+5 SET DIC=200
SET DIC(0)="AEMQ"
SET DIC("B")=$PIECE(^VA(200,DUZ,0),U)
DO ^DIC
+6 IF Y=-1
GOTO PROV
+7 SET AMHLVPR=+Y
+8 QUIT
FORMAT ;
+1 SET AMHTYPE=""
+2 SET DIR(0)="S^E:Encounter Form Format;S:Standard Display"
SET DIR("A")="Select Print Format"
SET DIR("B")="E"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
QUIT
+4 SET AMHTYPE=Y
+5 IF AMHTYPE="S"
QUIT
+6 KILL AMHEFT
+7 ;W !! S DIR(0)="S^F:Full Encounter Form;S:Suppressed Encounter Form;B:Both",DIR("A")="What type of form do you want to print"
+8 ;S DIR("B")=$S($P(^AMHSITE(DUZ(2),0),U,23)]"":$P(^AMHSITE(DUZ(2),0),U,23),1:"B") K DA D ^DIR K DIR
+9 DO FORMDIR^AMHLEFP(AMHR)
+10 IF $DATA(DIRUT)
GOTO FORMAT
+11 SET AMHEFT=Y
+12 QUIT
COMP ;
+1 QUIT
