BCHUEDT.m

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