source: FOIAVistA/trunk/r/GEN_MED_REC_VITALS-GMRV/GMRVEE1.m@ 1470

Last change on this file since 1470 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1GMRVEE1 ;HIRMFO/RM,YH-ENTERED IN ERROR EDIT ;7/15/97
2 ;;4.0;Vitals/Measurements;**1**;Apr 25, 1997
3EN1 ; ENTRY FROM ROUTINE GMRVEE1 TO CONTINUE EDITING VITALS IN ERROR
4 W !!,"*** DATA TO BE ENTERED IN ERROR ***"
5 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
6 Q
7RESLS ; RESELECT REASON FOR ERROR
8 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"
9RESCH K GMRCHC S GMROUT=0
10 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
11REHLP 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
12 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))=""
13 I GMRVITY="A" S:$D(GMRCHC(3)) GMRCHC(4)="" K GMRCHC(3) S:$D(GMRCHC(2)) GMRCHC(3)="" K GMRCHC(2)
14 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
15TIME 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
16 G:GMROUT QUIT
17 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
18 G:GMROUT QUIT
19PERSON 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
20 G:GMROUT QUIT
21 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
22QUIT K GBLNK,GLVL,GQUAL,GSIDE,GTYPE,GCHA,GCOL,GDATA,GENTR,GLAST,GLINE,GLN,GMRING,GMRVLST,GORDER Q
23CHKRG ; CHECK RANGE
24 I GMRZ'?1N1"-"1N&(GMRZ'?1N) S GMRX="",GMROUT=1 Q
25 I (GMRZ(2)'=""&(GMRZ(2)'?1N))!(GMRZ(1)'?1N) S GMRX="",GMROUT=1 Q
26 I GMRZ(1)<1!(GMRZ(1)>$S(GMRVITY'="A":4,1:3)) S GMRX="",GMROUT=1 Q
27 I GMRZ(2)'="",(GMRZ(2)<1!(GMRZ(2)>$S(GMRVITY'="A":4,1:3))) S GMRX="",GMROUT=1 Q
28 Q
29ENTERR ; ENTER RECORD DEFINED BY GMRDA IN ERROR
30 G:$D(GMRCHC(4)) ERREN
31 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
32 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
33 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
34 S GMRDAT=$S($D(^GMR(120.5,GMRDA,0)):^(0),1:"")
35 S GMRSTR=$P($S($D(^GMRD(120.51,GMRY,0)):^(0),1:0),"^",2)
36 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,"^"))
37 S GMRDFN=DFN,DFN=$S('$D(GMRCHC(3)):DFN,$P(GMRCHC(3),"^")'="":$P(GMRCHC(3),"^"),1:DFN),GMRVHLOC=$P(GMRDAT,"^",5)
38 S:'$D(GMRCHC(2)) GMRO2(GMRSTR)=$P(GMRDAT,"^",10)
39 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
40ERREN ; EDIT A RECORD ENTERED IN ERROR
41 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
42 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
43 S GMROUT=1
44 Q
Note: See TracBrowser for help on using the repository browser.