BCHUEDT ; IHS/CMI/LAB - EDIT A CHR RECORD ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
;IHS/CMI/LAB - patch 6 9/21/98 added ability to enter a
;IHS/CMI/LAB - patch 12 protected against bad narrative pointer
;registered patient on editing a record
;
;
;edit a chr record, called from protocol
;
EN ;EP
D EN^VALM2(XQORNOD(0),"OS")
I '$D(VALMY) W !,"No records selected." G XIT
S BCHR=$O(VALMY(0)) I 'BCHR K BCHR,VALMY,XQORNOD W !,"No record selected." G XIT
S BCHR=BCHVRECS("IDX",BCHR,BCHR) I 'BCHR K BCHRDEL,BCHR D PAUSE^BCHUTIL1 D XIT Q
I '$D(^BCHR(BCHR,0)) W !,"Not a valid CHR RECORD." K BCHRDEL,BCHR D PAUSE^BCHUTIL1 D XIT Q
D FULL^VALM1
DISP ;EP
D EN^BCHUDSP
S BCHUEDT=1,BCHRWDEL="" ;in edit
S BCHR0=^BCHR(BCHR,0)
S DFN=$P(BCHR0,U,4)
S BCHTYPE="" D TYPE I BCHTYPE="" D XIT Q
D RECCHECK^BCHUADD1
I $D(BCHERROR),'BCHRWDEL W !!,$C(7),$C(7),"PLEASE RE-EDIT THE RECORD AND CORRECT THIS ERROR!!!",! H 5
D XIT
Q
TYPE ; get type of data to edit
S BCHTYPE=""
W !!
S DIR(0)="SO^1:Patient Demographic Data;2:All Other Record Data",DIR("A")="EDIT Which Data Item" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
Q:Y=""
S BCHTYPE=+Y
D @BCHTYPE
Q
XIT ;eof
;do event protocol call
;S BCHEV("TYPE")="E"
;set up bchev with all pcc ptrs
;wipe out pcc ptrs in chr record
;S BCHEV("VFILES",9000010)=$P(^BCHR(BCHR,0),U,15)
;S X=0 F S X=$O(^BCHR(BCHR,31,X)) Q:X'=+X S F=$P(^BCHR(BCHR,31,X,0),U),N=$P(^(0),U,2) I F,N S BCHEV("VFILES",F,N)=""
;K ^BCHR(BCHR,31)
;D PROTOCOL^BCHUADD1
REF ;
I $G(BCHEN1) G EOJ
S VALMBCK="R"
D TERM^VALM0
D GATHER^BCHUARL
S VALMCNT=BCHRCNT
D HDR^BCHUAR
EOJ K BCHR,BCHTYPE,BCHR0,BCHERROR,BCHC,BCHRPOV,DFN,BCHX,BCHUEDT,BCHRWDEL
K BCHTYPE
Q
;
1 ;PATIENT demographic
;WILL be different depending if patient pointer or other data
I $P(^BCHR(BCHR,0),U,4)]"" D Q
.W !,"This is a REGISTERED Patient. You cannot edit any of ",$S($P(^DPT($P(^BCHR(BCHR,0),U,4),0),U,2)="M":"his",1:"her")," demographic data.",!,"You may enter a different patient if this was entered in error.",!
.S BCHODFN=DFN,DIE="^BCHR(",DA=BCHR,DR=".04" D ^DIE K DIE,DA,DR
.S DFN=$P(^BCHR(BCHR,0),U,4)
.Q:DFN=BCHODFN
.;backfill pt ptr in CHR POV
.S BCHX=0 F S BCHX=$O(^BCHRPROB("AD",BCHR,BCHX)) Q:BCHX'=+BCHX D
..S DIE="^BCHRPROB(",DA=BCHX,DR=".02////"_DFN,DITC=""
..D ^DIE
..K DIE,DA,DR,DIU,DIV,DIW,DIY,DITC
..I $D(Y) W !,"error updating pov's with patient, NOTIFY PROGRAMMER" H 5
..Q
.;backfill pt ptr in CHR EDUC
.S BCHX=0 F S BCHX=$O(^BCHRPED("AD",BCHR,BCHX)) Q:BCHX'=+BCHX D
..S DIE="^BCHRPED(",DA=BCHX,DR=".02////"_DFN,DITC=""
..D ^DIE
..K DIE,DA,DR,DIU,DIV,DIW,DIY,DITC
..I $D(Y) W !,"error updating educ's with patient, NOTIFY PROGRAMMER" H 5
..Q
.Q
;IHS/CMI/LAB - PATCH 6 ADDED THESE LINES TO ALLOW ENTRY OF A
;REGISTERED PATIENT ON EDIT
W !!,"If this is a registered patient, enter their name or chart number",!,"otherwise type an ""^"" to update a non-registered patient's data.",!! ;IHS/CMI/LAB added patch 6
S DIE="^BCHR(",DA=BCHR,DR=".04" D ^DIE K DIE,DA,DR ;IHS/CMI/LAB added patch 6
I $P(^BCHR(BCHR,0),U,4) S BCHXX=$P(^BCHR(BCHR,0),U,4) S DA=BCHR,DIE="^BCHR(",DR="1112///@;.04///@" D ^DIE K DA,DIE,DR S DIE="^BCHR(",DA=BCHR,DR=".04////"_BCHXX D ^DIE K DIE,DA,DR Q ;IF ADDED A REAL PATIENT DELETE OUT NON-REG PATIENT
S DA=BCHR,DIE=90002,DR=1112 D ^DIE K DA,DIE,DR,DIU,DIV
I $P($G(^BCHR(BCHR,11)),U,12) S (BCHXX,DA)=$P($G(^BCHR(BCHR,11)),U,12),DR="[BCH EDIT NON REG PT]",DIE="^BCHRPAT(" D ^DIE K DA,DR,DIE D
.S DA=BCHR,DIE=90002,DR="1112///@;.04///@" D ^DIE K DA,DIE,DR S DIE="^BCHR(",DA=BCHR,DR="1112////"_BCHXX D ^DIE K DIE,DA,DR
K DR,DA,DDSFILE,DIC,DIE
Q
2 ;EP - OTHER record data
W !
S DA=BCHR,DIE="^BCHR(",DR=".17////"_DT D ^DIE K DIE,DA,DIE
S DA=BCHR,DDSFILE=90002,DR=$S('$G(BCHUABFO):"[BCHE1 ENTER CHR DATA (535)]",1:"[BCHEA1 ENTER CHR DATA (535)]") D ^DDS
K DR,DA,DDSFILE,DIC,DIE
I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***" S BCHQUIT=1 K DIMSG Q
S DFN=$P(^BCHR(BCHR,0),U,4)
Q:DFN=""
;backfill pt ptr in CHR POV
S BCHX=0 F S BCHX=$O(^BCHRPROB("AD",BCHR,BCHX)) Q:BCHX'=+BCHX D
.S DIE="^BCHRPROB(",DA=BCHX,DR=".02////"_DFN,DITC=""
.D ^DIE
.K DIE,DA,DR,DIU,DIV,DIW,DIY,DITC
.I $D(Y) W !,"error updating pov's with patient, NOTIFY PROGRAMMER" H 5
.Q
;backfill pt ptr in CHR EDUC
S BCHX=0 F S BCHX=$O(^BCHRPED("AD",BCHR,BCHX)) Q:BCHX'=+BCHX D
.S DIE="^BCHRPED(",DA=BCHX,DR=".02////"_DFN,DITC=""
.D ^DIE
.K DIE,DA,DR,DIU,DIV,DIW,DIY,DITC
.I $D(Y) W !,"error updating educ's with patient, NOTIFY PROGRAMMER" H 5
.Q
Q
DISPPOVS ;
W !
S (X,BCHC)=0 F S X=$O(^BCHRPROB("AD",BCHR,X)) Q:X'=+X S BCHC=BCHC+1,BCHRPOV(BCHC)=X D
.S N=$P(^BCHRPROB(X,0),U,6) I N,$D(^AUTNPOV(N,0)) S N=$P(^AUTNPOV(N,0),U)
.W !?2,BCHC,") ",$E($P(^BCHTPROB($P(^BCHRPROB(X,0),U),0),U),1,20),?29,$E($P(^BCHTSERV($P(^BCHRPROB(X,0),U,4),0),U),1,20),?52,$P(^BCHRPROB(X,0),U,5),?57,$E(N,1,21)
.Q
Q
EPOV ;edit an existing pov
D DISPPOVS
W ! S DIR(0)="N^1:"_BCHC_":",DIR("A")="Which One do you wish to EDIT" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) Q
Q:'Y
I '$D(BCHRPOV(BCHC)) W !!,"Invalid choice." Q
S DA=BCHRPOV(Y),DIE="^BCHRPROB(",DR="[BCH EDIT POV]" D ^DIE K DIE,DA,DIU,DIV,DIY,DIW,DR
I $D(Y) W !!,"ERROR ENCOUNTERED IN EDITING A POV" Q
Q
APOV ;add a new pov
W !!,"Adding a NEW POV...",!
S DIE="^BCHR(",DR="[BCH ADD POV]",DA=BCHR D ^DIE K DIE,DA,DR,DIU,DIV,DIY,DIW
I $D(Y) W !!,"NO POV ADDED!"
Q
DPOV ;delete pov
D DISPPOVS
S DIR(0)="N^1:"_BCHC_":",DIR("A")="Which One do you wish to DELETE" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) Q
Q:'Y
I '$D(BCHRPOV(BCHC)) W !!,"Invalid choice." Q
;
S DIR(0)="Y",DIR("A")="Are you sure you want to delete this POV",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
I 'Y W !,"Okay, not deleted." Q
S DA=BCHRPOV(Y),DIK="^BCHRPROB(" D ^DIK W !,"POV DELETED" K DA,DIK Q
Q
CP ;EP - CHANGE PROVIDER
D FULL^VALM1
S BCHOPROV=BCHPROV
D GETPROV^BCHUAR
I BCHPROV="" W !!,"No provider selected." S BCHPROV=BCHOPROV D PAUSE^BCHUTIL1
S VALMBCK="R"
D TERM^VALM0
D GATHER^BCHUARL
S VALMCNT=BCHRCNT
D HDR^BCHUAR
Q
CD ;EP - CHANGE DATE
D FULL^VALM1
S BCHODATE=BCHDATE
D GETDATE^BCHUAR
I BCHDATE="" W !!,"No new date selected." S BCHDATE=BCHODATE D PAUSE^BCHUTIL1
S VALMBCK="R"
D TERM^VALM0
D GATHER^BCHUARL
S VALMCNT=BCHRCNT
D HDR^BCHUAR
Q
CF ;EP - CHANGE FORM
D FULL^VALM1
I $G(BCHUABFO) K BCHUABFO W !,"Form changed to 535 Comprehensive." G CF1
S BCHUABFO=1 W !,"Form changed to 535-1 Abbreviated."
CF1 D PAUSE^BCHUTIL1
S VALMBCK="R"
D TERM^VALM0
D GATHER^BCHUARL
S VALMCNT=BCHRCNT
D HDR^BCHUAR
Q
BCHUEDT ; IHS/CMI/LAB - EDIT A CHR RECORD ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
+2 ;IHS/CMI/LAB - patch 6 9/21/98 added ability to enter a
+3 ;IHS/CMI/LAB - patch 12 protected against bad narrative pointer
+4 ;registered patient on editing a record
+5 ;
+6 ;
+7 ;edit a chr record, called from protocol
+8 ;
EN ;EP
+1 DO EN^VALM2(XQORNOD(0),"OS")
+2 IF '$DATA(VALMY)
WRITE !,"No records selected."
GOTO XIT
+3 SET BCHR=$ORDER(VALMY(0))
IF 'BCHR
KILL BCHR,VALMY,XQORNOD
WRITE !,"No record selected."
GOTO XIT
+4 SET BCHR=BCHVRECS("IDX",BCHR,BCHR)
IF 'BCHR
KILL BCHRDEL,BCHR
DO PAUSE^BCHUTIL1
DO XIT
QUIT
+5 IF '$DATA(^BCHR(BCHR,0))
WRITE !,"Not a valid CHR RECORD."
KILL BCHRDEL,BCHR
DO PAUSE^BCHUTIL1
DO XIT
QUIT
+6 DO FULL^VALM1
DISP ;EP
+1 DO EN^BCHUDSP
+2 ;in edit
SET BCHUEDT=1
SET BCHRWDEL=""
+3 SET BCHR0=^BCHR(BCHR,0)
+4 SET DFN=$PIECE(BCHR0,U,4)
+5 SET BCHTYPE=""
DO TYPE
IF BCHTYPE=""
DO XIT
QUIT
+6 DO RECCHECK^BCHUADD1
+7 IF $DATA(BCHERROR)
IF 'BCHRWDEL
WRITE !!,$CHAR(7),$CHAR(7),"PLEASE RE-EDIT THE RECORD AND CORRECT THIS ERROR!!!",!
HANG 5
+8 DO XIT
+9 QUIT
TYPE ; get type of data to edit
+1 SET BCHTYPE=""
+2 WRITE !!
+3 SET DIR(0)="SO^1:Patient Demographic Data;2:All Other Record Data"
SET DIR("A")="EDIT Which Data Item"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
QUIT
+5 IF Y=""
QUIT
+6 SET BCHTYPE=+Y
+7 DO @BCHTYPE
+8 QUIT
XIT ;eof
+1 ;do event protocol call
+2 ;S BCHEV("TYPE")="E"
+3 ;set up bchev with all pcc ptrs
+4 ;wipe out pcc ptrs in chr record
+5 ;S BCHEV("VFILES",9000010)=$P(^BCHR(BCHR,0),U,15)
+6 ;S X=0 F S X=$O(^BCHR(BCHR,31,X)) Q:X'=+X S F=$P(^BCHR(BCHR,31,X,0),U),N=$P(^(0),U,2) I F,N S BCHEV("VFILES",F,N)=""
+7 ;K ^BCHR(BCHR,31)
+8 ;D PROTOCOL^BCHUADD1
REF ;
+1 IF $GET(BCHEN1)
GOTO EOJ
+2 SET VALMBCK="R"
+3 DO TERM^VALM0
+4 DO GATHER^BCHUARL
+5 SET VALMCNT=BCHRCNT
+6 DO HDR^BCHUAR
EOJ KILL BCHR,BCHTYPE,BCHR0,BCHERROR,BCHC,BCHRPOV,DFN,BCHX,BCHUEDT,BCHRWDEL
+1 KILL BCHTYPE
+2 QUIT
+3 ;
1 ;PATIENT demographic
+1 ;WILL be different depending if patient pointer or other data
+2 IF $PIECE(^BCHR(BCHR,0),U,4)]""
Begin DoDot:1
+3 WRITE !,"This is a REGISTERED Patient. You cannot edit any of ",$SELECT($PIECE(^DPT($PIECE(^BCHR(BCHR,0),U,4),0),U,2)="M":"his",1:"her")," demographic data.",!,"You may enter a different patient if this was entered in error.",!
+4 SET BCHODFN=DFN
SET DIE="^BCHR("
SET DA=BCHR
SET DR=".04"
DO ^DIE
KILL DIE,DA,DR
+5 SET DFN=$PIECE(^BCHR(BCHR,0),U,4)
+6 IF DFN=BCHODFN
QUIT
+7 ;backfill pt ptr in CHR POV
+8 SET BCHX=0
FOR
SET BCHX=$ORDER(^BCHRPROB("AD",BCHR,BCHX))
IF BCHX'=+BCHX
QUIT
Begin DoDot:2
+9 SET DIE="^BCHRPROB("
SET DA=BCHX
SET DR=".02////"_DFN
SET DITC=""
+10 DO ^DIE
+11 KILL DIE,DA,DR,DIU,DIV,DIW,DIY,DITC
+12 IF $DATA(Y)
WRITE !,"error updating pov's with patient, NOTIFY PROGRAMMER"
HANG 5
+13 QUIT
End DoDot:2
+14 ;backfill pt ptr in CHR EDUC
+15 SET BCHX=0
FOR
SET BCHX=$ORDER(^BCHRPED("AD",BCHR,BCHX))
IF BCHX'=+BCHX
QUIT
Begin DoDot:2
+16 SET DIE="^BCHRPED("
SET DA=BCHX
SET DR=".02////"_DFN
SET DITC=""
+17 DO ^DIE
+18 KILL DIE,DA,DR,DIU,DIV,DIW,DIY,DITC
+19 IF $DATA(Y)
WRITE !,"error updating educ's with patient, NOTIFY PROGRAMMER"
HANG 5
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
QUIT
+22 ;IHS/CMI/LAB - PATCH 6 ADDED THESE LINES TO ALLOW ENTRY OF A
+23 ;REGISTERED PATIENT ON EDIT
+24 ;IHS/CMI/LAB added patch 6
WRITE !!,"If this is a registered patient, enter their name or chart number",!,"otherwise type an ""^"" to update a non-registered patient's data.",!!
+25 ;IHS/CMI/LAB added patch 6
SET DIE="^BCHR("
SET DA=BCHR
SET DR=".04"
DO ^DIE
KILL DIE,DA,DR
+26 ;IF ADDED A REAL PATIENT DELETE OUT NON-REG PATIENT
IF $PIECE(^BCHR(BCHR,0),U,4)
SET BCHXX=$PIECE(^BCHR(BCHR,0),U,4)
SET DA=BCHR
SET DIE="^BCHR("
SET DR="1112///@;.04///@"
DO ^DIE
KILL DA,DIE,DR
SET DIE="^BCHR("
SET DA=BCHR
SET DR=".04////"_BCHXX
DO ^DIE
KILL DIE,DA,DR
QUIT
+27 SET DA=BCHR
SET DIE=90002
SET DR=1112
DO ^DIE
KILL DA,DIE,DR,DIU,DIV
+28 IF $PIECE($GET(^BCHR(BCHR,11)),U,12)
SET (BCHXX,DA)=$PIECE($GET(^BCHR(BCHR,11)),U,12)
SET DR="[BCH EDIT NON REG PT]"
SET DIE="^BCHRPAT("
DO ^DIE
KILL DA,DR,DIE
Begin DoDot:1
+29 SET DA=BCHR
SET DIE=90002
SET DR="1112///@;.04///@"
DO ^DIE
KILL DA,DIE,DR
SET DIE="^BCHR("
SET DA=BCHR
SET DR="1112////"_BCHXX
DO ^DIE
KILL DIE,DA,DR
End DoDot:1
+30 KILL DR,DA,DDSFILE,DIC,DIE
+31 QUIT
2 ;EP - OTHER record data
+1 WRITE !
+2 SET DA=BCHR
SET DIE="^BCHR("
SET DR=".17////"_DT
DO ^DIE
KILL DIE,DA,DIE
+3 SET DA=BCHR
SET DDSFILE=90002
SET DR=$SELECT('$GET(BCHUABFO):"[BCHE1 ENTER CHR DATA (535)]",1:"[BCHEA1 ENTER CHR DATA (535)]")
DO ^DDS
+4 KILL DR,DA,DDSFILE,DIC,DIE
+5 IF $DATA(DIMSG)
WRITE !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***"
SET BCHQUIT=1
KILL DIMSG
QUIT
+6 SET DFN=$PIECE(^BCHR(BCHR,0),U,4)
+7 IF DFN=""
QUIT
+8 ;backfill pt ptr in CHR POV
+9 SET BCHX=0
FOR
SET BCHX=$ORDER(^BCHRPROB("AD",BCHR,BCHX))
IF BCHX'=+BCHX
QUIT
Begin DoDot:1
+10 SET DIE="^BCHRPROB("
SET DA=BCHX
SET DR=".02////"_DFN
SET DITC=""
+11 DO ^DIE
+12 KILL DIE,DA,DR,DIU,DIV,DIW,DIY,DITC
+13 IF $DATA(Y)
WRITE !,"error updating pov's with patient, NOTIFY PROGRAMMER"
HANG 5
+14 QUIT
End DoDot:1
+15 ;backfill pt ptr in CHR EDUC
+16 SET BCHX=0
FOR
SET BCHX=$ORDER(^BCHRPED("AD",BCHR,BCHX))
IF BCHX'=+BCHX
QUIT
Begin DoDot:1
+17 SET DIE="^BCHRPED("
SET DA=BCHX
SET DR=".02////"_DFN
SET DITC=""
+18 DO ^DIE
+19 KILL DIE,DA,DR,DIU,DIV,DIW,DIY,DITC
+20 IF $DATA(Y)
WRITE !,"error updating educ's with patient, NOTIFY PROGRAMMER"
HANG 5
+21 QUIT
End DoDot:1
+22 QUIT
DISPPOVS ;
+1 WRITE !
+2 SET (X,BCHC)=0
FOR
SET X=$ORDER(^BCHRPROB("AD",BCHR,X))
IF X'=+X
QUIT
SET BCHC=BCHC+1
SET BCHRPOV(BCHC)=X
Begin DoDot:1
+3 SET N=$PIECE(^BCHRPROB(X,0),U,6)
IF N
IF $DATA(^AUTNPOV(N,0))
SET N=$PIECE(^AUTNPOV(N,0),U)
+4 WRITE !?2,BCHC,") ",$EXTRACT($PIECE(^BCHTPROB($PIECE(^BCHRPROB(X,0),U),0),U),1,20),?29,$EXTRACT($PIECE(^BCHTSERV($PIECE(^BCHRPROB(X,0),U,4),0),U),1,20),?52,$PIECE(^BCHRPROB(X,0),U,5),?57,$EXTRACT(N,1,21)
+5 QUIT
End DoDot:1
+6 QUIT
EPOV ;edit an existing pov
+1 DO DISPPOVS
+2 WRITE !
SET DIR(0)="N^1:"_BCHC_":"
SET DIR("A")="Which One do you wish to EDIT"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
QUIT
+4 IF 'Y
QUIT
+5 IF '$DATA(BCHRPOV(BCHC))
WRITE !!,"Invalid choice."
QUIT
+6 SET DA=BCHRPOV(Y)
SET DIE="^BCHRPROB("
SET DR="[BCH EDIT POV]"
DO ^DIE
KILL DIE,DA,DIU,DIV,DIY,DIW,DR
+7 IF $DATA(Y)
WRITE !!,"ERROR ENCOUNTERED IN EDITING A POV"
QUIT
+8 QUIT
APOV ;add a new pov
+1 WRITE !!,"Adding a NEW POV...",!
+2 SET DIE="^BCHR("
SET DR="[BCH ADD POV]"
SET DA=BCHR
DO ^DIE
KILL DIE,DA,DR,DIU,DIV,DIY,DIW
+3 IF $DATA(Y)
WRITE !!,"NO POV ADDED!"
+4 QUIT
DPOV ;delete pov
+1 DO DISPPOVS
+2 SET DIR(0)="N^1:"_BCHC_":"
SET DIR("A")="Which One do you wish to DELETE"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
QUIT
+4 IF 'Y
QUIT
+5 IF '$DATA(BCHRPOV(BCHC))
WRITE !!,"Invalid choice."
QUIT
+6 ;
+7 SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to delete this POV"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+8 IF $DATA(DIRUT)
QUIT
+9 IF 'Y
WRITE !,"Okay, not deleted."
QUIT
+10 SET DA=BCHRPOV(Y)
SET DIK="^BCHRPROB("
DO ^DIK
WRITE !,"POV DELETED"
KILL DA,DIK
QUIT
+11 QUIT
CP ;EP - CHANGE PROVIDER
+1 DO FULL^VALM1
+2 SET BCHOPROV=BCHPROV
+3 DO GETPROV^BCHUAR
+4 IF BCHPROV=""
WRITE !!,"No provider selected."
SET BCHPROV=BCHOPROV
DO PAUSE^BCHUTIL1
+5 SET VALMBCK="R"
+6 DO TERM^VALM0
+7 DO GATHER^BCHUARL
+8 SET VALMCNT=BCHRCNT
+9 DO HDR^BCHUAR
+10 QUIT
CD ;EP - CHANGE DATE
+1 DO FULL^VALM1
+2 SET BCHODATE=BCHDATE
+3 DO GETDATE^BCHUAR
+4 IF BCHDATE=""
WRITE !!,"No new date selected."
SET BCHDATE=BCHODATE
DO PAUSE^BCHUTIL1
+5 SET VALMBCK="R"
+6 DO TERM^VALM0
+7 DO GATHER^BCHUARL
+8 SET VALMCNT=BCHRCNT
+9 DO HDR^BCHUAR
+10 QUIT
CF ;EP - CHANGE FORM
+1 DO FULL^VALM1
+2 IF $GET(BCHUABFO)
KILL BCHUABFO
WRITE !,"Form changed to 535 Comprehensive."
GOTO CF1
+3 SET BCHUABFO=1
WRITE !,"Form changed to 535-1 Abbreviated."
CF1 DO PAUSE^BCHUTIL1
+1 SET VALMBCK="R"
+2 DO TERM^VALM0
+3 DO GATHER^BCHUARL
+4 SET VALMCNT=BCHRCNT
+5 DO HDR^BCHUAR
+6 QUIT
