source: WorldVistAEHR/trunk/r/GEN_MED_REC_VITALS-GMRV/GMRVED3.m@ 1714

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

initial load of WorldVistAEHR

File size: 6.6 KB
RevLine 
[613]1GMRVED3 ;HIRMFO/YH,FT-VITAL SIGNS EDIT SHORT FORM (cont.) ;6/28/01 14:42
2 ;;4.0;Vitals/Measurements;**1,5,6,7,11,13**;Apr 25, 1997
3EN2 ;VITAL ENTRY FOR A PATIENT
4 D EN2^GMRVED1 G:GMROUT NEXT D EN4^GMRVED2 S GMROK=0
5NEXT I '(GMRENTY=5!(GMRENTY=6)!(GMRENTY=9))!GMROUT S GMRVIDT=GMRDT0 Q
6 I $G(GMROUT(1))=1 S GMROUT(1)=0 S GMRVIDT=GMRDT0 Q
7 I GMRSTR'["BP" S GMRVIDT=GMRDT0 Q
8 S:'$D(GPRMT)&($D(GMRPRMT)) GPRMT="("_$P(GMRPRMT,":")_" continued )" S GPRMT(1)=GMRSTR
9 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
10ASK I '$D(GMRSITE("BP"))&'$D(GMRINF("BP")) S:GMRENTY=9 GMRSTR=GPRMT(1) K GPRMT Q
11 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
12 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
13 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
14 W !,"ANSWER YES OR NO, maximum 6 B/Ps ",*7 G ASK
15SETBP ;
16 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))=""
17 Q
18CHKDAT ;CHECK V/M ENTRY DATA
19 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)=""
20 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
21 . I GMRENTY=21,"Nn"'[GMRDAT D WDUP S GMRDAT="" Q
22 . D:"Nn"'[$P(GMRDAT,"-",GMRX-1) WDUP S $P(GMRDAT,"-",GMRX-1)="" Q
23 S GMRINPTR=$S($D(^GMRD(120.51,GMRVIT,1)):^(1),1:"K:X'?.NP X")
24INPTR ;
25 Q:GMROUT S X=$S(GMRENTY=21:GMRDAT,1:$P(GMRDAT,"-",GMRX-1))
26 I X="n"!(X="N")!(X="") S (GMRDAT(GMRVITY),GMRSITE(GMRVITY),GMRINF(GMRVITY))="" Q
27 I "UNAVAILABLEPASSREFUSED"[$$UP^XLFSTR(X) S GMRSITE(GMRVITY)="",GMRINF(GMRVITY)="",GMRDAT(GMRVITY)=X Q
28INPTR1 ;
29 I GMRVITY="PO2" G:$L(X)>10 A G:+X>100 A D O2^GMRVUT3
30 I GMRVITY="HT" G:'$$HTCHK(X) A S X=$$UP^XLFSTR(X),GMRSITE=$P(X,",",2),X=$P(X,",") D
31 .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")
32 .S:GMRSITE="" GMRSITE="A"
33 .D TPSITE^GMRVUT1
34 .Q
35 I GMRVITY="PN" S GMRDAT("PN")=+X,GMRSITE("PN")=""
36 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
37 I GMRVITY="CG" K GMRSITE(GMRVITY),GMRINF(GMRVITY) S GLVL=8 D LISTQ^GMRVQUAL,OTHERQ^GMRVQUAL,CLEAR^GMRVQUAL
38 I GMRVITY="BP",GMRENTY<5,$L(X,"/")=1 G A
39 I GMRVITY="BP" N GMRDP D
40 .S X=$$UP^XLFSTR(X)
41 .Q:X'["/"
42 .S:$P(X,"/",2)="" GMRSITE="PA",GMRDP=1
43 .S:$P(X,"/",2)="D" GMRSITE="D",X=$P(X,"/")_"/",GMRDP=1
44 .S:$P(X,"/",2)="P" GMRSITE="PA",X=$P(X,"/")_"/",GMRDP=1
45 .D:$D(GMRDP)&(GMRENTY<5) TPSITE^GMRVUT1
46 .Q
47 I GMRVITY="T"!(GMRVITY="P")!(GMRVITY="BP"&(GMRENTY>4))!(GMRVITY="R")!(GMRVITY="PO2") D SITE I '$D(X) G A
48 X GMRINPTR I $D(X)#2 S GMRDAT(GMRVITY)=X Q
49A W !,?5,$C(7),"Invalid ",GMRVIT(1)," entry"
50A1 W !,GMRVIT(1)_": " R GMRRET:DTIME
51 S:'$T GMRTO=1 I GMRRET="^"!'$T S GMROUT=1 G INPTR
52 I GMRRET="N"!(GMRRET="n") S (X,GMRRET)="" Q
53 I GMRRET'["?" S X=GMRRET G INPTR1
54 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
55 G A1
56WDUP ;
57 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.",!
58 Q
59SITE ;
60 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
61 Q:GMRVITY'="BP"
62 I GMRVITY="BP" S GLVL=8 D LISTQ^GMRVQUAL N GMRIN D:$D(GMRDP) CHKBP D OTHERQ^GMRVQUAL,CLEAR^GMRVQUAL
63 I $L(X,"/")=1!($L(X,"/")=2&($P(X,"/",2)="")) D
64 . I '$D(GMRINF("BP")) W !,"Missing diastolic data!",! K X D BP^GMRVUT1 W ! Q
65 . N II S (II,II(0))=0 F S II=$O(GMRINF("BP",II)) Q:II'>0 D
66 . . I $D(GMRINF("BP",II,"PALPATED")) S II(0)=1 Q
67 . . I $D(GMRINF("BP",II,"DOPPLER")) S II(0)=1
68 . I II(0)=0 W !,"Missing diastolic data!",! K X D BP^GMRVUT1 W !
69 Q
70CHKBP ; Check for Method of BP for Systolic Value only
71 N GMRVOK S (GMRVODR,GMRVOK)=0 F S GMRVODR=$O(GCOUNT(GMRVODR)) Q:GMRVODR<1 D Q:GMRVOK
72 .S GCAT="" F S GCAT=$O(GCOUNT(GMRVODR,GCAT)) Q:GCAT="" D Q:GMRVOK
73 ..I GCAT["METHOD" S GMRVOK=1 Q
74 ..Q
75 .Q
76 Q:'GMRVOK
77 Q:'GMRVODR
78 K GCOUNT(GMRVODR),GQUAL(GMRVODR),GMRLAST(GMRVODR),GORDER(GMRVODR)
79 N GMRCI,GMRCJ,GMRCX
80 S GMRCX=$S(GMRSITE="D":"DOPPLER",1:"PALPATED")
81 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
82 S:$G(GMRCJ)'="" GMRIN(GMRVODR,GMRCX)=GMRCJ
83 D RESET(GMRVODR,0,.GCOUNT)
84 D RESET(GMRVODR,0,.GQUAL)
85 D RESET(GMRVODR,0,.GMRLAST)
86 D RESET(GMRVODR,0,.GORDER)
87 D RESET(GMRVODR,1,.GCHART)
88 D RESET(GMRVODR,1,.GCHART1)
89 S (GMRCI,GMRCJ,GMRCX)=0 F S GMRCI=$O(GCHART(GMRCI)) Q:GMRCI<1 D
90 .S:GMRCX=0 GMRCX=$P(GCHART(GMRCI),"^",3)
91 .I GMRCX=$P(GCHART(GMRCI),"^",3) S GMRCJ=GMRCJ+1 Q
92 .I GMRCX'=$P(GCHART(GMRCI),"^",3) D
93 ..S GCAT=$O(GMRLAST(GMRCX,"")),GMRLAST(GMRCX,GCAT)=GMRCJ
94 ..S GMRCX=$P(GCHART(GMRCI),"^",3),GMRCJ=GMRCJ+1 Q
95 .Q
96 I GMRCX S GCAT=$O(GMRLAST(GMRCX,"")),GMRLAST(GMRCX,GCAT)=GMRCJ
97 Q
98RESET(GMRVOD,GMRVFLG,GMY) ; Reset GMY after removal of METHOD
99 N GMRCI,GMRCJ,GMY1,GMRCX
100 I GMRVFLG D Q
101 .S GMRCJ=0
102 .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
103 .K GMY F GMRCI=0:0 S GMRCI=$O(GMY1(GMRCI)) Q:GMRCI<1 S GMRCX=$G(GMY1(GMRCI)),GMY(GMRCI)=GMRCX
104 .Q
105 F GMRVOD=GMRVOD:0 S GMRVOD=$O(GMY(GMRVOD)) Q:GMRVOD<1 D
106 .S GMRCI=$O(GMY(GMRVOD,"")) I GMRCI="" S GMY(GMRVOD-1)=$G(GMY(GMRVOD)) K GMY(GMRVOD) Q
107 .S GCAT="" F S GCAT=$O(GMY(GMRVOD,GCAT)) Q:GCAT="" D
108 ..S GMY(GMRVOD-1,GCAT)=$G(GMY(GMRVOD,GCAT))
109 ..K GMY(GMRVOD,GCAT)
110 ..Q
111 .Q
112 Q
113HTCHK(X) ; Check ' and " symbols in height entry
114 ; input - X (the height entry)
115 ; output - 0 means there is a problem with the single or double quotes
116 ; 1 means the single and double quotes are fine
117 I X'["""",X'["'" Q 1 ;quit if ' and " are not in X
118 I $L(X,"'")>2!($L(X,"""")>2) Q 0 ;quit if more than 1 ' or "
119 N GMRVSQ,GMRVDQ
120 S GMRVSQ=$F(X,"'") ;find location of single quote in X
121 S GMRVDQ=$F(X,"""") ;find location of double quote in X
122 I GMRVDQ>0,GMRVDQ<GMRVSQ Q 0 ;quit if " is before '
123 I GMRVSQ>0,GMRVDQ>0,$E(X,GMRVSQ)="""" Q 0 ;quit if '" combination
124 Q 1
125 ;
Note: See TracBrowser for help on using the repository browser.