source: WorldVistAEHR/trunk/r/GEN_MED_REC_VITALS-GMRV/GMRVEE1.m@ 1604

GMRVEE1 ;HIRMFO/RM,YH-ENTERED IN ERROR EDIT ;7/15/97
 ;;4.0;Vitals/Measurements;**1**;Apr 25, 1997
EN1 ; ENTRY FROM ROUTINE GMRVEE1 TO CONTINUE EDITING VITALS IN ERROR
 W !!,"*** DATA TO BE ENTERED IN ERROR ***"
 F GMRX=0:0 S GMRX=$O(GMRARTY(GMRX)) Q:GMRX'>0  I $D(GMRARTY(GMRX,GMRVDT)) S GMRDA=GMRARTY(GMRX,GMRVDT) D PRTEED^GMRVEE2
 Q
RESLS ; RESELECT REASON FOR ERROR
 W !!?4,"1  INCORRECT DATE/TIME",!?4,"2  INCORRECT "_$S(GMRVITY'="A":"READING",1:"PATIENT"),!?4,"3  "_$S(GMRVITY'="A":"INCORRECT PATIENT",1:"INVALID VITAL/RECORD") W:GMRVITY'="A" !?4,"4  INVALID VITAL/RECORD"
RESCH K GMRCHC S GMROUT=0
 W !,"Select the reason(s) for entering ",$S(GMRVITY'="A":"this vital/measurement",1:"these vital/measurements")," in error",!,"or type '^' to exit: " R GMRX:DTIME I '$T!(GMRX="^") S GMROUT=1 W !!,"NO UPDATING WAS DONE" Q
REHLP I GMRX?.P&(GMRX'["-"&(GMRX'[","))!(GMRX'?.NP&(GMRX'?.N)) W !!?3,$C(7),"Answer with selection number(s) with ranges separated with hyphens (-),",!?3,"and multiple selections separated by commas (,).",! G RESLS:GMRX?1"?".E,RESCH
 F GMRY=1:1 S GMRZ=$P(GMRX,",",GMRY) Q:GMRZ=""  S GMRZ(1)=$P(GMRZ,"-"),GMRZ(2)=$P(GMRZ,"-",2) D CHKRG G:GMROUT REHLP F GMRY(0)=+GMRZ:1:$S(GMRZ(2)="":+GMRZ,1:+GMRZ(2)) S GMRCHC(GMRY(0))=""
 I GMRVITY="A" S:$D(GMRCHC(3)) GMRCHC(4)="" K GMRCHC(3) S:$D(GMRCHC(2)) GMRCHC(3)="" K GMRCHC(2)
 I $D(GMRCHC(4)),$O(GMRCHC(0))'=4 W !!,?3,$C(7),"The INVALID RECORD reason cannot be used in combination with any",!?3,"other selections." G RESCH
TIME I $D(GMRCHC(1)) D EN1^GMRVEE2 Q:GMROUT  I '$D(GMRCHC(3)) S GDT=GMRCHC(1) D EN1^GMRVADM Q:GMROUT  S Y=GMRCHC(1),GDATE=9999999-GMRCHC(1) D DD^%DT,DUPREC^GMRVEE2 Q:GMROUT
 G:GMROUT QUIT
 I $D(GMRCHC(2)) S GMRX=$O(GMRARTY(0)) Q:GMRX'>0  S GMRVIDT=$O(GMRARTY(GMRX,0)) Q:GMRVIDT'>0  D EN2^GMRVEE2 Q:GMROUT
 G:GMROUT QUIT
PERSON I $D(GMRCHC(3)) D EN3^GMRVEE2 Q:GMROUT  S GDFN=DFN,DFN=+GMRCHC(3),GDT=$S($D(GMRCHC(1)):GMRCHC(1),1:GMRVDT) D EN1^GMRVADM Q:GMROUT  S Y=GDT,GDATE=9999999-Y D DD^%DT,DUPREC^GMRVEE2 S DFN=GDFN
 G:GMROUT QUIT
 W ! F GMRY=0:0 S GMRY=$O(GMRARTY(GMRY)) Q:GMRY'>0  I $D(GMRARTY(GMRY,GMRVDT)) S GMRDA=GMRARTY(GMRY,GMRVDT) D QUALIFY^GMRVEE3,ENTERR
