AMHVDISP.m

AMHVDISP ; IHS/CMI/LAB - DISPLAY VISIT ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 ;

 D GETPAT

 I AMHPAT="" W !!,"No PATIENT selected!" D EOJ Q

 D GETVISIT

 I $G(APCDVSIT)="" W !!,"No VISIT selected!" D EOJ Q

 D DSPLY

 D EOJ

 Q

 ;

GETPAT ;EP GET-  PATIENT

 W !

 S AUPNLK("INAC")=""

 S AMHPAT=""

 S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC

 Q:Y<0

 S AMHPAT=+Y

 Q

 ;

GETVISIT ;EP - this entry point called by the BVP package (View patient record)

 S AMHLOOK="",AMHVSIT="",APCDVSIT=""

 K AMHVLK

 D VLK

 I $G(APCDVSIT)="" Q

 K AMHLOOK

 Q

 ;

DSPLY ;

 D EN^APCDVD

 Q

 ;

EOJ ; EP - EOJ HOUSE KEEPING - this ep called by the BVP package (View patient record)

 K AUPNLK("INAC")

 K %,%DT,%X,%Y,C,DIYS,X,Y

 K AMHCLN,AMHCAT,AMHDATE,AMHLOC,AMHPAT,AMHVSIT,AMHLOOK,AMHTYPE,APCDVSIT

 D KILL^AUPNPAT

 Q

VLK ;

 S U="^",AMHLOOK="",APCDVSIT=""

 I $D(AMHVLK),AMHVLK S AMHLOOK=AMHVLK Q  ;*** FOR MODIFY IN ADD MODE ***

 I $D(AMHVLDT) S Y=$P(AMHVLDT,".") G VDPASSED

RDV W !,"Enter VISIT date: " R X:$S($D(DTIME):DTIME,1:300) S:'$T X="" I X=" " W $C(7),"  ??" G RDV

 Q:X=""!(X="^")

 S %DT="EX" D ^%DT

 G:X="?" RDV

 I Y<0 K Y Q

VDPASSED ; FOR CALLER PASSING VISIT DATE

 K AMHVLKT

 S AMHVLDC=Y,(AMHVLI,AMHVLV)=0 K Y

 S (AMHVLID,AMHVLL)=9999999-AMHVLDC

 F  S AMHVLL=$O(^AUPNVSIT("AA",AMHPAT,AMHVLL)) Q:AMHVLL'=+AMHVLL!($P(AMHVLL,".")'=AMHVLID)  D

 .S AMHVLV=0 F  S AMHVLV=$O(^AUPNVSIT("AA",AMHPAT,AMHVLL,AMHVLV)) Q:AMHVLV'=+AMHVLV  I $D(^AUPNVSIT(AMHVLV,0)),'$P(^(0),U,11) D

 ..Q:'$$ALLOWPCC^AMHUTIL(DUZ,AMHVLV)  ;SDE/UU

 ..S AMHVLI=AMHVLI+1,AMHVLKT(AMHVLI)=AMHVLV

 .Q

 G:'$D(AMHVLKT) XIT

 I AMHVLI=1,'$D(AMHVLDT) S APCDVSIT=AMHVLKT(1) G XIT

SELECT ; SELECT EXISTING VISIT

 W !!,"PATIENT: ",$P(^DPT(AMHPAT,0),U)," has one or more VISITs on this date.",!

 S AMHVLI="" F AMHVLL=0:0 S AMHVLI=$O(AMHVLKT(AMHVLI)) Q:AMHVLI=""  S AMHVLX=^AUPNVSIT(AMHVLKT(AMHVLI),0),AMHA11=$G(^AUPNVSIT(AMHVLKT(AMHVLI),11)) D WRITE

 S AMHVLV=""

SRDR W !!,"Select one: " R AMHVLI:$S($D(DTIME):DTIME,1:300) I '$T S AMHVLI=""

 G:AMHVLI=""!(AMHVLI="^") XIT

 I AMHVLI'?1N.N W $C(7),$C(7) G SELECT

 I '$D(AMHVLKT(AMHVLI)) W $C(7),$C(7) G SELECT

 S APCDVSIT=AMHVLKT(AMHVLI)

 G XIT

 ;

