- 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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVED3 6885 printed Feb 18, 2025@23:22:37 Page 2
- 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 ;