QUIT K GBLNK,GLVL,GQUAL,GSIDE,GTYPE,GCHA,GCOL,GDATA,GENTR,GLAST,GLINE,GLN,GMRING,GMRVLST,GORDER Q
CHKRG ; CHECK RANGE
 I GMRZ'?1N1"-"1N&(GMRZ'?1N) S GMRX="",GMROUT=1 Q
 I (GMRZ(2)'=""&(GMRZ(2)'?1N))!(GMRZ(1)'?1N) S GMRX="",GMROUT=1 Q
 I GMRZ(1)<1!(GMRZ(1)>$S(GMRVITY'="A":4,1:3)) S GMRX="",GMROUT=1 Q
 I GMRZ(2)'="",(GMRZ(2)<1!(GMRZ(2)>$S(GMRVITY'="A":4,1:3))) S GMRX="",GMROUT=1 Q
 Q
ENTERR ; ENTER RECORD DEFINED BY GMRDA IN ERROR
 G:$D(GMRCHC(4)) ERREN
 I $D(GMRCHC(1)),'$D(GMRCHC(3)),$D(^GMR(120.5,"AA",DFN,GMRY,9999999-GMRCHC(1))) S GDATE=9999999-GMRCHC(1),GSAVE=GMRDA D DUPDT^GMRVEE2 S GMRDA=GSAVE
 I $D(GMRCHC(1)),$D(GMRCHC(3)),$D(^GMR(120.5,"AA",+GMRCHC(3),GMRY,9999999-GMRCHC(1))) S GDATE=9999999-GMRCHC(1),GSAVE=GMRDA,GDFN=DFN,DFN=+GMRCHC(3) D DUPDT^GMRVEE2 S DFN=GDFN,GMRDA=GSAVE
 I $D(GMRCHC(3)),'$D(GMRCHC(1)),$D(^GMR(120.5,"AA",+GMRCHC(3),GMRY,9999999-GMRVDT)) S GDATE=9999999-GMRVDT,GDFN=DFN,DFN=+GMRCHC(3),GSAVE=GMRDA D DUPDT^GMRVEE2 S DFN=GDFN,GMRDA=GSAVE
 S GMRDAT=$S($D(^GMR(120.5,GMRDA,0)):^(0),1:"")
 S GMRSTR=$P($S($D(^GMRD(120.51,GMRY,0)):^(0),1:0),"^",2)
 S GMRDAT(GMRSTR)=$S('$D(GMRCHC(2)):$P(GMRDAT,"^",8),$P(GMRCHC(2),"^")'="":$P(GMRCHC(2),"^"),1:$P(GMRDAT,"^",8)),GMRVIDT=$S('$D(GMRCHC(1)):$P(GMRDAT,"^"),$P(GMRCHC(1),"^")'="":$P(GMRCHC(1),"^"),1:$P(GMRDAT,"^"))
 S GMRDFN=DFN,DFN=$S('$D(GMRCHC(3)):DFN,$P(GMRCHC(3),"^")'="":$P(GMRCHC(3),"^"),1:DFN),GMRVHLOC=$P(GMRDAT,"^",5)
 S:'$D(GMRCHC(2)) GMRO2(GMRSTR)=$P(GMRDAT,"^",10)
 W "." S GMREDB="P",GMRSTR(0)=";"_GMRSTR I $E(GMRSTR(0),$L(GMRSTR(0)))'=";" S GMRSTR(0)=GMRSTR(0)_";",GMRENTY=8 D EN4^GMRVED2 S DFN=GMRDFN
ERREN ; EDIT A RECORD ENTERED IN ERROR
 S DA=GMRDA,DR="2///^S X=1;3///^S X=""`""_DUZ",DIE="^GMR(120.5," W "." D ^DIE S ^GMR(120.5,DA,2.1,0)="^120.506S^^",DA(1)=DA
 F GMRZ=0:0 S GMRZ=$O(GMRCHC(GMRZ)) Q:GMRZ'>0  S DIC="^GMR(120.5,"_DA(1)_",2.1,",DLAYGO=120.506,DIC(0)="L",X=GMRZ D ^DIC K DLAYGO
 S GMROUT=1
 Q