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
