BCHEGP1 ; IHS/CMI/LAB - GROUP FORM DATA ENTRY CREATE RECORD ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
;
;PATCH #16 Populates all Travel Time to one patient
;rather than deviding among all pts in group
;
;loop and get patients until BCHNUM
START ;EP - called from BCHLEGP
S (BCHQUIT,BCHHIT)=0
START1 ;
F BCHLEGPI=1:1 D PROCESS Q:$G(BCHQUIT) Q:BCHHIT=BCHNUM
I BCHNUM'=BCHHIT D ERROR I 'BCHSTOP G START1
D EXIT
Q
PROCESS ;
S DFN="",BCHNRPAT=""
D GETPAT
Q
GETPAT ;
W !
;W:$D(IOF) @IOF
W !!?15,"****** P A T I E N T I N F O R M A T I O N ******",!!
W !,"If this encounter involved a particular patient, please enter the patient's",!,"chart # or name now. If this is not a single patient encounter,",!,"but a group encounter, simply HIT the RETURN key to continue.",!
W !,"Please enter the patient information now.",!
S DFN=""
S DIR(0)="FO^1:30",DIR("A")="Enter PATIENT NAME or CHART #"
S DIR("?",1)=" To find a patient, you can enter the patient's chart number;"
S DIR("?",2)=" lastname,firstname; SSN; or DOB."
S DIR("?",3)=" "
S DIR("?",4)=" If the patient cannot be found in the Patient Registration"
S DIR("?",5)=" database and you would like to capture demographic information"
S DIR("?",6)=" for this patient into the CHR database, answer NO when asked"
S DIR("?",7)=" if you would like to try another lookup. You will then be"
S DIR("?",8)=" given the opportunity to capture the patient's demographic"
S DIR("?",9)=" data on the following screen."
S DIR("?",10)=""
S DIR("?",11)=" Registered patient demographic data can only be edit via the"
S DIR("?")=" Patient Registration system."
W !,"So far you have entered ",BCHHIT," patient records out of a total of ",BCHNUM,".",!
I BCHHIT W "You have entered records for: " D W !!
.S X=0 F S X=$O(^BCHGROUP(BCHFID,21,X)) Q:X'=+X W !?5,$P($G(^BCHR(X,11)),U)
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !!,"No patient entered!! - Required",! G GETPAT
I $D(DIRUT) W !,"No patient entered!! - Required." S BCHQUIT=1 Q
S (X,BCHNAME)=Y,DIC="^AUPNPAT(",DIC(0)="MQE" D ^DIC K DIC
I Y=-1 D NOREG Q
W !?25,"Ok" S %=1 D YN^DICN I %'=1 W !!,"Try again.",! G GETPAT
S DFN=+Y
D GENREC
Q
;
NOREG ;
S DFN=""
K BCHAGAIN
W !,"That patient cannot be found in the Registration database."
W ! S DIR(0)="Y",DIR("A")="Do you want to try to lookup the patient in registration again",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) W !,"Exiting..." S BCHQUIT=1 Q
I Y G GETPAT
W !!,"Please select a patient from the Non-Registered Patient Database",!,"or enter a new Non-Registered Patient.",!
S DIC="^BCHRPAT(",DIC(0)="AEMQL" D ^DIC K DIC
;SCREENMAN CALL
;S DIE="^BCHR(",DA=BCHR,DR="1101///"_BCHNAME D ^DIE K DIE,DR,DA,DIU,DIV,DIW
;S DA=BCHR,DDSFILE=90002,DR="[BCH ENTER PATIENT DATA]" D ^DDS
;K DR,DA,DDSFILE,DIC,DIE
;I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***" S BCHQUIT=1 K DIMSG Q
;Q:$G(^BCHR(BCHR,11))]""
I Y=-1 W !!,"A patient is Required" G GETPAT
S BCHNRPAT=+Y
I $P(Y,U,3) D I 1
.W !!,"Please review and update if necessary this non-registered patient's data:"
.S DIE="^BCHRPAT(",DR="[BCH EDIT NON REG PT]",DA=BCHNRPAT D ^DIE K DA,DIE,DR
E D
.W !!,"You now have the opportunity to update this patient's demographic data,"
.W !,"(DOB, Gender, Community of Residene, Tribe)",!
.S DIR(0)="Y",DIR("A")="Do you want to update this patient's demographic information?",DIR("B")="N" KILL DA D ^DIR KILL DIR
.I 'Y Q
.I $D(DIRUT) Q
.S DIE="^BCHRPAT(",DR="[BCH EDIT NON REG PT]",DA=BCHNRPAT D ^DIE K DA,DIE,DR
D GENREC
Q
GENREC ;create CHR record
S BCHEV("TYPE")="A"
D ^XBFMK
S APCDOVRR=1
S BCHOVRR=1
W !!,"Creating new record for ",$S(DFN:$P(^DPT(DFN,0),U),1:$P(^BCHRPAT(BCHNRPAT,0),U,1)),"."
;I 'DFN W !!,"Creating CHR record."
K DD,D0,DO,DIC,DA,DR S DIC(0)="EL",DIC="^BCHR(",DLAYGO=90002,DIADD=1,X=$P(^BCHGROUP(BCHFID,0),U,4)
S BCHG0=^BCHGROUP(BCHFID,0)
S DIC("DR")=".02////"_$P(BCHG0,U,2)_";.03////"_$P(BCHG0,U,3)_";.04////"_$G(DFN)_";.05////"_$P(BCHG0,U,5)_";.06////"_$P(BCHG0,U,6)_";.12///1"
S DIC("DR")=DIC("DR")_";.16////"_DUZ_";.17////"_DT_";.22////"_DT_";.26////H;.29///1"
S DIC("DR")=DIC("DR")_";.11////"_$S(BCHHIT=1:$P(BCHG0,U,11),1:0) ;IHS/CMI/TMJ PATCH #16 Travel time to one patient
D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0
I Y=-1 W !!,$C(7),$C(7),"ERROR generating CHR record!! Deleting Record.",! D ^XBFMK Q
S BCHR=+Y
I BCHNRPAT S DA=BCHR,DIE=90002,DR="1112////"_BCHNRPAT D ^DIE K DIE,DA,DR
POV ;create pov records
S BCHOVRR=1
S BCHX=0 F S BCHX=$O(^BCHRGAS("AD",BCHFID,BCHX)) Q:BCHX'=+BCHX D
.S BCHG0=^BCHRGAS(BCHX,0)
.D ^XBFMK
.S BCHPOVM=$P(BCHG0,U,5)/BCHNUM S BCHPOVM=(BCHPOVM+.5)\1
.K DD,D0,DO,DIC,DA,DR S DIC="^BCHRPROB(",DIC(0)="EL",DLAYGO=90002.01,DIADD=1,X=$P(BCHG0,U)
.S DIC("DR")=".02////"_$G(DFN)_";.03////"_BCHR_";.04////"_$P(BCHG0,U,4)_";.05///"_BCHPOVM_";.06////"_$P(BCHG0,U,6)
.D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,DO
.I Y<0 W !!,"Creating pov record failed.!! Notify PROGRAMMER!",!!
D ^XBFMK
;M ^BCHR(BCHR,51)=^BCHGROUP(BCHFID,51)
;M ^BCHR(BCHR,61)=^BCHGROUP(BCHFID,61)
;M ^BCHR(BCHR,71)=^BCHGROUP(BCHFID,71)
SOAP ;
;W ! S DIE="^BCHR(",DR="5101;6101;7101",DA=BCHR D ^DIE D ^XBFMK
D GETMEAS
EDITR ;
S DIR(0)="Y",DIR("A")="Do you wish to edit anything in this record",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y D EDIT
;DO PCC LINK
D PROTOCOL^BCHUADD1
S BCHHIT=BCHHIT+1
;update 2101 multiple
D ^XBFMK K DIADD,DLAYGO
S DIC="^BCHGROUP("_BCHFID_",21,",DIC(0)="L",DIC("P")=$P(^DD(90002.97,2101,0),U,2),DA(1)=BCHFID,X="`"_BCHR D ^DIC
I Y=-1 W !!,"adding visit to group file entry failed. Notify supervisor." H 2
D ^XBFMK K DIADD,DLAYGO
Q
GETMEAS ;
I '$G(DFN),'$G(^BCHR(BCHR,11))="" Q ;no patient so no measurements
W !
S DIR(0)="Y",DIR("A")=$S('$G(BCHUABFO):"Any MEASUREMENTS, TESTS or REPRODUCTIVE FACTORS",1:"Any MEASUREMENTS/TESTS"),DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
Q:'Y
S DA=BCHR,DDSFILE=90002,DR="[BCH ENTER MEASUREMENTS/TESTS" D ^DDS
I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***" S BCHQUIT=1 K DIMSG D ^XBFMK Q
D ^XBFMK
Q
EDIT ;
W !
S DA=BCHR,DDSFILE=90002,DR="[BCH EDIT RECORD DATA]" 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 BCHPAT=$P(^BCHR(BCHR,0),U,4)
Q:BCHPAT=""
;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////"_BCHPAT,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////"_BCHPAT,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
EXIT ;clean up and exit
K DIC,DR,DA,X,Y,DIU,DIU,D0,DO,DI
K BCHHIT,BCHX
K DIR,X,Y,DIC,DR,DA,D0,DO,DIZ,D
Q
ERROR ;
W !!,$C(7),$C(7),"You have NOT completed entry of all of the ",BCHNUM," patients!!"
W !,"This means that you MUST enter each of the remaining visits individually,",!,"using ",($P(^BCHGROUP(BCHFID,0),U,11)\BCHNUM)," minutes activity time for each patient.",!!!
;really want to quit?
K DIR S DIR(0)="Y",DIR("A")="Are you sure you wish to stop",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) S BCHSTOP=1 Q
I Y S BCHSTOP=1 Q
S BCHSTOP=0
Q
PAUSE ;
S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
DEL ;
S DIK="^BCHR(",DA=BCHR D ^DIK K DA,DIK
W !,"Record deleted."
D PAUSE
Q
BCHEGP1 ; IHS/CMI/LAB - GROUP FORM DATA ENTRY CREATE RECORD ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
+2 ;
+3 ;PATCH #16 Populates all Travel Time to one patient
+4 ;rather than deviding among all pts in group
+5 ;
+6 ;loop and get patients until BCHNUM
START ;EP - called from BCHLEGP
+1 SET (BCHQUIT,BCHHIT)=0
START1 ;
+1 FOR BCHLEGPI=1:1
DO PROCESS
IF $GET(BCHQUIT)
QUIT
IF BCHHIT=BCHNUM
QUIT
+2 IF BCHNUM'=BCHHIT
DO ERROR
IF 'BCHSTOP
GOTO START1
+3 DO EXIT
+4 QUIT
PROCESS ;
+1 SET DFN=""
SET BCHNRPAT=""
+2 DO GETPAT
+3 QUIT
GETPAT ;
+1 WRITE !
+2 ;W:$D(IOF) @IOF
+3 WRITE !!?15,"****** P A T I E N T I N F O R M A T I O N ******",!!
+4 WRITE !,"If this encounter involved a particular patient, please enter the patient's",!,"chart # or name now. If this is not a single patient encounter,",!,"but a group encounter, simply HIT the RETURN key to continue.",!
+5 WRITE !,"Please enter the patient information now.",!
+6 SET DFN=""
+7 SET DIR(0)="FO^1:30"
SET DIR("A")="Enter PATIENT NAME or CHART #"
+8 SET DIR("?",1)=" To find a patient, you can enter the patient's chart number;"
+9 SET DIR("?",2)=" lastname,firstname; SSN; or DOB."
+10 SET DIR("?",3)=" "
+11 SET DIR("?",4)=" If the patient cannot be found in the Patient Registration"
+12 SET DIR("?",5)=" database and you would like to capture demographic information"
+13 SET DIR("?",6)=" for this patient into the CHR database, answer NO when asked"
+14 SET DIR("?",7)=" if you would like to try another lookup. You will then be"
+15 SET DIR("?",8)=" given the opportunity to capture the patient's demographic"
+16 SET DIR("?",9)=" data on the following screen."
+17 SET DIR("?",10)=""
+18 SET DIR("?",11)=" Registered patient demographic data can only be edit via the"
+19 SET DIR("?")=" Patient Registration system."
+20 WRITE !,"So far you have entered ",BCHHIT," patient records out of a total of ",BCHNUM,".",!
+21 IF BCHHIT
WRITE "You have entered records for: "
Begin DoDot:1
+22 SET X=0
FOR
SET X=$ORDER(^BCHGROUP(BCHFID,21,X))
IF X'=+X
QUIT
WRITE !?5,$PIECE($GET(^BCHR(X,11)),U)
End DoDot:1
WRITE !!
+23 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+24 IF Y=""
WRITE !!,"No patient entered!! - Required",!
GOTO GETPAT
+25 IF $DATA(DIRUT)
WRITE !,"No patient entered!! - Required."
SET BCHQUIT=1
QUIT
+26 SET (X,BCHNAME)=Y
SET DIC="^AUPNPAT("
SET DIC(0)="MQE"
DO ^DIC
KILL DIC
+27 IF Y=-1
DO NOREG
QUIT
+28 WRITE !?25,"Ok"
SET %=1
DO YN^DICN
IF %'=1
WRITE !!,"Try again.",!
GOTO GETPAT
+29 SET DFN=+Y
+30 DO GENREC
+31 QUIT
+32 ;
NOREG ;
+1 SET DFN=""
+2 KILL BCHAGAIN
+3 WRITE !,"That patient cannot be found in the Registration database."
+4 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Do you want to try to lookup the patient in registration again"
SET DIR("B")="Y"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF $DATA(DIRUT)
WRITE !,"Exiting..."
SET BCHQUIT=1
QUIT
+6 IF Y
GOTO GETPAT
+7 WRITE !!,"Please select a patient from the Non-Registered Patient Database",!,"or enter a new Non-Registered Patient.",!
+8 SET DIC="^BCHRPAT("
SET DIC(0)="AEMQL"
DO ^DIC
KILL DIC
+9 ;SCREENMAN CALL
+10 ;S DIE="^BCHR(",DA=BCHR,DR="1101///"_BCHNAME D ^DIE K DIE,DR,DA,DIU,DIV,DIW
+11 ;S DA=BCHR,DDSFILE=90002,DR="[BCH ENTER PATIENT DATA]" D ^DDS
+12 ;K DR,DA,DDSFILE,DIC,DIE
+13 ;I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***" S BCHQUIT=1 K DIMSG Q
+14 ;Q:$G(^BCHR(BCHR,11))]""
+15 IF Y=-1
WRITE !!,"A patient is Required"
GOTO GETPAT
+16 SET BCHNRPAT=+Y
+17 IF $PIECE(Y,U,3)
Begin DoDot:1
+18 WRITE !!,"Please review and update if necessary this non-registered patient's data:"
+19 SET DIE="^BCHRPAT("
SET DR="[BCH EDIT NON REG PT]"
SET DA=BCHNRPAT
DO ^DIE
KILL DA,DIE,DR
End DoDot:1
IF 1
+20 IF '$TEST
Begin DoDot:1
+21 WRITE !!,"You now have the opportunity to update this patient's demographic data,"
+22 WRITE !,"(DOB, Gender, Community of Residene, Tribe)",!
+23 SET DIR(0)="Y"
SET DIR("A")="Do you want to update this patient's demographic information?"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+24 IF 'Y
QUIT
+25 IF $DATA(DIRUT)
QUIT
+26 SET DIE="^BCHRPAT("
SET DR="[BCH EDIT NON REG PT]"
SET DA=BCHNRPAT
DO ^DIE
KILL DA,DIE,DR
End DoDot:1
+27 DO GENREC
+28 QUIT
GENREC ;create CHR record
+1 SET BCHEV("TYPE")="A"
+2 DO ^XBFMK
+3 SET APCDOVRR=1
+4 SET BCHOVRR=1
+5 WRITE !!,"Creating new record for ",$SELECT(DFN:$PIECE(^DPT(DFN,0),U),1:$PIECE(^BCHRPAT(BCHNRPAT,0),U,1)),"."
+6 ;I 'DFN W !!,"Creating CHR record."
+7 KILL DD,D0,DO,DIC,DA,DR
SET DIC(0)="EL"
SET DIC="^BCHR("
SET DLAYGO=90002
SET DIADD=1
SET X=$PIECE(^BCHGROUP(BCHFID,0),U,4)
+8 SET BCHG0=^BCHGROUP(BCHFID,0)
+9 SET DIC("DR")=".02////"_$PIECE(BCHG0,U,2)_";.03////"_$PIECE(BCHG0,U,3)_";.04////"_$GET(DFN)_";.05////"_$PIECE(BCHG0,U,5)_";.06////"_$PIECE(BCHG0,U,6)_";.12///1"
+10 SET DIC("DR")=DIC("DR")_";.16////"_DUZ_";.17////"_DT_";.22////"_DT_";.26////H;.29///1"
+11 ;IHS/CMI/TMJ PATCH #16 Travel time to one patient
SET DIC("DR")=DIC("DR")_";.11////"_$SELECT(BCHHIT=1:$PIECE(BCHG0,U,11),1:0)
+12 DO FILE^DICN
KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0
+13 IF Y=-1
WRITE !!,$CHAR(7),$CHAR(7),"ERROR generating CHR record!! Deleting Record.",!
DO ^XBFMK
QUIT
+14 SET BCHR=+Y
+15 IF BCHNRPAT
SET DA=BCHR
SET DIE=90002
SET DR="1112////"_BCHNRPAT
DO ^DIE
KILL DIE,DA,DR
POV ;create pov records
+1 SET BCHOVRR=1
+2 SET BCHX=0
FOR
SET BCHX=$ORDER(^BCHRGAS("AD",BCHFID,BCHX))
IF BCHX'=+BCHX
QUIT
Begin DoDot:1
+3 SET BCHG0=^BCHRGAS(BCHX,0)
+4 DO ^XBFMK
+5 SET BCHPOVM=$PIECE(BCHG0,U,5)/BCHNUM
SET BCHPOVM=(BCHPOVM+.5)\1
+6 KILL DD,D0,DO,DIC,DA,DR
SET DIC="^BCHRPROB("
SET DIC(0)="EL"
SET DLAYGO=90002.01
SET DIADD=1
SET X=$PIECE(BCHG0,U)
+7 SET DIC("DR")=".02////"_$GET(DFN)_";.03////"_BCHR_";.04////"_$PIECE(BCHG0,U,4)_";.05///"_BCHPOVM_";.06////"_$PIECE(BCHG0,U,6)
+8 DO FILE^DICN
KILL DIC,DR,DIE,DIADD,DLAYGO,X,DO
+9 IF Y<0
WRITE !!,"Creating pov record failed.!! Notify PROGRAMMER!",!!
End DoDot:1
+10 DO ^XBFMK
+11 ;M ^BCHR(BCHR,51)=^BCHGROUP(BCHFID,51)
+12 ;M ^BCHR(BCHR,61)=^BCHGROUP(BCHFID,61)
+13 ;M ^BCHR(BCHR,71)=^BCHGROUP(BCHFID,71)
SOAP ;
+1 ;W ! S DIE="^BCHR(",DR="5101;6101;7101",DA=BCHR D ^DIE D ^XBFMK
+2 DO GETMEAS
EDITR ;
+1 SET DIR(0)="Y"
SET DIR("A")="Do you wish to edit anything in this record"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF Y
DO EDIT
+3 ;DO PCC LINK
+4 DO PROTOCOL^BCHUADD1
+5 SET BCHHIT=BCHHIT+1
+6 ;update 2101 multiple
+7 DO ^XBFMK
KILL DIADD,DLAYGO
+8 SET DIC="^BCHGROUP("_BCHFID_",21,"
SET DIC(0)="L"
SET DIC("P")=$PIECE(^DD(90002.97,2101,0),U,2)
SET DA(1)=BCHFID
SET X="`"_BCHR
DO ^DIC
+9 IF Y=-1
WRITE !!,"adding visit to group file entry failed. Notify supervisor."
HANG 2
+10 DO ^XBFMK
KILL DIADD,DLAYGO
+11 QUIT
GETMEAS ;
+1 ;no patient so no measurements
IF '$GET(DFN)
IF '$GET(^BCHR(BCHR,11))=""
QUIT
+2 WRITE !
+3 SET DIR(0)="Y"
SET DIR("A")=$SELECT('$GET(BCHUABFO):"Any MEASUREMENTS, TESTS or REPRODUCTIVE FACTORS",1:"Any MEASUREMENTS/TESTS")
SET DIR("B")="Y"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
QUIT
+5 IF 'Y
QUIT
+6 SET DA=BCHR
SET DDSFILE=90002
SET DR="[BCH ENTER MEASUREMENTS/TESTS"
DO ^DDS
+7 IF $DATA(DIMSG)
WRITE !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***"
SET BCHQUIT=1
KILL DIMSG
DO ^XBFMK
QUIT
+8 DO ^XBFMK
+9 QUIT
EDIT ;
+1 WRITE !
+2 SET DA=BCHR
SET DDSFILE=90002
SET DR="[BCH EDIT RECORD DATA]"
DO ^DDS
+3 KILL DR,DA,DDSFILE,DIC,DIE
+4 IF $DATA(DIMSG)
WRITE !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***"
SET BCHQUIT=1
KILL DIMSG
QUIT
+5 SET BCHPAT=$PIECE(^BCHR(BCHR,0),U,4)
+6 IF BCHPAT=""
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:1
+9 SET DIE="^BCHRPROB("
SET DA=BCHX
SET DR=".02////"_BCHPAT
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:1
+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:1
+16 SET DIE="^BCHRPED("
SET DA=BCHX
SET DR=".02////"_BCHPAT
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:1
+21 QUIT
EXIT ;clean up and exit
+1 KILL DIC,DR,DA,X,Y,DIU,DIU,D0,DO,DI
+2 KILL BCHHIT,BCHX
+3 KILL DIR,X,Y,DIC,DR,DA,D0,DO,DIZ,D
+4 QUIT
ERROR ;
+1 WRITE !!,$CHAR(7),$CHAR(7),"You have NOT completed entry of all of the ",BCHNUM," patients!!"
+2 WRITE !,"This means that you MUST enter each of the remaining visits individually,",!,"using ",($PIECE(^BCHGROUP(BCHFID,0),U,11)\BCHNUM)," minutes activity time for each patient.",!!!
+3 ;really want to quit?
+4 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Are you sure you wish to stop"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF $DATA(DIRUT)
SET BCHSTOP=1
QUIT
+6 IF Y
SET BCHSTOP=1
QUIT
+7 SET BCHSTOP=0
+8 QUIT
PAUSE ;
+1 SET DIR(0)="EO"
SET DIR("A")="Press enter to continue...."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 QUIT
DEL ;
+1 SET DIK="^BCHR("
SET DA=BCHR
DO ^DIK
KILL DA,DIK
+2 WRITE !,"Record deleted."
+3 DO PAUSE
+4 QUIT
