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