WRITE ; WRITE VISITS FOR SELECT

 S AMHVLT=$P(+AMHVLX,".",2),AMHVLT=$S(AMHVLT="":"<NONE>",$L(AMHVLT)=1:AMHVLT_"0:00 ",1:$E(AMHVLT,1,2)_":"_$E(AMHVLT,3,4)_$E("00",1,2-$L($E(AMHVLT,3,4)))_" ")

 S AMHVLOC=""

 I $P(AMHVLX,U,6),$D(^AUTTLOC($P(AMHVLX,U,6),0)) S AMHVLOC=$P(^(0),U,7),AMHVLOC=AMHVLOC_$E("    ",1,4-$L(AMHVLOC))

 S:AMHVLOC="" AMHVLOC="...."

 W !,AMHVLI,"  TIME: ",AMHVLT,"LOC: ",AMHVLOC," TYPE: ",$P(AMHVLX,U,3)," CAT: ",$P(AMHVLX,U,7)," CLINIC: ",$S($P(AMHVLX,U,8)]"":$E($P(^DIC(40.7,$P(AMHVLX,U,8),0),U),1,8),1:"<NONE>") D

 .W ?57,"DEC: ",$S($P(AMHVLX,U,9):$P(AMHVLX,U,9),1:0),$S($P(AMHA11,U,3)]"":" VCN:"_$P(AMHA11,U,3),1:"")

 .I $P(AMHVLX,U,22) W !?3,"Hospital Location: ",$P($G(^SC($P(AMHVLX,U,22),0)),U)

 .I $$PRIMPROV^APCLV(AMHVLKT(AMHVLI))]"" W !?3,"Primary Provider: ",$$PRIMPROV^APCLV(AMHVLKT(AMHVLI),"N")

 K AMHVLT,AMHVLOC

 Q

 ;

XIT ; KILL VARIABLES AND QUIT

 ;S APCDVSIT=AMHLOOK

 K AMHVLDC,AMHVLDT,AMHVLI,AMHVLKT,AMHVLL,AMHVLOC,AMHVLT,AMHVLV,AMHVLX,Y,AMHA11,AMHVLID

 Q

AMHVDISP  ; IHS/CMI/LAB - DISPLAY VISIT ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;

 +3        DO GETPAT

 +4        IF AMHPAT=""

               WRITE !!,"No PATIENT selected!"

               DO EOJ

               QUIT 

 +5        DO GETVISIT

 +6        IF $GET(APCDVSIT)=""

               WRITE !!,"No VISIT selected!"

               DO EOJ

               QUIT 

 +7        DO DSPLY

 +8        DO EOJ

 +9        QUIT 

 +10      ;

GETPAT    ;EP GET-  PATIENT

 +1        WRITE !

 +2        SET AUPNLK("INAC")=""

 +3        SET AMHPAT=""

 +4        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +5        IF Y<0

               QUIT 

 +6        SET AMHPAT=+Y

 +7        QUIT 

 +8       ;

GETVISIT  ;EP - this entry point called by the BVP package (View patient record)

 +1        SET AMHLOOK=""

           SET AMHVSIT=""

           SET APCDVSIT=""

 +2        KILL AMHVLK

 +3        DO VLK

 +4        IF $GET(APCDVSIT)=""

               QUIT 

 +5        KILL AMHLOOK

 +6        QUIT 

 +7       ;

DSPLY     ;

 +1        DO EN^APCDVD

 +2        QUIT 

 +3       ;

EOJ       ; EP - EOJ HOUSE KEEPING - this ep called by the BVP package (View patient record)

 +1        KILL AUPNLK("INAC")

 +2        KILL %,%DT,%X,%Y,C,DIYS,X,Y

 +3        KILL AMHCLN,AMHCAT,AMHDATE,AMHLOC,AMHPAT,AMHVSIT,AMHLOOK,AMHTYPE,APCDVSIT

 +4        DO KILL^AUPNPAT

 +5        QUIT 

VLK       ;

 +1        SET U="^"

           SET AMHLOOK=""

           SET APCDVSIT=""

 +2       ;*** FOR MODIFY IN ADD MODE ***

           IF $DATA(AMHVLK)

               IF AMHVLK

                   SET AMHLOOK=AMHVLK

                   QUIT 

 +3        IF $DATA(AMHVLDT)

               SET Y=$PIECE(AMHVLDT,".")

               GOTO VDPASSED

RDV        WRITE !,"Enter VISIT date: "

           READ X:$SELECT($DATA(DTIME):DTIME,1:300)

           IF '$TEST

               SET X=""

           IF X=" "

               WRITE $CHAR(7),"  ??"

               GOTO RDV

 +1        IF X=""!(X="^")

               QUIT 

 +2        SET %DT="EX"

           DO ^%DT

 +3        IF X="?"

               GOTO RDV

 +4        IF Y<0

               KILL Y

               QUIT 

