AMHLEDV ; IHS/CMI/LAB - ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
START ;
W !!,"This option has been disabled." H 4 Q
D FULL^VALM1
;D EN^AMHEKL
D ^AMHLEIN
W:$D(IOF) @IOF
W !!,"This option is used to duplicate a patient visit that occurred on a different",!,"day. The user selects a visit, enters a new date, and then the visit",!,"is copied to the new date.",!!
W !,"You must first identify the patient and the visit to duplicate.",!
GETPAT ;EP
D ^XBFMK
S AMHC=0
I $G(AMHPAT) G GETDATE
GETPAT1 W !!!?20,"TYPE THE PATIENT'S HRN, NAME, SSN OR DOB" S DIC("A")=" Patient: "
S AMHPAT=""
S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DLAYGO,DIADD
I Y<0 D XIT Q
S AMHPAT=+Y
I AMHPAT,'$$ALLOWP^AMHUTIL(DUZ,AMHPAT) D NALLOWP^AMHUTIL D PAUSE^AMHLEA G GETPAT1
I $G(AUPNDOD)]"" W !!?10,"***** PATIENT'S DATE OF DEATH IS ",$$FMTE^XLFDT(AUPNDOD),!! H 2
W !?25,"Ok" S %=1 D YN^DICN I %'=1 S AMHPAT="" K AMHC Q
GETDATE ;EP
S AMHDATE=""
S DIR(0)="DO^::EP",DIR("A")="Enter PREVIOUS DATE OF ENCOUNTER (if known, otherwise press ENTER)" KILL DA D ^DIR KILL DIR
I $D(DUOUT) D XIT Q
S AMHDATE=Y
GETPROV ;
S DIC=200,DIC(0)="AEMQ",DIC("A")="Enter PROVIDER of SERVICE: " D ^DIC K DIC,DA
I Y=-1 G GETDATE
S AMHPROV=+Y
GETVISIT ;
I '$D(^AMHREC("C",AMHPAT)) W $C(7),$C(7),!,"Patient has no visits to duplicate" D PAUSE,XIT Q
;gather visits for this provider in array AMHPATV
K AMHPATV
S AMHX=0 F S AMHX=$O(^AMHREC("C",AMHPAT,AMHX)) Q:AMHX'=+AMHX D
.I AMHDATE]"",$P($P(^AMHREC(AMHX,0),U),".")'=AMHDATE Q
.Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHX)
.I $$PPINT^AMHUTIL(AMHX)'=AMHPROV Q
.S AMHPATV(AMHX)=""
.Q
I '$D(AMHPATV) W $C(7),$C(7),!,"Patient has no visits to meeting your criteria to duplicate.",! D PAUSE,XIT Q
EN ; EP -- main entry point for AMH UPDATE ACTIVITY RECORDS
S VALMCC=1
D EN^VALM("AMH DE LIST PATIENTS VISITS")
D CLEAR^VALM1
Q
;
HDR ;EP -- header code
S VALMHDR(1)=$TR($J(" ",80)," ","-")
D GETHRN
S VALMHDR(2)="Visits for "_$P(^DPT(AMHPAT,0),U)_" HRN: "_AMHHRN
S VALMHDR(3)="Provider: "_$P(^VA(200,AMHPROV,0),U)
S VALMHDR(4)=$TR($J(" ",80)," ","-")
K AMHHRN
S VALMHDR(5)=" # PRV VISIT DATE CONTACT LOC ACT PROB NARRATIVE"
Q
;
INIT ;EP -- init variables and list array
S VALMSG="QU - Quit ?? for more actions + next screen - prev screen"
D GATHER^AMHLEDV1 ;gather up all records for display
S VALMCNT=AMHRCNT
Q
;
HELP ;EP -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K AMHRCNT,^TMP("AMHPATV",$J)
K VALMCC,VALMHDR
Q
;
XIT ;kill variables and quit
D CLEAR^VALM1
D EN^AMHEKL
K ^TMP("AMHPATV",$J)
K AMHPAT,AMHDATE,AMHPROV,AMHPATV,AMHX,AMHC,AMHNEWD,AMHR1
Q
PAUSE ;EP
S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
EXPND ; -- expand code
Q
;
GETHRN ;
S AMHHRN=""
I AMHPAT]"" D
.I $D(^AUPNPAT(AMHPAT,41,AMHPAT)) S AMHHRN=$P(^AUTTLOC(AMHPAT,0),U,7)_" "_$P(^AUPNPAT(AMHPAT,41,AMHPAT,0),U,2) Q
.I $D(^AUPNPAT(AMHPAT,41,DUZ(2))) S AMHHRN=$P(^AUTTLOC(DUZ(2),0),U,7)_" "_$P(^AUPNPAT(AMHPAT,41,DUZ(2),0),U,2) Q
.S AMHHRN="<none>"
E S AMHHRN=" -- "
Q
SELECT ;select record, get new date, confirm, duplicate
D EN^VALM2(XQORNOD(0),"OS")
I '$D(VALMY) W !,"No records selected." G XIT
S AMHR1=$O(VALMY(0)) I 'AMHR1 K AMHR1,VALMY,XQORNOD W !,"No record selected." G XIT
S AMHR1=^TMP("AMHPATV",$J,"IDX",AMHR1,AMHR1) I 'AMHR1 K AMHRDEL,AMHR1 D PAUSE D XIT Q
I '$D(^AMHREC(AMHR1,0)) W !,"Not a valid BH RECORD." K AMHRDEL,AMHR1 D PAUSE D XIT Q
D FULL^VALM1
W !,"The following visit will be duplicated:",!
W !,$TR($J(" ",80)," ","-"),! W ^TMP("AMHPATV",$J,$O(VALMY(0)),0),!!!
S AMHNEWD=""
NEWDATE ;get new date
D FULL^VALM1 W:$D(IOF) @IOF
S DIR(0)="D^::EP",DIR("A")="Enter NEW Visit Date" KILL DA D ^DIR KILL DIR
I $D(DIRUT) W !,$C(7),$C(7),"New date not entered" D BACK
S AMHNEWD=Y
DUPLICAT ;
W !,"Duplicating visit to ",$$FMTE^XLFDT(AMHNEWD)," HOLD ON..."
S AMHPTYPE=$P(^AMHREC(AMHR1,0),U,2)
S APCDOVRR=""
S AMHQUIT=0,AMHACTN=1
CREATE ;
W !,"Creating new record..." K DD,D0,DO,DINUM,DIC,DA,DR S DIC(0)="EL",DIC="^AMHREC(",DLAYGO=9002011,DIADD=1,X=AMHNEWD,DIC("DR")=".03///^S X=DT;.19////"_DUZ_";.21///^S X=DT;.22///A;.28////"_DUZ_";1111////1"
D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0
I Y=-1 W !!,$C(7),$C(7),"Behavioral Health Record is NOT complete!! Deleting Record.",! D PAUSE Q
;update multiple of user last update/date edited
S AMHR=+Y
S DIE="^AMHREC(",DA=AMHR,DR="5100///NOW",DR(2,9002011.5101)=".02////^S X=DUZ" D ^DIE K DIE,DA,DR
S DA=AMHR,DR=".08////"_AMHPAT,DIE="^AMHREC(" D CALLDIE^AMHLEIN
;set up DIE string and 4 slash
F X=2,4,5,6,7,8,9,25,26,29,31,33 S $P(^AMHREC(AMHR,0),U,X)=$P(^AMHREC(AMHR1,0),U,X)
S DA=AMHR,DIK="^AMHREC(" D IX1^DIK
POVS ;
S AMHX=0 F S AMHX=$O(^AMHRPRO("AD",AMHR1,AMHX)) Q:AMHX'=+AMHX D
.S DIC="^AMHRPRO(",X=+^AMHRPRO(AMHX,0),DIC("DR")=".02////"_AMHPAT_";.03////"_AMHR_";.04////"_$P(^AMHRPRO(AMHX,0),U,4),DIADD=1,DLAYGO=9002011.01,DIC(0)="L" K DD,DA,D0,DO D FILE^DICN K DIADD,DIC,DR,DA,DD,D0,DLAYGO
.I Y=-1 W !!,"Creating pov FAILED!" H 5 Q
;copy all povs from 1 visit to another
PROVS ;
S AMHX=0 F S AMHX=$O(^AMHRPROV("AD",AMHR1,AMHX)) Q:AMHX'=+AMHX D
.S DIC="^AMHRPROV(",X=+^AMHRPROV(AMHX,0),DIC("DR")=".02////"_AMHPAT_";.03////"_AMHR_";.04////"_$P(^AMHRPROV(AMHX,0),U,4),DIADD=1,DLAYGO=9002011.02,DIC(0)="L" K DD,DA,D0,DO D FILE^DICN K DIADD,DIC,DR,DA,DD,D0,DLAYGO
SM ;
S DA=AMHR,AMHDATE=$P(^AMHREC(AMHR,0),U),DDSFILE=9002011,DR="[AMH ADD RECORD]" D ^DDS
I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***" S AMHQUIT=1 K DIMSG Q
;CHECK RECORD
S AMHOKAY=0 D RECCHECK^AMHLE2 I AMHOKAY W !!,"Incomplete record!! Deleting record!!" D DEL^AMHLEA,EXIT Q
I $G(AMHERROR) W !!,$C(7),$C(7),"PLEASE EDIT THIS RECORD!!",!!
D OTHER^AMHLEA
D PCCLINK^AMHLE2
D XIT
Q
DISPLAY ;EP-DISPLAY AN ACTIVITY RECORD
D EN^VALM2(XQORNOD(0),"OS")
I '$D(VALMY) W !,"No records selected." G XIT
S AMHR=$O(VALMY(0)) I 'AMHR K AMHR,VALMY,XQORNOD W !,"No record selected." G XIT
S AMHR=^TMP("AMHPATV",$J,"IDX",AMHR,AMHR) I 'AMHR K AMHRDEL,AMHR D PAUSE D XIT Q
I '$D(^AMHREC(AMHR,0)) W !,"Not a valid BH RECORD." K AMHRDEL,AMHR D PAUSE D XIT Q
D FULL^VALM1
DISP ;
NEW AMHPAT,AMHPROV,AMHDATE
D ^AMHDVD
D XIT
Q
BACK ;
S VALMBCK="R"
D TERM^VALM0
D GATHER^AMHLEDV1
S VALMCNT=AMHRCNT
D HDR
K AMHNEWD
Q
EP1 ;EP
I '$G(AMHPAT) W "No patient defined." Q
D FULL^VALM1
;D EN^AMHEKL
D ^AMHLEIN
W:$D(IOF) @IOF
W !!,"This option is used to duplicate a patient visit that occurred on a different",!,"day. The user selects a visit, enters a new date, and then the visit",!,"is copied to the new date.",!!
W !,"You must first identify the patient and the visit to duplicate.",!
G GETDATE
RBLK(V,L) ;EP - right blank fill
NEW %,I
S %=$L(V),Z=L-% F I=1:1:Z S V=V_" "
Q V
LBLK(V,L) ;left blank fill
NEW %,I
S %=$L(V),Z=L-% F I=1:1:Z S V=" "_V
Q V
AMHLEDV ; IHS/CMI/LAB - ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
START ;
+1 WRITE !!,"This option has been disabled."
HANG 4
QUIT
+2 DO FULL^VALM1
+3 ;D EN^AMHEKL
+4 DO ^AMHLEIN
+5 IF $DATA(IOF)
WRITE @IOF
+6 WRITE !!,"This option is used to duplicate a patient visit that occurred on a different",!,"day. The user selects a visit, enters a new date, and then the visit",!,"is copied to the new date.",!!
+7 WRITE !,"You must first identify the patient and the visit to duplicate.",!
GETPAT ;EP
+1 DO ^XBFMK
+2 SET AMHC=0
+3 IF $GET(AMHPAT)
GOTO GETDATE
GETPAT1 WRITE !!!?20,"TYPE THE PATIENT'S HRN, NAME, SSN OR DOB"
SET DIC("A")=" Patient: "
+1 SET AMHPAT=""
+2 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA,DR,DLAYGO,DIADD
+3 IF Y<0
DO XIT
QUIT
+4 SET AMHPAT=+Y
+5 IF AMHPAT
IF '$$ALLOWP^AMHUTIL(DUZ,AMHPAT)
DO NALLOWP^AMHUTIL
DO PAUSE^AMHLEA
GOTO GETPAT1
+6 IF $GET(AUPNDOD)]""
WRITE !!?10,"***** PATIENT'S DATE OF DEATH IS ",$$FMTE^XLFDT(AUPNDOD),!!
HANG 2
+7 WRITE !?25,"Ok"
SET %=1
DO YN^DICN
IF %'=1
SET AMHPAT=""
KILL AMHC
QUIT
GETDATE ;EP
+1 SET AMHDATE=""
+2 SET DIR(0)="DO^::EP"
SET DIR("A")="Enter PREVIOUS DATE OF ENCOUNTER (if known, otherwise press ENTER)"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DUOUT)
DO XIT
QUIT
+4 SET AMHDATE=Y
GETPROV ;
+1 SET DIC=200
SET DIC(0)="AEMQ"
SET DIC("A")="Enter PROVIDER of SERVICE: "
DO ^DIC
KILL DIC,DA
+2 IF Y=-1
GOTO GETDATE
+3 SET AMHPROV=+Y
GETVISIT ;
+1 IF '$DATA(^AMHREC("C",AMHPAT))
WRITE $CHAR(7),$CHAR(7),!,"Patient has no visits to duplicate"
DO PAUSE
DO XIT
QUIT
+2 ;gather visits for this provider in array AMHPATV
+3 KILL AMHPATV
+4 SET AMHX=0
FOR
SET AMHX=$ORDER(^AMHREC("C",AMHPAT,AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+5 IF AMHDATE]""
IF $PIECE($PIECE(^AMHREC(AMHX,0),U),".")'=AMHDATE
QUIT
+6 IF '$$ALLOWVI^AMHUTIL(DUZ,AMHX)
QUIT
+7 IF $$PPINT^AMHUTIL(AMHX)'=AMHPROV
QUIT
+8 SET AMHPATV(AMHX)=""
+9 QUIT
End DoDot:1
+10 IF '$DATA(AMHPATV)
WRITE $CHAR(7),$CHAR(7),!,"Patient has no visits to meeting your criteria to duplicate.",!
DO PAUSE
DO XIT
QUIT
EN ; EP -- main entry point for AMH UPDATE ACTIVITY RECORDS
+1 SET VALMCC=1
+2 DO EN^VALM("AMH DE LIST PATIENTS VISITS")
+3 DO CLEAR^VALM1
+4 QUIT
+5 ;
HDR ;EP -- header code
+1 SET VALMHDR(1)=$TRANSLATE($JUSTIFY(" ",80)," ","-")
+2 DO GETHRN
+3 SET VALMHDR(2)="Visits for "_$PIECE(^DPT(AMHPAT,0),U)_" HRN: "_AMHHRN
+4 SET VALMHDR(3)="Provider: "_$PIECE(^VA(200,AMHPROV,0),U)
+5 SET VALMHDR(4)=$TRANSLATE($JUSTIFY(" ",80)," ","-")
+6 KILL AMHHRN
+7 SET VALMHDR(5)=" # PRV VISIT DATE CONTACT LOC ACT PROB NARRATIVE"
+8 QUIT
+9 ;
INIT ;EP -- init variables and list array
+1 SET VALMSG="QU - Quit ?? for more actions + next screen - prev screen"
+2 ;gather up all records for display
DO GATHER^AMHLEDV1
+3 SET VALMCNT=AMHRCNT
+4 QUIT
+5 ;
HELP ;EP -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL AMHRCNT,^TMP("AMHPATV",$JOB)
+2 KILL VALMCC,VALMHDR
+3 QUIT
+4 ;
XIT ;kill variables and quit
+1 DO CLEAR^VALM1
+2 DO EN^AMHEKL
+3 KILL ^TMP("AMHPATV",$JOB)
+4 KILL AMHPAT,AMHDATE,AMHPROV,AMHPATV,AMHX,AMHC,AMHNEWD,AMHR1
+5 QUIT
PAUSE ;EP
+1 SET DIR(0)="EO"
SET DIR("A")="Press enter to continue...."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 QUIT
EXPND ; -- expand code
+1 QUIT
+2 ;
GETHRN ;
+1 SET AMHHRN=""
+2 IF AMHPAT]""
Begin DoDot:1
+3 IF $DATA(^AUPNPAT(AMHPAT,41,AMHPAT))
SET AMHHRN=$PIECE(^AUTTLOC(AMHPAT,0),U,7)_" "_$PIECE(^AUPNPAT(AMHPAT,41,AMHPAT,0),U,2)
QUIT
+4 IF $DATA(^AUPNPAT(AMHPAT,41,DUZ(2)))
SET AMHHRN=$PIECE(^AUTTLOC(DUZ(2),0),U,7)_" "_$PIECE(^AUPNPAT(AMHPAT,41,DUZ(2),0),U,2)
QUIT
+5 SET AMHHRN="<none>"
End DoDot:1
+6 IF '$TEST
SET AMHHRN=" -- "
+7 QUIT
SELECT ;select record, get new date, confirm, duplicate
+1 DO EN^VALM2(XQORNOD(0),"OS")
+2 IF '$DATA(VALMY)
WRITE !,"No records selected."
GOTO XIT
+3 SET AMHR1=$ORDER(VALMY(0))
IF 'AMHR1
KILL AMHR1,VALMY,XQORNOD
WRITE !,"No record selected."
GOTO XIT
+4 SET AMHR1=^TMP("AMHPATV",$JOB,"IDX",AMHR1,AMHR1)
IF 'AMHR1
KILL AMHRDEL,AMHR1
DO PAUSE
DO XIT
QUIT
+5 IF '$DATA(^AMHREC(AMHR1,0))
WRITE !,"Not a valid BH RECORD."
KILL AMHRDEL,AMHR1
DO PAUSE
DO XIT
QUIT
+6 DO FULL^VALM1
+7 WRITE !,"The following visit will be duplicated:",!
+8 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-"),!
WRITE ^TMP("AMHPATV",$JOB,$ORDER(VALMY(0)),0),!!!
+9 SET AMHNEWD=""
NEWDATE ;get new date
+1 DO FULL^VALM1
IF $DATA(IOF)
WRITE @IOF
+2 SET DIR(0)="D^::EP"
SET DIR("A")="Enter NEW Visit Date"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
WRITE !,$CHAR(7),$CHAR(7),"New date not entered"
DO BACK
+4 SET AMHNEWD=Y
DUPLICAT ;
+1 WRITE !,"Duplicating visit to ",$$FMTE^XLFDT(AMHNEWD)," HOLD ON..."
+2 SET AMHPTYPE=$PIECE(^AMHREC(AMHR1,0),U,2)
+3 SET APCDOVRR=""
+4 SET AMHQUIT=0
SET AMHACTN=1
CREATE ;
+1 WRITE !,"Creating new record..."
KILL DD,D0,DO,DINUM,DIC,DA,DR
SET DIC(0)="EL"
SET DIC="^AMHREC("
SET DLAYGO=9002011
SET DIADD=1
SET X=AMHNEWD
SET DIC("DR")=".03///^S X=DT;.19////"_DUZ_";.21///^S X=DT;.22///A;.28////"_DUZ_";1111////1"
+2 DO FILE^DICN
KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0
+3 IF Y=-1
WRITE !!,$CHAR(7),$CHAR(7),"Behavioral Health Record is NOT complete!! Deleting Record.",!
DO PAUSE
QUIT
+4 ;update multiple of user last update/date edited
+5 SET AMHR=+Y
+6 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
+7 SET DA=AMHR
SET DR=".08////"_AMHPAT
SET DIE="^AMHREC("
DO CALLDIE^AMHLEIN
+8 ;set up DIE string and 4 slash
+9 FOR X=2,4,5,6,7,8,9,25,26,29,31,33
SET $PIECE(^AMHREC(AMHR,0),U,X)=$PIECE(^AMHREC(AMHR1,0),U,X)
+10 SET DA=AMHR
SET DIK="^AMHREC("
DO IX1^DIK
POVS ;
+1 SET AMHX=0
FOR
SET AMHX=$ORDER(^AMHRPRO("AD",AMHR1,AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+2 SET DIC="^AMHRPRO("
SET X=+^AMHRPRO(AMHX,0)
SET DIC("DR")=".02////"_AMHPAT_";.03////"_AMHR_";.04////"_$PIECE(^AMHRPRO(AMHX,0),U,4)
SET DIADD=1
SET DLAYGO=9002011.01
SET DIC(0)="L"
KILL DD,DA,D0,DO
DO FILE^DICN
KILL DIADD,DIC,DR,DA,DD,D0,DLAYGO
+3 IF Y=-1
WRITE !!,"Creating pov FAILED!"
HANG 5
QUIT
End DoDot:1
+4 ;copy all povs from 1 visit to another
PROVS ;
+1 SET AMHX=0
FOR
SET AMHX=$ORDER(^AMHRPROV("AD",AMHR1,AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+2 SET DIC="^AMHRPROV("
SET X=+^AMHRPROV(AMHX,0)
SET DIC("DR")=".02////"_AMHPAT_";.03////"_AMHR_";.04////"_$PIECE(^AMHRPROV(AMHX,0),U,4)
SET DIADD=1
SET DLAYGO=9002011.02
SET DIC(0)="L"
KILL DD,DA,D0,DO
DO FILE^DICN
KILL DIADD,DIC,DR,DA,DD,D0,DLAYGO
End DoDot:1
SM ;
+1 SET DA=AMHR
SET AMHDATE=$PIECE(^AMHREC(AMHR,0),U)
SET DDSFILE=9002011
SET DR="[AMH ADD RECORD]"
DO ^DDS
+2 IF $DATA(DIMSG)
WRITE !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***"
SET AMHQUIT=1
KILL DIMSG
QUIT
+3 ;CHECK RECORD
+4 SET AMHOKAY=0
DO RECCHECK^AMHLE2
IF AMHOKAY
WRITE !!,"Incomplete record!! Deleting record!!"
DO DEL^AMHLEA
DO EXIT
QUIT
+5 IF $GET(AMHERROR)
WRITE !!,$CHAR(7),$CHAR(7),"PLEASE EDIT THIS RECORD!!",!!
+6 DO OTHER^AMHLEA
+7 DO PCCLINK^AMHLE2
+8 DO XIT
+9 QUIT
DISPLAY ;EP-DISPLAY AN ACTIVITY RECORD
+1 DO EN^VALM2(XQORNOD(0),"OS")
+2 IF '$DATA(VALMY)
WRITE !,"No records selected."
GOTO XIT
+3 SET AMHR=$ORDER(VALMY(0))
IF 'AMHR
KILL AMHR,VALMY,XQORNOD
WRITE !,"No record selected."
GOTO XIT
+4 SET AMHR=^TMP("AMHPATV",$JOB,"IDX",AMHR,AMHR)
IF 'AMHR
KILL AMHRDEL,AMHR
DO PAUSE
DO XIT
QUIT
+5 IF '$DATA(^AMHREC(AMHR,0))
WRITE !,"Not a valid BH RECORD."
KILL AMHRDEL,AMHR
DO PAUSE
DO XIT
QUIT
+6 DO FULL^VALM1
DISP ;
+1 NEW AMHPAT,AMHPROV,AMHDATE
+2 DO ^AMHDVD
+3 DO XIT
+4 QUIT
BACK ;
+1 SET VALMBCK="R"
+2 DO TERM^VALM0
+3 DO GATHER^AMHLEDV1
+4 SET VALMCNT=AMHRCNT
+5 DO HDR
+6 KILL AMHNEWD
+7 QUIT
EP1 ;EP
+1 IF '$GET(AMHPAT)
WRITE "No patient defined."
QUIT
+2 DO FULL^VALM1
+3 ;D EN^AMHEKL
+4 DO ^AMHLEIN
+5 IF $DATA(IOF)
WRITE @IOF
+6 WRITE !!,"This option is used to duplicate a patient visit that occurred on a different",!,"day. The user selects a visit, enters a new date, and then the visit",!,"is copied to the new date.",!!
+7 WRITE !,"You must first identify the patient and the visit to duplicate.",!
+8 GOTO GETDATE
RBLK(V,L) ;EP - right blank fill
+1 NEW %,I
+2 SET %=$LENGTH(V)
SET Z=L-%
FOR I=1:1:Z
SET V=V_" "
+3 QUIT V
LBLK(V,L) ;left blank fill
+1 NEW %,I
+2 SET %=$LENGTH(V)
SET Z=L-%
FOR I=1:1:Z
SET V=" "_V
+3 QUIT V
