GMRVED3 ;HIRMFO/YH,FT-VITAL SIGNS EDIT SHORT FORM (cont.) ;6/28/01 14:42
;;4.0;Vitals/Measurements;**1,5,6,7,11,13**;Apr 25, 1997
EN2 ;VITAL ENTRY FOR A PATIENT
D EN2^GMRVED1 G:GMROUT NEXT D EN4^GMRVED2 S GMROK=0
NEXT I '(GMRENTY=5!(GMRENTY=6)!(GMRENTY=9))!GMROUT S GMRVIDT=GMRDT0 Q
I $G(GMROUT(1))=1 S GMROUT(1)=0 S GMRVIDT=GMRDT0 Q
I GMRSTR'["BP" S GMRVIDT=GMRDT0 Q
S:'$D(GPRMT)&($D(GMRPRMT)) GPRMT="("_$P(GMRPRMT,":")_" continued )" S GPRMT(1)=GMRSTR
I '$D(^GMR(120.5,"AA",DFN,1,9999999-GMRVIDT)) S:GMRENTY=5 GMRSTR="T;P;R;BP;" S:GMRENTY=6 GMRSTR="BP;P;" S:GMRENTY=10 GMRSTR="T;P;R;BP;HT;WT;" S GMRVIDT=GMRDT0 S:GMRENTY=9 GMRSTR=GPRMT(1) K GPRMT,GBP Q
ASK I '$D(GMRSITE("BP"))&'$D(GMRINF("BP")) S:GMRENTY=9 GMRSTR=GPRMT(1) K GPRMT Q
W !,"Enter another B/P? NO// " R GMRX:DTIME S:'$T GMRTO=1 I '$T!(GMRX="^") S GMROUT=1,GMRVIDT=GMRDT0 S:GMRENTY=9 GMRSTR=GPRMT(1) K GBP,GPRMT Q
I GMRX=""!("Nn"[GMRX) S GMRVIDT=GDT S:GMRENTY=5 GMRSTR="T;P;R;BP;" S:GMRENTY=10 GMRSTR="T;P;R;BP;HT;WT;" S GMRVIDT=GMRDT0 S:GMRENTY=9 GMRSTR=GPRMT(1) K GPRMT Q
I GMRX["Y"!(GMRX["y") S GMRSTR=$S(GMRENTY=5!(GMRENTY=6):"BP;P;",1:"BP;"),GMRVIDT=GMRDT0 W @IOF,GPRMT D DSPOV^GMRVED4 D SETBP S GLAST=GLAST+.00000001,GMRVIDT=GLAST G EN2
W !,"ANSWER YES OR NO, maximum 6 B/Ps ",*7 G ASK
SETBP ;
N I S I=0 F S I=$O(GMROV("BP",I)) Q:I'>0 I $P(GMROV("BP",I),"^",2)'="" S GBP($P(GMROV("BP",I),"^",2))=""
Q
CHKDAT ;CHECK V/M ENTRY DATA
S GMRVITY=$P(GMRSTR(0),";",GMRX),GMRVIT=+$O(^GMRD(120.51,"C",GMRVITY,"")),GMRVIT(1)=$S($D(^GMRD(120.51,GMRVIT,0)):$P(^(0),"^"),1:""),GMRO2(GMRVITY)=""
F GMRY=0:0 S GMRY=$O(^GMR(120.5,"AA",DFN,GMRVIT,9999999-GMRVIDT,GMRY)) Q:GMRY'>0 I $S('$D(^GMR(120.5,GMRY,2)):1,$P(^(2),"^"):0,1:1) D
. I GMRENTY=21,"Nn"'[GMRDAT D WDUP S GMRDAT="" Q
. D:"Nn"'[$P(GMRDAT,"-",GMRX-1) WDUP S $P(GMRDAT,"-",GMRX-1)="" Q
S GMRINPTR=$S($D(^GMRD(120.51,GMRVIT,1)):^(1),1:"K:X'?.NP X")
INPTR ;
Q:GMROUT S X=$S(GMRENTY=21:GMRDAT,1:$P(GMRDAT,"-",GMRX-1))
I X="n"!(X="N")!(X="") S (GMRDAT(GMRVITY),GMRSITE(GMRVITY),GMRINF(GMRVITY))="" Q
I "UNAVAILABLEPASSREFUSED"[$$UP^XLFSTR(X) S GMRSITE(GMRVITY)="",GMRINF(GMRVITY)="",GMRDAT(GMRVITY)=X Q
INPTR1 ;
I GMRVITY="PO2" G:$L(X)>10 A G:+X>100 A D O2^GMRVUT3
I GMRVITY="HT" G:'$$HTCHK(X) A S X=$$UP^XLFSTR(X),GMRSITE=$P(X,",",2),X=$P(X,",") D
.I GMRSITE="" S:X["E" GMRSITE=$E(X,$F(X,"E")-1),X=$P(X,"E") S:X["A" GMRSITE=$E(X,$F(X,"A")-1),X=$P(X,"A")
.S:GMRSITE="" GMRSITE="A"
.D TPSITE^GMRVUT1
.Q
I GMRVITY="PN" S GMRDAT("PN")=+X,GMRSITE("PN")=""
I GMRVITY="WT" G:$L(X)>10 A G:+X>1500 A S GMRSITE=$P(X,+X,2) G:GMRSITE=""!("LlKk"'[$E(GMRSITE)) A K GMRSITE(GMRVITY),GMRINF(GMRVITY) D WTYPE^GMRVUT1
I GMRVITY="CG" K GMRSITE(GMRVITY),GMRINF(GMRVITY) S GLVL=8 D LISTQ^GMRVQUAL,OTHERQ^GMRVQUAL,CLEAR^GMRVQUAL
I GMRVITY="BP",GMRENTY<5,$L(X,"/")=1 G A
I GMRVITY="BP" N GMRDP D
.S X=$$UP^XLFSTR(X)
.Q:X'["/"
.S:$P(X,"/",2)="" GMRSITE="PA",GMRDP=1
.S:$P(X,"/",2)="D" GMRSITE="D",X=$P(X,"/")_"/",GMRDP=1
.S:$P(X,"/",2)="P" GMRSITE="PA",X=$P(X,"/")_"/",GMRDP=1
.D:$D(GMRDP)&(GMRENTY<5) TPSITE^GMRVUT1
.Q
I GMRVITY="T"!(GMRVITY="P")!(GMRVITY="BP"&(GMRENTY>4))!(GMRVITY="R")!(GMRVITY="PO2") D SITE I '$D(X) G A
X GMRINPTR I $D(X)#2 S GMRDAT(GMRVITY)=X Q
A W !,?5,$C(7),"Invalid ",GMRVIT(1)," entry"
A1 W !,GMRVIT(1)_": " R GMRRET:DTIME
S:'$T GMRTO=1 I GMRRET="^"!'$T S GMROUT=1 G INPTR
I GMRRET="N"!(GMRRET="n") S (X,GMRRET)="" Q
I GMRRET'["?" S X=GMRRET G INPTR1
I GMRRET?1"?".E S XQH="GMRV-"_$S(GMRVITY="CG":"CIRCUM/GIRTH",GMRVITY="PO2":"PO2",GMRVITY="CVP":"CVP",1:GMRVIT(1))_" RATE HELP" D EN^XQH K XQH
G A1
WDUP ;
W $C(7),!,?4,GMRVIT(1)_" data already exists for this patient on this date/time.",!,?4,"To change this data use the enter a vital/measurement in error option.",!
Q
SITE ;
I GMRVITY'="BP" S GMRSITE=$P(X,+X,2),X=+X S GMRSITE=$$UP^XLFSTR(GMRSITE) I GMRVITY="T"!(GMRVITY="P")!(GMRVITY="R") D TPSITE^GMRVUT1 Q
Q:GMRVITY'="BP"
I GMRVITY="BP" S GLVL=8 D LISTQ^GMRVQUAL N GMRIN D:$D(GMRDP) CHKBP D OTHERQ^GMRVQUAL,CLEAR^GMRVQUAL
I $L(X,"/")=1!($L(X,"/")=2&($P(X,"/",2)="")) D
. I '$D(GMRINF("BP")) W !,"Missing diastolic data!",! K X D BP^GMRVUT1 W ! Q
. N II S (II,II(0))=0 F S II=$O(GMRINF("BP",II)) Q:II'>0 D
. . I $D(GMRINF("BP",II,"PALPATED")) S II(0)=1 Q
. . I $D(GMRINF("BP",II,"DOPPLER")) S II(0)=1
. I II(0)=0 W !,"Missing diastolic data!",! K X D BP^GMRVUT1 W !
Q
CHKBP ; Check for Method of BP for Systolic Value only
N GMRVOK S (GMRVODR,GMRVOK)=0 F S GMRVODR=$O(GCOUNT(GMRVODR)) Q:GMRVODR<1 D Q:GMRVOK
.S GCAT="" F S GCAT=$O(GCOUNT(GMRVODR,GCAT)) Q:GCAT="" D Q:GMRVOK
..I GCAT["METHOD" S GMRVOK=1 Q
..Q
.Q
Q:'GMRVOK
Q:'GMRVODR
K GCOUNT(GMRVODR),GQUAL(GMRVODR),GMRLAST(GMRVODR),GORDER(GMRVODR)
N GMRCI,GMRCJ,GMRCX
S GMRCX=$S(GMRSITE="D":"DOPPLER",1:"PALPATED")
F GMRCI=0:0 S GMRCI=$O(GCHART(GMRCI)) Q:GMRCI<1 I $P(GCHART(GMRCI),"^")=GMRCX S GMRCJ=$P(GCHART(GMRCI),"^",2,3) Q
S:$G(GMRCJ)'="" GMRIN(GMRVODR,GMRCX)=GMRCJ
D RESET(GMRVODR,0,.GCOUNT)
D RESET(GMRVODR,0,.GQUAL)
D RESET(GMRVODR,0,.GMRLAST)
D RESET(GMRVODR,0,.GORDER)
D RESET(GMRVODR,1,.GCHART)
D RESET(GMRVODR,1,.GCHART1)
S (GMRCI,GMRCJ,GMRCX)=0 F S GMRCI=$O(GCHART(GMRCI)) Q:GMRCI<1 D
.S:GMRCX=0 GMRCX=$P(GCHART(GMRCI),"^",3)
.I GMRCX=$P(GCHART(GMRCI),"^",3) S GMRCJ=GMRCJ+1 Q
.I GMRCX'=$P(GCHART(GMRCI),"^",3) D
..S GCAT=$O(GMRLAST(GMRCX,"")),GMRLAST(GMRCX,GCAT)=GMRCJ
..S GMRCX=$P(GCHART(GMRCI),"^",3),GMRCJ=GMRCJ+1 Q
.Q
I GMRCX S GCAT=$O(GMRLAST(GMRCX,"")),GMRLAST(GMRCX,GCAT)=GMRCJ
Q
RESET(GMRVOD,GMRVFLG,GMY) ; Reset GMY after removal of METHOD
N GMRCI,GMRCJ,GMY1,GMRCX
I GMRVFLG D Q
.S GMRCJ=0
.F GMRCI=0:0 S GMRCI=$O(GMY(GMRCI)) Q:GMRCI<1 S GMRCX=$G(GMY(GMRCI)) I $P(GMRCX,"^",3)'=GMRVOD S GMRCJ=GMRCJ+1,GMY1(GMRCJ)=GMRCX S:$P(GMRCX,"^",3)>GMRVOD $P(GMY1(GMRCJ),"^",3)=$P(GMY1(GMRCJ),"^",3)-1
.K GMY F GMRCI=0:0 S GMRCI=$O(GMY1(GMRCI)) Q:GMRCI<1 S GMRCX=$G(GMY1(GMRCI)),GMY(GMRCI)=GMRCX
.Q
F GMRVOD=GMRVOD:0 S GMRVOD=$O(GMY(GMRVOD)) Q:GMRVOD<1 D
.S GMRCI=$O(GMY(GMRVOD,"")) I GMRCI="" S GMY(GMRVOD-1)=$G(GMY(GMRVOD)) K GMY(GMRVOD) Q
.S GCAT="" F S GCAT=$O(GMY(GMRVOD,GCAT)) Q:GCAT="" D
..S GMY(GMRVOD-1,GCAT)=$G(GMY(GMRVOD,GCAT))
..K GMY(GMRVOD,GCAT)
..Q
.Q
Q
HTCHK(X) ; Check ' and " symbols in height entry
; input - X (the height entry)
; output - 0 means there is a problem with the single or double quotes
; 1 means the single and double quotes are fine
I X'["""",X'["'" Q 1 ;quit if ' and " are not in X
I $L(X,"'")>2!($L(X,"""")>2) Q 0 ;quit if more than 1 ' or "
N GMRVSQ,GMRVDQ
S GMRVSQ=$F(X,"'") ;find location of single quote in X
S GMRVDQ=$F(X,"""") ;find location of double quote in X
I GMRVDQ>0,GMRVDQ<GMRVSQ Q 0 ;quit if " is before '
I GMRVSQ>0,GMRVDQ>0,$E(X,GMRVSQ)="""" Q 0 ;quit if '" combination
Q 1
;
GMRVED3 ;HIRMFO/YH,FT-VITAL SIGNS EDIT SHORT FORM (cont.) ;6/28/01 14:42
+1 ;;4.0;Vitals/Measurements;**1,5,6,7,11,13**;Apr 25, 1997
EN2 ;VITAL ENTRY FOR A PATIENT
+1 DO EN2^GMRVED1
IF GMROUT
GOTO NEXT
DO EN4^GMRVED2
SET GMROK=0
NEXT IF '(GMRENTY=5!(GMRENTY=6)!(GMRENTY=9))!GMROUT
SET GMRVIDT=GMRDT0
QUIT
+1 IF $GET(GMROUT(1))=1
SET GMROUT(1)=0
SET GMRVIDT=GMRDT0
QUIT
+2 IF GMRSTR'["BP"
SET GMRVIDT=GMRDT0
QUIT
+3 IF '$DATA(GPRMT)&($DATA(GMRPRMT))
SET GPRMT="("_$PIECE(GMRPRMT,":")_" continued )"
SET GPRMT(1)=GMRSTR
+4 IF '$DATA(^GMR(120.5,"AA",DFN,1,9999999-GMRVIDT))
IF GMRENTY=5
SET GMRSTR="T;P;R;BP;"
IF GMRENTY=6
SET GMRSTR="BP;P;"
IF GMRENTY=10
SET GMRSTR="T;P;R;BP;HT;WT;"
SET GMRVIDT=GMRDT0
IF GMRENTY=9
SET GMRSTR=GPRMT(1)
KILL GPRMT,GBP
QUIT
ASK IF '$DATA(GMRSITE("BP"))&'$DATA(GMRINF("BP"))
IF GMRENTY=9
SET GMRSTR=GPRMT(1)
KILL GPRMT
QUIT
+1 WRITE !,"Enter another B/P? NO// "
READ GMRX:DTIME
IF '$TEST
SET GMRTO=1
IF '$TEST!(GMRX="^")
SET GMROUT=1
SET GMRVIDT=GMRDT0
IF GMRENTY=9
SET GMRSTR=GPRMT(1)
KILL GBP,GPRMT
QUIT
+2 IF GMRX=""!("Nn"[GMRX)
SET GMRVIDT=GDT
IF GMRENTY=5
SET GMRSTR="T;P;R;BP;"
IF GMRENTY=10
SET GMRSTR="T;P;R;BP;HT;WT;"
SET GMRVIDT=GMRDT0
IF GMRENTY=9
SET GMRSTR=GPRMT(1)
KILL GPRMT
QUIT
+3 IF GMRX["Y"!(GMRX["y")
SET GMRSTR=$SELECT(GMRENTY=5!(GMRENTY=6):"BP;P;",1:"BP;")
SET GMRVIDT=GMRDT0
WRITE @IOF,GPRMT
DO DSPOV^GMRVED4
DO SETBP
SET GLAST=GLAST+.00000001
SET GMRVIDT=GLAST
GOTO EN2
+4 WRITE !,"ANSWER YES OR NO, maximum 6 B/Ps ",*7
GOTO ASK
SETBP ;
+1 NEW I
SET I=0
FOR
SET I=$ORDER(GMROV("BP",I))
IF I'>0
QUIT
IF $PIECE(GMROV("BP",I),"^",2)'=""
SET GBP($PIECE(GMROV("BP",I),"^",2))=""
+2 QUIT
CHKDAT ;CHECK V/M ENTRY DATA
+1 SET GMRVITY=$PIECE(GMRSTR(0),";",GMRX)
SET GMRVIT=+$ORDER(^GMRD(120.51,"C",GMRVITY,""))
SET GMRVIT(1)=$SELECT($DATA(^GMRD(120.51,GMRVIT,0)):$PIECE(^(0),"^"),1:"")
SET GMRO2(GMRVITY)=""
+2 FOR GMRY=0:0
SET GMRY=$ORDER(^GMR(120.5,"AA",DFN,GMRVIT,9999999-GMRVIDT,GMRY))
IF GMRY'>0
QUIT
IF $SELECT('$DATA(^GMR(120.5,GMRY,2)):1,$PIECE(^(2),"^"):0,1:1)
Begin DoDot:1
+3 IF GMRENTY=21
IF "Nn"'[GMRDAT
DO WDUP
SET GMRDAT=""
QUIT
+4 IF "Nn"'[$PIECE(GMRDAT,"-",GMRX-1)
DO WDUP
SET $PIECE(GMRDAT,"-",GMRX-1)=""
QUIT
End DoDot:1
+5 SET GMRINPTR=$SELECT($DATA(^GMRD(120.51,GMRVIT,1)):^(1),1:"K:X'?.NP X")
INPTR ;
+1 IF GMROUT
QUIT
SET X=$SELECT(GMRENTY=21:GMRDAT,1:$PIECE(GMRDAT,"-",GMRX-1))
+2 IF X="n"!(X="N")!(X="")
SET (GMRDAT(GMRVITY),GMRSITE(GMRVITY),GMRINF(GMRVITY))=""
QUIT
+3 IF "UNAVAILABLEPASSREFUSED"[$$UP^XLFSTR(X)
SET GMRSITE(GMRVITY)=""
SET GMRINF(GMRVITY)=""
SET GMRDAT(GMRVITY)=X
QUIT
INPTR1 ;
+1 IF GMRVITY="PO2"
IF $LENGTH(X)>10
GOTO A
IF +X>100
GOTO A
DO O2^GMRVUT3
+2 IF GMRVITY="HT"
IF '$$HTCHK(X)
GOTO A
SET X=$$UP^XLFSTR(X)
SET GMRSITE=$PIECE(X,",",2)
SET X=$PIECE(X,",")
Begin DoDot:1
+3 IF GMRSITE=""
IF X["E"
SET GMRSITE=$EXTRACT(X,$FIND(X,"E")-1)
SET X=$PIECE(X,"E")
IF X["A"
SET GMRSITE=$EXTRACT(X,$FIND(X,"A")-1)
SET X=$PIECE(X,"A")
+4 IF GMRSITE=""
SET GMRSITE="A"
+5 DO TPSITE^GMRVUT1
+6 QUIT
End DoDot:1
+7 IF GMRVITY="PN"
SET GMRDAT("PN")=+X
SET GMRSITE("PN")=""
+8 IF GMRVITY="WT"
IF $LENGTH(X)>10
GOTO A
IF +X>1500
GOTO A
SET GMRSITE=$PIECE(X,+X,2)
IF GMRSITE=""!("LlKk"'[$EXTRACT(GMRSITE))
GOTO A
KILL GMRSITE(GMRVITY),GMRINF(GMRVITY)
DO WTYPE^GMRVUT1
+9 IF GMRVITY="CG"
KILL GMRSITE(GMRVITY),GMRINF(GMRVITY)
SET GLVL=8
DO LISTQ^GMRVQUAL
DO OTHERQ^GMRVQUAL
DO CLEAR^GMRVQUAL
+10 IF GMRVITY="BP"
IF GMRENTY<5
IF $LENGTH(X,"/")=1
GOTO A
+11 IF GMRVITY="BP"
NEW GMRDP
Begin DoDot:1
+12 SET X=$$UP^XLFSTR(X)
+13 IF X'["/"
QUIT
+14 IF $PIECE(X,"/",2)=""
SET GMRSITE="PA"
SET GMRDP=1
+15 IF $PIECE(X,"/",2)="D"
SET GMRSITE="D"
SET X=$PIECE(X,"/")_"/"
SET GMRDP=1
+16 IF $PIECE(X,"/",2)="P"
SET GMRSITE="PA"
SET X=$PIECE(X,"/")_"/"
SET GMRDP=1
+17 IF $DATA(GMRDP)&(GMRENTY<5)
DO TPSITE^GMRVUT1
+18 QUIT
End DoDot:1
+19 IF GMRVITY="T"!(GMRVITY="P")!(GMRVITY="BP"&(GMRENTY>4))!(GMRVITY="R")!(GMRVITY="PO2")
DO SITE
IF '$DATA(X)
GOTO A
+20 XECUTE GMRINPTR
IF $DATA(X)#2
SET GMRDAT(GMRVITY)=X
QUIT
A WRITE !,?5,$CHAR(7),"Invalid ",GMRVIT(1)," entry"
A1 WRITE !,GMRVIT(1)_": "
READ GMRRET:DTIME
+1 IF '$TEST
SET GMRTO=1
IF GMRRET="^"!'$TEST
SET GMROUT=1
GOTO INPTR
+2 IF GMRRET="N"!(GMRRET="n")
SET (X,GMRRET)=""
QUIT
+3 IF GMRRET'["?"
SET X=GMRRET
GOTO INPTR1
+4 IF GMRRET?1"?".E
SET XQH="GMRV-"_$SELECT(GMRVITY="CG":"CIRCUM/GIRTH",GMRVITY="PO2":"PO2",GMRVITY="CVP":"CVP",1:GMRVIT(1))_" RATE HELP"
DO EN^XQH
KILL XQH
+5 GOTO A1
WDUP ;
+1 WRITE $CHAR(7),!,?4,GMRVIT(1)_" data already exists for this patient on this date/time.",!,?4,"To change this data use the enter a vital/measurement in error option.",!
+2 QUIT
SITE ;
+1 IF GMRVITY'="BP"
SET GMRSITE=$PIECE(X,+X,2)
SET X=+X
SET GMRSITE=$$UP^XLFSTR(GMRSITE)
IF GMRVITY="T"!(GMRVITY="P")!(GMRVITY="R")
DO TPSITE^GMRVUT1
QUIT
+2 IF GMRVITY'="BP"
QUIT
+3 IF GMRVITY="BP"
SET GLVL=8
DO LISTQ^GMRVQUAL
NEW GMRIN
IF $DATA(GMRDP)
DO CHKBP
DO OTHERQ^GMRVQUAL
DO CLEAR^GMRVQUAL
+4 IF $LENGTH(X,"/")=1!($LENGTH(X,"/")=2&($PIECE(X,"/",2)=""))
Begin DoDot:1
+5 IF '$DATA(GMRINF("BP"))
WRITE !,"Missing diastolic data!",!
KILL X
DO BP^GMRVUT1
WRITE !
QUIT
+6 NEW II
SET (II,II(0))=0
FOR
SET II=$ORDER(GMRINF("BP",II))
IF II'>0
QUIT
Begin DoDot:2
+7 IF $DATA(GMRINF("BP",II,"PALPATED"))
SET II(0)=1
QUIT
+8 IF $DATA(GMRINF("BP",II,"DOPPLER"))
SET II(0)=1
End DoDot:2
+9 IF II(0)=0
WRITE !,"Missing diastolic data!",!
KILL X
DO BP^GMRVUT1
WRITE !
End DoDot:1
+10 QUIT
CHKBP ; Check for Method of BP for Systolic Value only
+1 NEW GMRVOK
SET (GMRVODR,GMRVOK)=0
FOR
SET GMRVODR=$ORDER(GCOUNT(GMRVODR))
IF GMRVODR<1
QUIT
Begin DoDot:1
+2 SET GCAT=""
FOR
SET GCAT=$ORDER(GCOUNT(GMRVODR,GCAT))
IF GCAT=""
QUIT
Begin DoDot:2
+3 IF GCAT["METHOD"
SET GMRVOK=1
QUIT
+4 QUIT
End DoDot:2
IF GMRVOK
QUIT
+5 QUIT
End DoDot:1
IF GMRVOK
QUIT
+6 IF 'GMRVOK
QUIT
+7 IF 'GMRVODR
QUIT
+8 KILL GCOUNT(GMRVODR),GQUAL(GMRVODR),GMRLAST(GMRVODR),GORDER(GMRVODR)
+9 NEW GMRCI,GMRCJ,GMRCX
+10 SET GMRCX=$SELECT(GMRSITE="D":"DOPPLER",1:"PALPATED")
+11 FOR GMRCI=0:0
SET GMRCI=$ORDER(GCHART(GMRCI))
IF GMRCI<1
QUIT
IF $PIECE(GCHART(GMRCI),"^")=GMRCX
SET GMRCJ=$PIECE(GCHART(GMRCI),"^",2,3)
QUIT
+12 IF $GET(GMRCJ)'=""
SET GMRIN(GMRVODR,GMRCX)=GMRCJ
+13 DO RESET(GMRVODR,0,.GCOUNT)
+14 DO RESET(GMRVODR,0,.GQUAL)
+15 DO RESET(GMRVODR,0,.GMRLAST)
+16 DO RESET(GMRVODR,0,.GORDER)
+17 DO RESET(GMRVODR,1,.GCHART)
+18 DO RESET(GMRVODR,1,.GCHART1)
+19 SET (GMRCI,GMRCJ,GMRCX)=0
FOR
SET GMRCI=$ORDER(GCHART(GMRCI))
IF GMRCI<1
QUIT
Begin DoDot:1
+20 IF GMRCX=0
SET GMRCX=$PIECE(GCHART(GMRCI),"^",3)
+21 IF GMRCX=$PIECE(GCHART(GMRCI),"^",3)
SET GMRCJ=GMRCJ+1
QUIT
+22 IF GMRCX'=$PIECE(GCHART(GMRCI),"^",3)
Begin DoDot:2
+23 SET GCAT=$ORDER(GMRLAST(GMRCX,""))
SET GMRLAST(GMRCX,GCAT)=GMRCJ
+24 SET GMRCX=$PIECE(GCHART(GMRCI),"^",3)
SET GMRCJ=GMRCJ+1
QUIT
End DoDot:2
+25 QUIT
End DoDot:1
+26 IF GMRCX
SET GCAT=$ORDER(GMRLAST(GMRCX,""))
SET GMRLAST(GMRCX,GCAT)=GMRCJ
+27 QUIT
RESET(GMRVOD,GMRVFLG,GMY) ; Reset GMY after removal of METHOD
+1 NEW GMRCI,GMRCJ,GMY1,GMRCX
+2 IF GMRVFLG
Begin DoDot:1
+3 SET GMRCJ=0
+4 FOR GMRCI=0:0
SET GMRCI=$ORDER(GMY(GMRCI))
IF GMRCI<1
QUIT
SET GMRCX=$GET(GMY(GMRCI))
IF $PIECE(GMRCX,"^",3)'=GMRVOD
SET GMRCJ=GMRCJ+1
SET GMY1(GMRCJ)=GMRCX
IF $PIECE(GMRCX,"^",3)>GMRVOD
SET $PIECE(GMY1(GMRCJ),"^",3)=$PIECE(GMY1(GMRCJ),"^",3)-1
+5 KILL GMY
FOR GMRCI=0:0
SET GMRCI=$ORDER(GMY1(GMRCI))
IF GMRCI<1
QUIT
SET GMRCX=$GET(GMY1(GMRCI))
SET GMY(GMRCI)=GMRCX
+6 QUIT
End DoDot:1
QUIT
+7 FOR GMRVOD=GMRVOD:0
SET GMRVOD=$ORDER(GMY(GMRVOD))
IF GMRVOD<1
QUIT
Begin DoDot:1
+8 SET GMRCI=$ORDER(GMY(GMRVOD,""))
IF GMRCI=""
SET GMY(GMRVOD-1)=$GET(GMY(GMRVOD))
KILL GMY(GMRVOD)
QUIT
+9 SET GCAT=""
FOR
SET GCAT=$ORDER(GMY(GMRVOD,GCAT))
IF GCAT=""
QUIT
Begin DoDot:2
+10 SET GMY(GMRVOD-1,GCAT)=$GET(GMY(GMRVOD,GCAT))
+11 KILL GMY(GMRVOD,GCAT)
+12 QUIT
End DoDot:2
+13 QUIT
End DoDot:1
+14 QUIT
HTCHK(X) ; Check ' and " symbols in height entry
+1 ; input - X (the height entry)
+2 ; output - 0 means there is a problem with the single or double quotes
+3 ; 1 means the single and double quotes are fine
+4 ;quit if ' and " are not in X
IF X'[""""
IF X'["'"
QUIT 1
+5 ;quit if more than 1 ' or "
IF $LENGTH(X,"'")>2!($LENGTH(X,"""")>2)
QUIT 0
+6 NEW GMRVSQ,GMRVDQ
+7 ;find location of single quote in X
SET GMRVSQ=$FIND(X,"'")
+8 ;find location of double quote in X
SET GMRVDQ=$FIND(X,"""")
+9 ;quit if " is before '
IF GMRVDQ>0
IF GMRVDQ<GMRVSQ
QUIT 0
+10 ;quit if '" combination
IF GMRVSQ>0
IF GMRVDQ>0
IF $EXTRACT(X,GMRVSQ)=""""
QUIT 0
+11 QUIT 1
+12 ;
