AMHLEER.m

AMHLEER ; IHS/CMI/LAB - EDIT A RECORD ;

 ;;4.0;IHS BEHAVIORAL HEALTH;**2**;JUN 18, 2010;Build 23

 ;

 D GETDATE

 I AMHDATE="" W !!,"No Date entered!" D EOJ Q

 D GETLOC

 D GETPAT

 D RECLKUP

 I '$G(AMHR) D EOJ Q

 D EDIT

 D EOJ

 Q

GETDATE ; GET DATE OF ENCOUNTER

 W !

 S AMHDATE=""

 S DIR(0)="DO^:"_DT_":EPT",DIR("A")="Enter ENCOUNTER DATE" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:$D(DIRUT)

 S %DT="ET" D ^%DT G:Y<0 GETDATE

 I Y>DT W "  <Future dates not allowed>",$C(7),$C(7) K X G GETDATE

 K AMHODAT

 S AMHDATE=Y

 ;

 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,DR,DA

 Q:Y<0

 S AMHPAT=+Y

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

 Q

 ;

GETLOC ;get location of encounter

 S AMHLOC=""

 S DIC("A")="Enter LOCATION OF ENCOUNTER (if known, otherwise press ENTER): ",DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC,DA

 Q:Y<0

 S AMHLOC=+Y

 Q

EDIT ;

 S AMHPAT=$P(^AMHREC(AMHR,0),U,8)

 S AMHACTN=2

 S DIADD=1,DIE="^AMHREC(",DA=AMHR,DR="5100///NOW",DR(2,9002011.5101)=".02////^S X=DUZ" D ^DIE K DIE,DA,DR K DIADD

 S DR=$S(AMHPAT:"[AMH EDIT RECORD]",1:"[AMH ADD NON-PAT RECORD]"),DA=AMHR,DDSFILE=9002011 D ^DDS I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!!  ** NOTIFY PROGRAMMER **" S AMHQUIT=1 K DIMSG Q

 I $P(^AMHREC(AMHR,0),U,8)]"" D OTHER^AMHLEA

 S AMHERROR=0 D RECCHECK^AMHLE2 I AMHERROR D PAUSE^AMHLEA

 D PCCLINK^AMHLEA

 Q

 ;

RECLKUP ;

 D ^AMHRLKUP

 Q

EOJ ; END OF JOB

 K AMHPROV,AMHDATE,AMHPAT,AMHODAT,AMHR

 Q

TEXT ;

 ;;BH Data Entry Module

 ;;

 ;;************************

 ;;* Update BH Records *

 ;;************************

 ;;

 Q

 ;

PL ;EP - called from SDE to update the problem list

 D FULL^VALM1

 W !,"Problem List updates must be attached to a visit. If you are updating the "

 W !,"Problem List in the context of a patient visit select the appropriate existing"

 W !,"visit and then update the Problem List. If you are updating the Problem List "

 W !,"outside of the context of a patient visit, first create a chart review visit "

 W !,"and then update the Problem List."

 I AMHRCNT=0 W !,"There are no visits to select." D PAUSE^AMHLEA D XIT^AMHLEE Q

 K DIR S DIR(0)="N^1:"_AMHRCNT_":0",DIR("A")="Select record to associate the Problem List update to" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) W !,"No record selected." G XIT^AMHLEE

 S AMHR1=+Y I 'AMHR1 K VALMY,XQORNOD W !,"No record selected." G XIT^AMHLEE

 S AMHR=^TMP("AMHVRECS",$J,"IDX",AMHR1,AMHR1) I 'AMHR K AMHRDEL,AMHR D PAUSE^AMHLEA D XIT^AMHLEE Q

 I '$D(^AMHREC(AMHR,0)) W !,"Not a valid BH RECORD." K AMHRDEL,AMHR D PAUSE^AMHLEA D XIT^AMHLEE Q

DGSECDS ;

 I '$P(^AMHREC(AMHR,0),U,8) W !!,"This is not a patient visit." D PAUSE^AMHLEA,XIT^AMHLEE Q

 S AMHPAT=$P(^AMHREC(AMHR,0),U,8)

 S AMHLOC=$P(^AMHREC(AMHR,0),U,4)

 D PTSEC^AMHUTIL2(.AMHRESU,AMHPAT,1)

 I '$G(AMHRESU(1)) G PL1

 I $G(AMHRESU(1))=3!($G(AMHRESU(1))=4)!($G(AMHRESU(1))=5) D DISPDG^AMHLE,PAUSE^AMHLEA,XIT^AMHLEE Q

 D DISPDG^AMHLE

 W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to continue to select this record",DIR("B")="N" KILL DA D ^DIR KILL DIR

 I 'Y D XIT^AMHLEE Q

 K AMHRESU

 D NOTICE^DGSEC4(.AMHRESU,AMHPAT,,3)

PL1 ;

 D START^AMHBPL(AMHR)

 D XIT^AMHLEE

 Q

AMHLEER   ; IHS/CMI/LAB - EDIT A RECORD ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;**2**;JUN 18, 2010;Build 23

 +2       ;

 +3        DO GETDATE

 +4        IF AMHDATE=""

               WRITE !!,"No Date entered!"

               DO EOJ

               QUIT 

 +5        DO GETLOC

 +6        DO GETPAT

 +7        DO RECLKUP

 +8        IF '$GET(AMHR)

               DO EOJ

               QUIT 

 +9        DO EDIT

 +10       DO EOJ

 +11       QUIT 

