AMHLELV.m

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