VDPASSED  ; FOR CALLER PASSING VISIT DATE

 +1        KILL AMHVLKT

 +2        SET AMHVLDC=Y

           SET (AMHVLI,AMHVLV)=0

           KILL Y

 +3        SET (AMHVLID,AMHVLL)=9999999-AMHVLDC

 +4        FOR 

               SET AMHVLL=$ORDER(^AUPNVSIT("AA",AMHPAT,AMHVLL))

               IF AMHVLL'=+AMHVLL!($PIECE(AMHVLL,".")'=AMHVLID)

                   QUIT 

               Begin DoDot:1

 +5                SET AMHVLV=0

                   FOR 

                       SET AMHVLV=$ORDER(^AUPNVSIT("AA",AMHPAT,AMHVLL,AMHVLV))

                       IF AMHVLV'=+AMHVLV

                           QUIT 

                       IF $DATA(^AUPNVSIT(AMHVLV,0))

                           IF '$PIECE(^(0),U,11)

                               Begin DoDot:2

 +6       ;SDE/UU

                                   IF '$$ALLOWPCC^AMHUTIL(DUZ,AMHVLV)

                                       QUIT 

 +7                                SET AMHVLI=AMHVLI+1

                                   SET AMHVLKT(AMHVLI)=AMHVLV

                               End DoDot:2

 +8                QUIT 

               End DoDot:1

 +9        IF '$DATA(AMHVLKT)

               GOTO XIT

 +10       IF AMHVLI=1

               IF '$DATA(AMHVLDT)

                   SET APCDVSIT=AMHVLKT(1)

                   GOTO XIT

SELECT    ; SELECT EXISTING VISIT

 +1        WRITE !!,"PATIENT: ",$PIECE(^DPT(AMHPAT,0),U)," has one or more VISITs on this date.",!

 +2        SET AMHVLI=""

           FOR AMHVLL=0:0

               SET AMHVLI=$ORDER(AMHVLKT(AMHVLI))

               IF AMHVLI=""

                   QUIT 

               SET AMHVLX=^AUPNVSIT(AMHVLKT(AMHVLI),0)

               SET AMHA11=$GET(^AUPNVSIT(AMHVLKT(AMHVLI),11))

               DO WRITE

 +3        SET AMHVLV=""

SRDR       WRITE !!,"Select one: "

           READ AMHVLI:$SELECT($DATA(DTIME):DTIME,1:300)

           IF '$TEST

               SET AMHVLI=""

 +1        IF AMHVLI=""!(AMHVLI="^")

               GOTO XIT

 +2        IF AMHVLI'?1N.N

               WRITE $CHAR(7),$CHAR(7)

               GOTO SELECT

 +3        IF '$DATA(AMHVLKT(AMHVLI))

               WRITE $CHAR(7),$CHAR(7)

               GOTO SELECT

 +4        SET APCDVSIT=AMHVLKT(AMHVLI)

 +5        GOTO XIT

 +6       ;

WRITE     ; WRITE VISITS FOR SELECT

 +1        SET AMHVLT=$PIECE(+AMHVLX,".",2)

           SET AMHVLT=$SELECT(AMHVLT="":"<NONE>",$LENGTH(AMHVLT)=1:AMHVLT_"0:00 ",1:$EXTRACT(AMHVLT,1,2)_":"_$EXTRACT(AMHVLT,3,4)_$EXTRACT("00",1,2-$LENGTH($EXTRACT(AMHVLT,3,4)))_" ")

 +2        SET AMHVLOC=""

 +3        IF $PIECE(AMHVLX,U,6)

               IF $DATA(^AUTTLOC($PIECE(AMHVLX,U,6),0))

                   SET AMHVLOC=$PIECE(^(0),U,7)

                   SET AMHVLOC=AMHVLOC_$EXTRACT("    ",1,4-$LENGTH(AMHVLOC))

 +4        IF AMHVLOC=""

               SET AMHVLOC="...."

 +5        WRITE !,AMHVLI,"  TIME: ",AMHVLT,"LOC: ",AMHVLOC," TYPE: ",$PIECE(AMHVLX,U,3)," CAT: ",$PIECE(AMHVLX,U,7)," CLINIC: ",$SELECT($PIECE(AMHVLX,U,8)]"":$EXTRACT($PIECE(^DIC(40.7,$PIECE(AMHVLX,U,8),0),U),1,8),1:"<NONE>")

           Begin DoDot:1

 +6            WRITE ?57,"DEC: ",$SELECT">SELECT($PIECE(AMHVLX,U,9):$PIECE(AMHVLX,U,9),1:0),$SELECT">SELECT($PIECE(AMHA11,U,3)]"":" VCN:"_$PIECE(AMHA11,U,3),1:"")

 +7            IF $PIECE(AMHVLX,U,22)

                   WRITE !?3,"Hospital Location: ",$PIECE($GET(^SC($PIECE(AMHVLX,U,22),0)),U)

 +8            IF $$PRIMPROV^APCLV(AMHVLKT(AMHVLI))]""

                   WRITE !?3,"Primary Provider: ",$$PRIMPROV^APCLV(AMHVLKT(AMHVLI),"N")

           End DoDot:1

 +9        KILL AMHVLT,AMHVLOC

 +10       QUIT 

 +11      ;

XIT       ; KILL VARIABLES AND QUIT

 +1       ;S APCDVSIT=AMHLOOK

 +2        KILL AMHVLDC,AMHVLDT,AMHVLI,AMHVLKT,AMHVLL,AMHVLOC,AMHVLT,AMHVLV,AMHVLX,Y,AMHA11,AMHVLID

 +3        QUIT