GETDATE   ; GET DATE OF ENCOUNTER

 +1        WRITE !

 +2        SET AMHDATE=""

 +3        SET DIR(0)="DO^:"_DT_":EPT"

           SET DIR("A")="Enter ENCOUNTER DATE"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF $DATA(DIRUT)

               QUIT 

 +5        SET %DT="ET"

           DO ^%DT

           IF Y<0

               GOTO GETDATE

 +6        IF Y>DT

               WRITE "  <Future dates not allowed>",$CHAR(7),$CHAR(7)

               KILL X

               GOTO GETDATE

 +7        KILL AMHODAT

 +8        SET AMHDATE=Y

 +9       ;

 +10       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,DR,DA

 +3        IF Y<0

               QUIT 

 +4        SET AMHPAT=+Y

 +5        IF $GET(AUPNDOD)]""

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

               HANG 2

 +6        QUIT 

 +7       ;

GETLOC    ;get location of encounter

 +1        SET AMHLOC=""

 +2        SET DIC("A")="Enter LOCATION OF ENCOUNTER (if known, otherwise press ENTER): "

           SET DIC="^AUTTLOC("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC,DA

 +3        IF Y<0

               QUIT 

 +4        SET AMHLOC=+Y

 +5        QUIT 

EDIT      ;

 +1        SET AMHPAT=$PIECE(^AMHREC(AMHR,0),U,8)

 +2        SET AMHACTN=2

 +3        SET DIADD=1

           SET DIE="^AMHREC("

           SET DA=AMHR

           SET DR="5100///NOW"

           SET DR(2,9002011.5101)=".02////^S X=DUZ"

           DO ^DIE

           KILL DIE,DA,DR

           KILL DIADD

 +4        SET DR=$SELECT(AMHPAT:"[AMH EDIT RECORD]",1:"[AMH ADD NON-PAT RECORD]")

           SET DA=AMHR

           SET DDSFILE=9002011

           DO ^DDS

           IF $DATA(DIMSG)

               WRITE !!,"ERROR IN SCREENMAN FORM!!  ** NOTIFY PROGRAMMER **"

               SET AMHQUIT=1

               KILL DIMSG

               QUIT 

 +5        IF $PIECE(^AMHREC(AMHR,0),U,8)]""

               DO OTHER^AMHLEA

 +6        SET AMHERROR=0

           DO RECCHECK^AMHLE2

           IF AMHERROR

               DO PAUSE^AMHLEA

 +7        DO PCCLINK^AMHLEA

 +8        QUIT 

 +9       ;

RECLKUP   ;

 +1        DO ^AMHRLKUP

 +2        QUIT 

EOJ       ; END OF JOB

 +1        KILL AMHPROV,AMHDATE,AMHPAT,AMHODAT,AMHR

 +2        QUIT 

TEXT      ;

 +1       ;;BH Data Entry Module

 +2       ;;

 +3       ;;************************

 +4       ;;* Update BH Records *

 +5       ;;************************

 +6       ;;

 +7        QUIT 

 +8       ;

PL        ;EP - called from SDE to update the problem list

 +1        DO FULL^VALM1

 +2        WRITE !,"Problem List updates must be attached to a visit. If you are updating the "

 +3        WRITE !,"Problem List in the context of a patient visit select the appropriate existing"

 +4        WRITE !,"visit and then update the Problem List. If you are updating the Problem List "

 +5        WRITE !,"outside of the context of a patient visit, first create a chart review visit "

 +6        WRITE !,"and then update the Problem List."

 +7        IF AMHRCNT=0

               WRITE !,"There are no visits to select."

               DO PAUSE^AMHLEA

               DO XIT^AMHLEE

               QUIT 

 +8        KILL DIR

           SET DIR(0)="N^1:"_AMHRCNT_":0"

           SET DIR("A")="Select record to associate the Problem List update to"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +9        IF $DATA(DIRUT)

               WRITE !,"No record selected."

               GOTO XIT^AMHLEE

 +10       SET AMHR1=+Y

           IF 'AMHR1

               KILL VALMY,XQORNOD

               WRITE !,"No record selected."

               GOTO XIT^AMHLEE

 +11       SET AMHR=^TMP("AMHVRECS",$JOB,"IDX",AMHR1,AMHR1)

           IF 'AMHR

               KILL AMHRDEL,AMHR

               DO PAUSE^AMHLEA

               DO XIT^AMHLEE

               QUIT 

 +12       IF '$DATA(^AMHREC(AMHR,0))

               WRITE !,"Not a valid BH RECORD."

               KILL AMHRDEL,AMHR

               DO PAUSE^AMHLEA

               DO XIT^AMHLEE

               QUIT 

DGSECDS   ;

 +1        IF '$PIECE(^AMHREC(AMHR,0),U,8)

               WRITE !!,"This is not a patient visit."

               DO PAUSE^AMHLEA

               DO XIT^AMHLEE

               QUIT 

 +2        SET AMHPAT=$PIECE(^AMHREC(AMHR,0),U,8)

 +3        SET AMHLOC=$PIECE(^AMHREC(AMHR,0),U,4)

 +4        DO PTSEC^AMHUTIL2(.AMHRESU,AMHPAT,1)

 +5        IF '$GET(AMHRESU(1))

               GOTO PL1

 +6        IF $GET(AMHRESU(1))=3!($GET(AMHRESU(1))=4)!($GET(AMHRESU(1))=5)

               DO DISPDG^AMHLE

               DO PAUSE^AMHLEA

               DO XIT^AMHLEE

               QUIT 

 +7        DO DISPDG^AMHLE

 +8        WRITE !

           KILL DIR

           SET DIR(0)="Y"

           SET DIR("A")="Do you want to continue to select this record"

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +9        IF 'Y

               DO XIT^AMHLEE

               QUIT 

 +10       KILL AMHRESU

 +11       DO NOTICE^DGSEC4(.AMHRESU,AMHPAT,,3)

PL1       ;

 +1        DO START^AMHBPL(AMHR)

 +2        DO XIT^AMHLEE

 +3        QUIT