BEHOVM ;MSC/IND/DKM - Cover Sheet: Vital Measurements ;29-Apr-2014 13:35;DU
;;1.1;BEH COMPONENTS;**001003,001004,001005,001006,001009,001010**;Sep 18, 2007
;=================================================================
; RPC: Return patient's most recent vital measurements
; vfile ien^vital name^vital abbr^date/time taken^value+units (US & metric)^Pt status (in,out)
LIST(DATA,DFN,START,END,VITS,VSTR,METRIC,PTST,FSDATA) ;EP
N RMAX,O2
S RMAX=1
D QUERY("LISTX")
Q
; Format data for list view
LISTX N X
S X=RESULT(VUNT)_" "_$P(VUNT(VUNT),U)_U
S:VUNT(0)'=VUNT(1) X=X_RESULT('VUNT)_" "_$P(VUNT('VUNT),U)
I $G(O2)'="" S QUALIF=QUALIF_" "_O2 K O2 ;EHR11
D ADD(VIEN_U_VNAM_U_VABR_U_DATE_U_X_U_QUALIF)
Q
; RPC: Return last vital for a specific date range
LASTVIT(DATA,DFN,START,END,VITS,METRIC,FSDATA) ;EP
N VSTR,RMAX
S RMAX=1
D QUERY("LASTVITX")
Q
; Format data for list view
LASTVITX N X
S X=RESULT(VUNT)_" "_$P(VUNT(VUNT),U)_U
S:VUNT(0)'=VUNT(1) X=X_"("_RESULT('VUNT)_" "_$P(VUNT('VUNT),U)_")"
D ADD(VIEN_U_VABR_U_RESULT(VUNT)_U_DATE_U_X_U_QUALIF)
Q
; Return last vital for specified type
; Return format is: DT TAKEN^DFN^VTYP^VCTL^LOC^ENTERED BY^^RATE
LAST(DFN,VITS,METRIC,START,END) ;EP
N VSTR,RMAX,DATA,LAST
S RMAX=1
D QUERY("LASTX")
Q $G(LAST)
LASTX S LAST=DATE_U_DFN_U_VTYP_U_VCTL_U_LOC_U_ENTERBY_U_U_RESULT(METRIC)_U_QUALIF
Q
; RPC: Return data for grid view
GRID(DATA,DFN,START,END,RMAX,VITS,VSTR,METRIC,SD,FSDATA,PTST) ;EP
N CNT
S:'$G(RMAX) RMAX=$$GET^XPAR("ALL","BEHOVM MAX RETURN","GRID")
D QUERY("GRIDX",.CNT,.SD)
M @DATA@(0)=VITS
S @DATA@(0)=CNT(1)_U_CNT(2)_U_CNT(3)
Q
; Format for grid view
GRIDX I '$D(DATE(DATE(0))) D
.S CNT(2)=CNT(2)+1,DATE(DATE(0))=CNT(2)
.D ADD(CNT(2)_U_DATE(0),,DATE(0))
I $G(O2)'="" S QUALIF=QUALIF_":"_O2 K O2 ;EHR11
D ADD(DATE(DATE(0))_U_CNT(1)_U_RESULT(METRIC)_U_$$FLAG_U_VIEN_U_QUALIF,,"R")
I $G(COMMENT)'="" D ADD(DATE(DATE(0))_U_CNT(1)_U_VIEN_U_COMMENT,,"C")
S CNT(3)=CNT(3)+1
Q
; RPC: Return data for vital entry template
TEMPLATE(DATA,DFN,VSTR,METRIC) ;EP
N VITS,RMAX
S:'$P(VSTR,";",4) $P(VSTR,";",4)=-1
D VLIST(.VITS,"BEHOVM TEMPLATE",+VSTR)
;IHS/MSC/MGH Called now to truncate to 2 decimal places
S RMAX=$$GET^XPAR("ALL","BEHOVM MAX RETURN","TEMPLATE")
D GRID(.DATA,DFN,,,RMAX,.VITS,VSTR,.METRIC,2)
Q
; Return flag for abnormal
FLAG() N LO,HI,VAL
S LO=$P(VUNT(VUNT),U,2,3),HI=$P(LO,U,2),LO=$P(LO,U),VAL=RESULT(VUNT)
Q $S(VAL'=+VAL:"",$L(LO)&(VAL<LO):"L",$L(HI)&(VAL>HI):"H",1:"")
; RPC: Return data for detail view
DETAIL(DATA,DFN,START,END,RMAX,VITS,VSTR,METRIC) ;EP
D QUERY("DETAILX")
Q
; Format for detail view
DETAILX I '$D(DATE(DATE(0),LOC,ENTERBY)) D
.S CNT(2)=CNT(2)+1,DATE(DATE(0),LOC,ENTERBY)=CNT(2)
.D ADD("",,CNT(2))
.D ADD($$ENTRY^CIAUDT(DATE)_" Location: "_$P($G(^SC(LOC,0)),U)_" Entered by: "_$P($G(^VA(200,ENTERBY,0)),U),,CNT(2))
.D ADD($$REPEAT^XLFSTR("-",80),,CNT(2))
I $G(O2)'="" S QUALIF=QUALIF_" "_O2 K O2 ;EHR11
D ADD(RESULT(METRIC)_" "_$P(VUNT(METRIC),U)_" "_QUALIF," "_VNAM,DATE(DATE(0),LOC,ENTERBY))
Q
; Query logic for vitals
QUERY(RTN,CNT,SD) ;
N SEQ,VIEN,IDT,DATE,LOC,VTYP,VNAM,VCTL,VABR,RCNT,RESULT,ENTERBY,VMSR,VUNT,VSIT,QRY,DEFUNT,X,Y,Z
N QUALS,QUALIF,QUALN,QUALIEN,COMMENT,QARY
S DATA=$$TMPGBL^CIAVMRPC,START=+$G(START),END=+$G(END),RMAX=+$G(RMAX),VSTR=$G(VSTR),VSIT=+$P(VSTR,";",4),PTST=$G(PTST)
S (CNT,CNT(1),CNT(2),CNT(3),SEQ)=0
Q:'DFN
S:'START START=DT+1
S:START<END X=START,START=END,END=X
S START=9999999-$S(START#1:START,1:START+.9),END=9999999-END
S:'RMAX RMAX=99999999
I $D(VITS)=1,$L(VITS) S VITS(1)=VITS
D:$D(VITS)'>1 VLIST(.VITS,"BEHOVM VITAL LIST",+VSTR)
S VMSR=$$VMSR,METRIC=$G(METRIC,-1),METRIC=$S(METRIC<0:-1,METRIC>0:1,1:0),DEFUNT=METRIC<0
F S SEQ=$O(VITS(SEQ)) Q:'SEQ D
.S VCTL=+VITS(SEQ)
.D TYPEINFO(.VCTL,.VNAM,.VABR,.VUNT,VMSR,.VTYP)
.;I VCTL'>0!(VTYP'>0) K VITS(SEQ) Q
.S:DEFUNT METRIC=$$DEFUNIT(VCTL,VUNT)
.K QARY D GETCATS^BEHOVM2(.QARY,VABR)
.S VITS(SEQ)=VCTL_U_VTYP_U_VNAM_U_VABR_U_VUNT(METRIC)_U_$S($O(^BEHOVM(90460.01,VCTL,3,0)):"BEHOVM PCTILE",1:"")_U_($D(@(QARY))=10)
.S IDT=START,RCNT=0,CNT(1)=CNT(1)+1,QRY=$G(^BEHOVM(90460.01,VCTL,10))
.I $L(QRY) X QRY Q
.D QRYGMR:'VMSR,QRYMSR:VMSR
Q
; Query logic for Vitals package
QRYGMR F Q:'IDT!(IDT>END)!(RCNT=RMAX) D
.S VIEN=$C(1)
.S XREF="AA"
.F S VIEN=$O(^GMR(120.5,XREF,DFN,VTYP,IDT,VIEN),-1) Q:'VIEN D Q:RCNT=RMAX
..;IHS/MSC/MGH Quit if this vital was entered in error
..Q:$P($G(^GMR(120.5,VIEN,2)),U) S X=$G(^(0))
..Q:$P(X,U,2)'=DFN
..Q:$P(X,U,3)'=VTYP
..I VSIT,+$G(^GMR(120.5,VIEN,9000010))'=VSIT Q
..S RESULT(VUNT)=$$TRIM^XLFSTR($P(X,U,8)),DATE=+X,LOC=+$P(X,U,5),ENTERBY=+$P(X,U,6),RCNT=RCNT+1
..S DATE(0)=DATE*10000\1/10000
..;IHS/MSC/MGH Get qualifier informaton for GMR file patch 5
..S QUALIF="",COMMENT=""
..S QUALS=0 F S QUALS=$O(^GMR(120.5,VIEN,5,QUALS)) Q:QUALS="" D
...S QUALN=$P($G(^GMR(120.5,VIEN,5,QUALS,0)),U,1)
...I +QUALN S QUALN=$P($G(^GMRD(120.52,QUALN,0)),U,1)
...I QUALIF="" S QUALIF=QUALN
...E I QUALN'="" S QUALIF=QUALIF_"~"_QUALN
..D CALLBCK
.S IDT=$O(^GMR(120.5,"AA",DFN,VTYP,IDT))
Q
; Query logic for V file
QRYMSR D BLDXRF(VTYP)
F Q:'IDT!(RCNT=RMAX) D
.S VIEN=$C(1)
.F S VIEN=$O(^TMP("BEHOVM",$J,VTYP,IDT,VIEN),-1) Q:'VIEN D Q:RCNT=RMAX
..D GETMSR(VIEN,.X,.DATE,.LOC,.ENTERBY)
..S RESULT(VUNT)=X,RCNT=RCNT+1
..K O2 S O2=$P($G(^AUPNVMSR(VIEN,0)),U,10) ;EHR11
..S QUALIF=""
..S QUALS=0 F S QUALS=$O(^AUPNVMSR(VIEN,5,QUALS)) Q:'+QUALS D
...S QUALIEN=$P($G(^AUPNVMSR(VIEN,5,QUALS,0)),U,1)
...I +QUALIEN D
....S QUALN=$P($G(^GMRD(120.52,QUALIEN,0)),U,1)
....;S QUALIF=$S(QUALIF="":$S(RTN="GRIDX":QUALIEN_";"_QUALN,1:QUALN),1:$S(RTN="GRIDX":QUALIF_","_QUALIEN_";"_QUALN,1:QUALIF_","_QUALN))
....S QUALIF=$S(QUALIF="":QUALN,1:QUALIF_","_QUALN)
..D CALLBCK
.S IDT=$O(^TMP("BEHOVM",$J,VTYP,IDT))
K ^TMP("BEHOVM",$J)
Q
; Query logic for BMI
; Redone to use same logic as health summary
QRYBMI(PCTILE) ;
D QRYBMI^BEHOVM2(PCTILE)
Q
; Get measurement data
GETMSR(VIEN,RESULT,DATE,LOC,ENTERBY) ;
N X,X12,DATEE
S X=$G(^AUPNVMSR(VIEN,0)),X12=$G(^(12))
S DATEE=$P(X,U,7)
S DATE=+X12,ENTERBY=+$P(X12,U,4)
S RESULT=$$TRIM^XLFSTR($P(X,U,4)),X=+$P(X,U,3)
S X=$G(^AUPNVSIT(X,0))
S:'DATE DATE=+X
S LOC=+$P(X,U,22),DATE(0)=DATE*10000\1/10000
;IHS/MSC/MGH Get qualifier information patch 5
S QUALIF="" S COMMENT=""
I $D(^AUPNVMSR(VIEN,5))>0 D
.S QUALS=0 F S QUALS=$O(^AUPNVMSR(VIEN,5,QUALS)) Q:QUALS="" D
..S QUALN=$P($G(^AUPNVMSR(VIEN,5,QUALS,0)),U,1)
..I QUALN S QUALN=$P($G(^GMRD(120.52,QUALN,0)),U,1)
..I QUALIF="" S QUALIF=QUALN
..E S QUALIF=QUALIF_"~"_QUALN
I +$G(FSDATA)>0 D
.S COMMENT=$P($G(^AUPNVMSR(VIEN,811)),U,1)
Q
; Build temp xref for measurement type
BLDXRF(VTYP) ;
N X,Y,Z,TT,CVISIT,CTYPE,XREF,MDATE,EIE
S X=0
K ^TMP("BEHOVM",$J,VTYP)
;IHS/MSC/MGH Use different cross-reference if flowsheets
I +$G(FSDATA)>0 S XREF="AE"
E S XREF="AA"
F S X=$O(^AUPNVMSR(XREF,DFN,VTYP,X)),VIEN=0 Q:'X D
.F S VIEN=$O(^AUPNVMSR(XREF,DFN,VTYP,X,VIEN)) Q:'VIEN D
..S Z=$G(^AUPNVMSR(VIEN,0)),Y=+$G(^(12)),Y=$S(Y:9999999-Y,1:X)
..S Y=$S(XREF="AA":Y,1:X)
..Q:+Z'=VTYP
..Q:$P(Z,U,2)'=DFN
..I VSIT,$P(Z,U,3)'=VSIT Q
..S MDATE=$S(XREF="AA":Y,1:X)
..Q:MDATE<START
..Q:MDATE>END
..;IHS/MSC/MGH Quit if entered in error
..S EIE=$$GET1^DIQ(9000010.01,VIEN,2,"I")
..Q:EIE=1
..;IHS/MSC/MGH Check for inpt or outpt status
..I PTST="I"!(PTST="O") D
...S CVISIT=$P($G(^AUPNVMSR(VIEN,0)),U,3)
...I CVISIT'="" S CTYPE=$P($G(^AUPNVSIT(CVISIT,0)),U,7)
...I PTST="H"&(CTYPE="H") S ^TMP("BEHOVM",$J,VTYP,MDATE,VIEN)=""
...I PTST="O"&(CTYPE'="H") S ^TMP("BEHOVM",$J,VTYP,MDATE,VIEN)=""
..I PTST="" S ^TMP("BEHOVM",$J,VTYP,MDATE,VIEN)=""
Q
; Perform query callback
CALLBCK S RESULT('VUNT)=$$CONVERT(RESULT(VUNT),VUNT,.SD)
S RESULT(VUNT)=$$ROUND(RESULT(VUNT),.SD)
D @RTN
Q
; Return info for vital type
TYPEINFO(VCTL,VNAM,VABR,VUNT,VMSR,VTYP) ;EP
N X
S VCTL=$$VCTL(VCTL)
S X=$G(^BEHOVM(90460.01,VCTL,0))
I '$L(X) S (VNAM,VABR,VUNT,VCTL)="" Q
S VNAM=$P(X,U),VABR=$P(X,U,7)
S:'$D(VMSR) VMSR=$$VMSR
F X=VABR,VNAM D Q:VTYP
.S VTYP=$$VTYPE(X,VMSR)
;I 'VTYP S (VNAM,VABR,VUNT,VCTL)="" Q
D UNITS(.VUNT)
Q
; Returns IEN of vital control ien
VCTL(X) Q $S(X=+X:X,1:+$O(^BEHOVM(90460.01,"B",X,0)))
; Returns vital control IEN given measure type IEN
TYP2CTL(VTYP,VMSR) ;
N FNUM,X
S:'$D(VMSR) VMSR=$$VMSR
S FNUM=$S(VMSR:9999999.07,1:120.51)
S X=$$GET1^DIQ(FNUM,VTYP,.01)
S:$L(X) X=$$VCTL(X)
Q:X X
S X=$$GET1^DIQ(FNUM,VTYP,$S(VMSR:.02,1:7))
Q $S($L(X):$$VCTL(X),1:"")
; Gets vital type based on name or abbreviation
VTYPE(X,VMSR) ;
N FNUM
S:'$D(VMSR) VMSR=$$VMSR
S FNUM=$S(VMSR:9999999.07,1:120.51)
Q +$$FIND1^DIC(FNUM,"","X",$$UP^XLFSTR(X),"B^"_$S(VMSR:"D",1:"APCE^C"))
; Returns true if V file is used for vital measurements
VMSR() Q ''$$GET^XPAR("ALL","BEHOVM USE VMSR")
; Get default units
DEFUNIT(VCTL,VUNT) ;
N UNIT
D GETPAR^CIAVMRPC(.UNIT,"BEHOVM DEFAULT UNITS",,"`"_VCTL)
;S UNIT=$$GET^XPAR("ALL","BEHOVM DEFAULT UNITS","`"_VCTL)
I UNIT="" D
.D:$G(VUNT)="" TYPEINFO(VCTL,,,.VUNT)
.S UNIT=VUNT
Q UNIT
; Get vital list
; PRM = Name of parameter containing vital list
; LOC = Optional hosp location IEN
VLIST(DATA,PRM,LOC) ;
N ENT
S ENT=$$ENT^CIAVMRPC(PRM)
;S ENT=$S($G(LOC)>0:"ALL^LOC.`"_LOC,1:"ALL")
D GETLST^XPAR(.DATA,ENT,PRM,"I")
Q
; Return units+normal range
; .VUNT = Returned unit values as:
; VUNT = Default system (0=US, 1=Metric)
; VUNT(0) = US unit^LO^HI
; VUNT(1) = Metric unit^LO^HI
; Return value = US unit^LO^HI^Metric unit^LO^HI
UNITS(VUNT) ;
N LO,HI,X
I 'VCTL S VUNT=0,(VUNT(0),VUNT(1))="^^"
E D
.S X=^BEHOVM(90460.01,VCTL,0),VUNT=+$P(X,U,2),LO=$P(X,U,5),HI=$P(X,U,6)
.S VUNT(VUNT)=$P(X,U,3+VUNT)_U_LO_U_HI
.S VUNT('VUNT)=$P(X,U,4-VUNT)
.I '$L(VUNT('VUNT)) S VUNT('VUNT)=VUNT(VUNT)
.E S VUNT('VUNT)=VUNT('VUNT)_U_$$CONVERT(LO,VUNT)_U_$$CONVERT(HI,VUNT)
Q:$Q VUNT(0)_U_VUNT(1)
Q
; RPC: Return help text for vital type
HELP(DATA,VCTL) ;EP
M DATA=^BEHOVM(90460.01,VCTL,99)
K DATA(0)
S:$D(DATA)'>1 DATA(1)="No help is available for this item."
Q
; RPC: Return percentile values
PCTILE(DATA,VCTL,DFN,START,END,METRIC) ;EP
D PCTILE^BEHOVM2(.DATA,VCTL,DFN,START,END,.METRIC)
Q
; Round value to specified # fractional digits
ROUND(VAL,SD) ;
Q:VAL'=+VAL!($G(SD)=0) VAL
Q +$J(VAL,0,$S($D(SD):SD,VAL<1:2,VAL<10:2,1:2))
; Convert between metric and US
CONVERT(X,TOUS,SD) ;
Q:'VCTL!'$L(X) ""
X $G(^BEHOVM(90460.01,VCTL,$S(TOUS:2,1:1)))
S X=$$ROUND(X,.SD)
Q X
; Convert ff'ii" to inches
CVTFTIN(X) ;
N F,I
I X'["'",X'["""" Q X
S X=$TR(X," ")
I X["'" S F=$P(X,"'"),I=$P(X,"'",2,99) Q:F'=+F X
E S F=0,I=X
I $L(I) Q:$E(I,$L(I))'="""" X S I=$E(I,1,$L(I)-1) Q:I'=+I X
Q F*12+I_"IN"
; Valid blood pressure
VALIDBP(VAL,SLO,SHI,DLO,DHI) ;EP
N SBP,DBP
I VAL'?1.N1"/"1.N S VAL="-1^Format must be <systolic>/<diastolic>." Q
S SBP=+$P(VAL,"/"),DBP=+$P(VAL,"/",2)
D VALIDNUM(.SBP,SLO,SHI)
I SBP[U S VAL="-1^Systolic pressure "_$P(SBP," ",2,999) Q
D VALIDNUM(.DBP,DLO,DHI)
I DBP[U S VAL="-1^Diastolic pressure "_$P(DBP," ",2,999) Q
I SBP'>DBP S VAL="-1^Systolic BP<Diastolic BP" Q
S VAL=SBP_"/"_DBP
Q
; Validate integer value
VALIDINT(VAL,LO,HI,INC) ;EP
I VAL\1'=VAL S VAL="-1^Input must be an integer value." Q
D VALIDNUM(.VAL,LO,HI)
I $G(INC),VAL'[U,VAL#INC S VAL="-1^Input must be in increments of "_INC_"."
Q
; Validate numeric value
VALIDNUM(VAL,LO,HI) ;EP
I VAL'=+VAL S VAL="-1^Input must be a numeric value."
E I VAL<LO!(VAL>HI) D
.N UNT
.I VUNT'=METRIC S LO=$$CONVERT(LO,VUNT),HI=$$CONVERT(HI,VUNT),UNT=VUNT('VUNT)
.E S UNT=VUNT(VUNT)
.S VAL="-1^Input must be between "_LO_" and "_HI_" "_$P(UNT,U)_"."
Q
; Validate tonometric value
VALIDTON(VAL) ;EP
N LV,RV
S VAL=$$UP^XLFSTR(VAL)
I $L(VAL,"/")>2 S VAL=-1
E D
.S RV=$P(VAL,"/"),LV=$P(VAL,"/",2),VAL=""
.I $E(RV)="L" D Q:VAL
..I LV="" S LV=RV,RV=""
..E S VAL=-1
.D VT1(.RV,"R"),VT1(.LV,"L")
I VAL S:VAL'[U $P(VAL,U,2)="Invalid input format."
E S VAL=RV_$S($L(LV):"/",1:"")_LV
Q
VT1(TON,PFX) ;
S:$E(TON)=PFX TON=$E(TON,2,999)
Q:'$L(TON)
I $TR(TON,"0123456789")'="" S VAL=-1
E D
.S TON=+TON
.I TON>80 S VAL="-1^Value must be between 0 and 80, inclusive."
.E S TON=PFX_TON
Q
; RPC: Validate value X for measurement type VCTL
; Returns normalized value in DATA if valid, or -1^error if not
VALIDATE(DATA,VCTL,METRIC,X) ;EP
N VABR,VUNT,VMSR,LP,UNIT
D TYPEINFO(.VCTL,,,.VUNT)
S X=$$UP^XLFSTR($$TRIM^XLFSTR(X)),METRIC=$G(METRIC,-1),METRIC=$S(METRIC<0:$$DEFUNIT(VCTL,VUNT),METRIC>0:1,1:0),UNIT=-1
S X=$$CVTFTIN(X)
F LP=VUNT,1-VUNT D Q:UNIT>-1
.N Y,Z
.S Y=$$UP^XLFSTR($P(VUNT(LP),U))
.F Z=1:1:$L(Y) D Q:UNIT>-1
..S:$E(X,$L(X)-Z+1,99)=$E(Y,1,Z) UNIT=LP,X=$$TRIM^XLFSTR($E(X,1,$L(X)-Z))
S:UNIT<0 UNIT=METRIC
S:UNIT'=VUNT X=$$CONVERT(X,UNIT,0),UNIT=VUNT
X $G(^BEHOVM(90460.01,VCTL,4))
S:$G(X)="" X="-1^Invalid entry. Try again."
I X'[U,UNIT'=METRIC S X=$$CONVERT(X,UNIT,2)
S DATA=X
Q
; Normalize value for storage
NORM(VTYP,VAL,UNT,VMSR) ;EP
N VCTL,VUNT
S:'$D(VMSR) VMSR=$$VMSR
S VCTL=$S(VTYP=+VTYP:$$TYP2CTL(VTYP,VMSR),1:VTYP)
D TYPEINFO(.VCTL,,,.VUNT,VMSR,.VTYP)
Q:'VCTL!'VTYP "-1^Unrecognized measurement type."
Q:VAL=" " 0
D VALIDATE(.VAL,VCTL,VUNT,VAL_UNT)
Q:VAL[U VAL
S UNT=$P(VUNT(VUNT),U)
Q 0
; RPC: Store vitals data
SAVE(DATA,DFN,VITS) ;EP
N VMSR,LP,VCNT
S VMSR=$$VMSR,LP="",VCNT=0
;IHS/MSC/MGH EHR Patch 13 Reorder the array so that HT is first
D REORDER(.VITS)
F S LP=$O(VITS(LP)) Q:'LP D
.N VTYP,VAL,UNT,DEL,X
.S VITS=VITS(LP)
.Q:$E(VITS,1,3)'="VIT"
.S DEL=$P(VITS,U)["-",VTYP=$P(VITS,U,2)
.S VAL=$S(DEL:" ",1:$P(VITS,U,5)),UNT=$S(DEL:"",1:$P(VITS,U,7))
.I $$NORM(.VTYP,.VAL,.UNT,VMSR) S VCNT=VCNT+1
.E S $P(VITS,U,2)=VTYP,$P(VITS,U,5)=VAL,$P(VITS,U,7)=UNT,VITS(LP)=VITS
I VCNT S DATA="-1^"_$$SNGPLR^CIAU(VCNT," entry"," entries")_" failed validation. No results stored."
E D SAVE^BEHOENPC(.DATA,.VITS)
Q
REORDER(VITS) ;resort the list
N LP,CNT,LIST,CNT2
S CNT=0,CNT2=1,LP=""
F S LP=$O(VITS(LP)) Q:'LP D
.S CNT=LP
.I $E($P(VITS(LP),U,1),1,3)="VIT" D
..I $P(VITS(LP),U,2)="HT" D
...S LIST(1)=VITS(LP)
...K VITS(LP)
..E D
...S CNT2=CNT2+1
...S LIST(CNT2)=VITS(LP)
...K VITS(LP)
S I=""
F S I=$O(LIST(I)) Q:'I D
.S CNT=CNT+1
.S VITS(CNT)=LIST(I)
Q
; Add to output global
ADD(TXT,LBL,SUB) ;
S CNT=CNT+1,@DATA@($G(SUB,0),CNT)=$S($D(LBL):$$LJ^XLFSTR(LBL,20),1:"")_$G(TXT),LBL=""
Q
BEHOVM ;MSC/IND/DKM - Cover Sheet: Vital Measurements ;29-Apr-2014 13:35;DU
+1 ;;1.1;BEH COMPONENTS;**001003,001004,001005,001006,001009,001010**;Sep 18, 2007
+2 ;=================================================================
+3 ; RPC: Return patient's most recent vital measurements
+4 ; vfile ien^vital name^vital abbr^date/time taken^value+units (US & metric)^Pt status (in,out)
LIST(DATA,DFN,START,END,VITS,VSTR,METRIC,PTST,FSDATA) ;EP
+1 NEW RMAX,O2
+2 SET RMAX=1
+3 DO QUERY("LISTX")
+4 QUIT
+5 ; Format data for list view
LISTX NEW X
+1 SET X=RESULT(VUNT)_" "_$PIECE(VUNT(VUNT),U)_U
+2 IF VUNT(0)'=VUNT(1)
SET X=X_RESULT('VUNT)_" "_$PIECE(VUNT('VUNT),U)
+3 ;EHR11
IF $GET(O2)'=""
SET QUALIF=QUALIF_" "_O2
KILL O2
+4 DO ADD(VIEN_U_VNAM_U_VABR_U_DATE_U_X_U_QUALIF)
+5 QUIT
+6 ; RPC: Return last vital for a specific date range
LASTVIT(DATA,DFN,START,END,VITS,METRIC,FSDATA) ;EP
+1 NEW VSTR,RMAX
+2 SET RMAX=1
+3 DO QUERY("LASTVITX")
+4 QUIT
+5 ; Format data for list view
LASTVITX NEW X
+1 SET X=RESULT(VUNT)_" "_$PIECE(VUNT(VUNT),U)_U
+2 IF VUNT(0)'=VUNT(1)
SET X=X_"("_RESULT('VUNT)_" "_$PIECE(VUNT('VUNT),U)_")"
+3 DO ADD(VIEN_U_VABR_U_RESULT(VUNT)_U_DATE_U_X_U_QUALIF)
+4 QUIT
+5 ; Return last vital for specified type
+6 ; Return format is: DT TAKEN^DFN^VTYP^VCTL^LOC^ENTERED BY^^RATE
LAST(DFN,VITS,METRIC,START,END) ;EP
+1 NEW VSTR,RMAX,DATA,LAST
+2 SET RMAX=1
+3 DO QUERY("LASTX")
+4 QUIT $GET(LAST)
LASTX SET LAST=DATE_U_DFN_U_VTYP_U_VCTL_U_LOC_U_ENTERBY_U_U_RESULT(METRIC)_U_QUALIF
+1 QUIT
+2 ; RPC: Return data for grid view
GRID(DATA,DFN,START,END,RMAX,VITS,VSTR,METRIC,SD,FSDATA,PTST) ;EP
+1 NEW CNT
+2 IF '$GET(RMAX)
SET RMAX=$$GET^XPAR("ALL","BEHOVM MAX RETURN","GRID")
+3 DO QUERY("GRIDX",.CNT,.SD)
+4 MERGE @DATA@(0)=VITS
+5 SET @DATA@(0)=CNT(1)_U_CNT(2)_U_CNT(3)
+6 QUIT
+7 ; Format for grid view
GRIDX IF '$DATA(DATE(DATE(0)))
Begin DoDot:1
+1 SET CNT(2)=CNT(2)+1
SET DATE(DATE(0))=CNT(2)
+2 DO ADD(CNT(2)_U_DATE(0),,DATE(0))
End DoDot:1
+3 ;EHR11
IF $GET(O2)'=""
SET QUALIF=QUALIF_":"_O2
KILL O2
+4 DO ADD(DATE(DATE(0))_U_CNT(1)_U_RESULT(METRIC)_U_$$FLAG_U_VIEN_U_QUALIF,,"R")
+5 IF $GET(COMMENT)'=""
DO ADD(DATE(DATE(0))_U_CNT(1)_U_VIEN_U_COMMENT,,"C")
+6 SET CNT(3)=CNT(3)+1
+7 QUIT
+8 ; RPC: Return data for vital entry template
TEMPLATE(DATA,DFN,VSTR,METRIC) ;EP
+1 NEW VITS,RMAX
+2 IF '$PIECE(VSTR,";",4)
SET $PIECE(VSTR,";",4)=-1
+3 DO VLIST(.VITS,"BEHOVM TEMPLATE",+VSTR)
+4 ;IHS/MSC/MGH Called now to truncate to 2 decimal places
+5 SET RMAX=$$GET^XPAR("ALL","BEHOVM MAX RETURN","TEMPLATE")
+6 DO GRID(.DATA,DFN,,,RMAX,.VITS,VSTR,.METRIC,2)
+7 QUIT
+8 ; Return flag for abnormal
FLAG() NEW LO,HI,VAL
+1 SET LO=$PIECE(VUNT(VUNT),U,2,3)
SET HI=$PIECE(LO,U,2)
SET LO=$PIECE(LO,U)
SET VAL=RESULT(VUNT)
+2 QUIT $SELECT(VAL'=+VAL:"",$LENGTH(LO)&(VAL<LO):"L",$LENGTH(HI)&(VAL>HI):"H",1:"")
+3 ; RPC: Return data for detail view
DETAIL(DATA,DFN,START,END,RMAX,VITS,VSTR,METRIC) ;EP
+1 DO QUERY("DETAILX")
+2 QUIT
+3 ; Format for detail view
DETAILX IF '$DATA(DATE(DATE(0),LOC,ENTERBY))
Begin DoDot:1
+1 SET CNT(2)=CNT(2)+1
SET DATE(DATE(0),LOC,ENTERBY)=CNT(2)
+2 DO ADD("",,CNT(2))
+3 DO ADD($$ENTRY^CIAUDT(DATE)_" Location: "_$PIECE($GET(^SC(LOC,0)),U)_" Entered by: "_$PIECE($GET(^VA(200,ENTERBY,0)),U),,CNT(2))
+4 DO ADD($$REPEAT^XLFSTR("-",80),,CNT(2))
End DoDot:1
+5 ;EHR11
IF $GET(O2)'=""
SET QUALIF=QUALIF_" "_O2
KILL O2
+6 DO ADD(RESULT(METRIC)_" "_$PIECE(VUNT(METRIC),U)_" "_QUALIF," "_VNAM,DATE(DATE(0),LOC,ENTERBY))
+7 QUIT
+8 ; Query logic for vitals
QUERY(RTN,CNT,SD) ;
+1 NEW SEQ,VIEN,IDT,DATE,LOC,VTYP,VNAM,VCTL,VABR,RCNT,RESULT,ENTERBY,VMSR,VUNT,VSIT,QRY,DEFUNT,X,Y,Z
+2 NEW QUALS,QUALIF,QUALN,QUALIEN,COMMENT,QARY
+3 SET DATA=$$TMPGBL^CIAVMRPC
SET START=+$GET(START)
SET END=+$GET(END)
SET RMAX=+$GET(RMAX)
SET VSTR=$GET(VSTR)
SET VSIT=+$PIECE(VSTR,";",4)
SET PTST=$GET(PTST)
+4 SET (CNT,CNT(1),CNT(2),CNT(3),SEQ)=0
+5 IF 'DFN
QUIT
+6 IF 'START
SET START=DT+1
+7 IF START<END
SET X=START
SET START=END
SET END=X
+8 SET START=9999999-$SELECT(START#1:START,1:START+.9)
SET END=9999999-END
+9 IF 'RMAX
SET RMAX=99999999
+10 IF $DATA(VITS)=1
IF $LENGTH(VITS)
SET VITS(1)=VITS
+11 IF $DATA(VITS)'>1
DO VLIST(.VITS,"BEHOVM VITAL LIST",+VSTR)
+12 SET VMSR=$$VMSR
SET METRIC=$GET(METRIC,-1)
SET METRIC=$SELECT(METRIC<0:-1,METRIC>0:1,1:0)
SET DEFUNT=METRIC<0
+13 FOR
SET SEQ=$ORDER(VITS(SEQ))
IF 'SEQ
QUIT
Begin DoDot:1
+14 SET VCTL=+VITS(SEQ)
+15 DO TYPEINFO(.VCTL,.VNAM,.VABR,.VUNT,VMSR,.VTYP)
+16 ;I VCTL'>0!(VTYP'>0) K VITS(SEQ) Q
+17 IF DEFUNT
SET METRIC=$$DEFUNIT(VCTL,VUNT)
+18 KILL QARY
DO GETCATS^BEHOVM2(.QARY,VABR)
+19 SET VITS(SEQ)=VCTL_U_VTYP_U_VNAM_U_VABR_U_VUNT(METRIC)_U_$SELECT($ORDER(^BEHOVM(90460.01,VCTL,3,0)):"BEHOVM PCTILE",1:"")_U_($DATA(@(QARY))=10)
+20 SET IDT=START
SET RCNT=0
SET CNT(1)=CNT(1)+1
SET QRY=$GET(^BEHOVM(90460.01,VCTL,10))
+21 IF $LENGTH(QRY)
XECUTE QRY
QUIT
+22 IF 'VMSR
DO QRYGMR
IF VMSR
DO QRYMSR
End DoDot:1
+23 QUIT
+24 ; Query logic for Vitals package
QRYGMR FOR
IF 'IDT!(IDT>END)!(RCNT=RMAX)
QUIT
Begin DoDot:1
+1 SET VIEN=$CHAR(1)
+2 SET XREF="AA"
+3 FOR
SET VIEN=$ORDER(^GMR(120.5,XREF,DFN,VTYP,IDT,VIEN),-1)
IF 'VIEN
QUIT
Begin DoDot:2
+4 ;IHS/MSC/MGH Quit if this vital was entered in error
+5 IF $PIECE($GET(^GMR(120.5,VIEN,2)),U)
QUIT
SET X=$GET(^(0))
+6 IF $PIECE(X,U,2)'=DFN
QUIT
+7 IF $PIECE(X,U,3)'=VTYP
QUIT
+8 IF VSIT
IF +$GET(^GMR(120.5,VIEN,9000010))'=VSIT
QUIT
+9 SET RESULT(VUNT)=$$TRIM^XLFSTR($PIECE(X,U,8))
SET DATE=+X
SET LOC=+$PIECE(X,U,5)
SET ENTERBY=+$PIECE(X,U,6)
SET RCNT=RCNT+1
+10 SET DATE(0)=DATE*10000\1/10000
+11 ;IHS/MSC/MGH Get qualifier informaton for GMR file patch 5
+12 SET QUALIF=""
SET COMMENT=""
+13 SET QUALS=0
FOR
SET QUALS=$ORDER(^GMR(120.5,VIEN,5,QUALS))
IF QUALS=""
QUIT
Begin DoDot:3
+14 SET QUALN=$PIECE($GET(^GMR(120.5,VIEN,5,QUALS,0)),U,1)
+15 IF +QUALN
SET QUALN=$PIECE($GET(^GMRD(120.52,QUALN,0)),U,1)
+16 IF QUALIF=""
SET QUALIF=QUALN
+17 IF '$TEST
IF QUALN'=""
SET QUALIF=QUALIF_"~"_QUALN
End DoDot:3
+18 DO CALLBCK
End DoDot:2
IF RCNT=RMAX
QUIT
+19 SET IDT=$ORDER(^GMR(120.5,"AA",DFN,VTYP,IDT))
End DoDot:1
+20 QUIT
+21 ; Query logic for V file
QRYMSR DO BLDXRF(VTYP)
+1 FOR
IF 'IDT!(RCNT=RMAX)
QUIT
Begin DoDot:1
+2 SET VIEN=$CHAR(1)
+3 FOR
SET VIEN=$ORDER(^TMP("BEHOVM",$JOB,VTYP,IDT,VIEN),-1)
IF 'VIEN
QUIT
Begin DoDot:2
+4 DO GETMSR(VIEN,.X,.DATE,.LOC,.ENTERBY)
+5 SET RESULT(VUNT)=X
SET RCNT=RCNT+1
+6 ;EHR11
KILL O2
SET O2=$PIECE($GET(^AUPNVMSR(VIEN,0)),U,10)
+7 SET QUALIF=""
+8 SET QUALS=0
FOR
SET QUALS=$ORDER(^AUPNVMSR(VIEN,5,QUALS))
IF '+QUALS
QUIT
Begin DoDot:3
+9 SET QUALIEN=$PIECE($GET(^AUPNVMSR(VIEN,5,QUALS,0)),U,1)
+10 IF +QUALIEN
Begin DoDot:4
+11 SET QUALN=$PIECE($GET(^GMRD(120.52,QUALIEN,0)),U,1)
+12 ;S QUALIF=$S(QUALIF="":$S(RTN="GRIDX":QUALIEN_";"_QUALN,1:QUALN),1:$S(RTN="GRIDX":QUALIF_","_QUALIEN_";"_QUALN,1:QUALIF_","_QUALN))
+13 SET QUALIF=$SELECT(QUALIF="":QUALN,1:QUALIF_","_QUALN)
End DoDot:4
End DoDot:3
+14 DO CALLBCK
End DoDot:2
IF RCNT=RMAX
QUIT
+15 SET IDT=$ORDER(^TMP("BEHOVM",$JOB,VTYP,IDT))
End DoDot:1
+16 KILL ^TMP("BEHOVM",$JOB)
+17 QUIT
+18 ; Query logic for BMI
+19 ; Redone to use same logic as health summary
QRYBMI(PCTILE) ;
+1 DO QRYBMI^BEHOVM2(PCTILE)
+2 QUIT
+3 ; Get measurement data
GETMSR(VIEN,RESULT,DATE,LOC,ENTERBY) ;
+1 NEW X,X12,DATEE
+2 SET X=$GET(^AUPNVMSR(VIEN,0))
SET X12=$GET(^(12))
+3 SET DATEE=$PIECE(X,U,7)
+4 SET DATE=+X12
SET ENTERBY=+$PIECE(X12,U,4)
+5 SET RESULT=$$TRIM^XLFSTR($PIECE(X,U,4))
SET X=+$PIECE(X,U,3)
+6 SET X=$GET(^AUPNVSIT(X,0))
+7 IF 'DATE
SET DATE=+X
+8 SET LOC=+$PIECE(X,U,22)
SET DATE(0)=DATE*10000\1/10000
+9 ;IHS/MSC/MGH Get qualifier information patch 5
+10 SET QUALIF=""
SET COMMENT=""
+11 IF $DATA(^AUPNVMSR(VIEN,5))>0
Begin DoDot:1
+12 SET QUALS=0
FOR
SET QUALS=$ORDER(^AUPNVMSR(VIEN,5,QUALS))
IF QUALS=""
QUIT
Begin DoDot:2
+13 SET QUALN=$PIECE($GET(^AUPNVMSR(VIEN,5,QUALS,0)),U,1)
+14 IF QUALN
SET QUALN=$PIECE($GET(^GMRD(120.52,QUALN,0)),U,1)
+15 IF QUALIF=""
SET QUALIF=QUALN
+16 IF '$TEST
SET QUALIF=QUALIF_"~"_QUALN
End DoDot:2
End DoDot:1
+17 IF +$GET(FSDATA)>0
Begin DoDot:1
+18 SET COMMENT=$PIECE($GET(^AUPNVMSR(VIEN,811)),U,1)
End DoDot:1
+19 QUIT
+20 ; Build temp xref for measurement type
BLDXRF(VTYP) ;
+1 NEW X,Y,Z,TT,CVISIT,CTYPE,XREF,MDATE,EIE
+2 SET X=0
+3 KILL ^TMP("BEHOVM",$JOB,VTYP)
+4 ;IHS/MSC/MGH Use different cross-reference if flowsheets
+5 IF +$GET(FSDATA)>0
SET XREF="AE"
+6 IF '$TEST
SET XREF="AA"
+7 FOR
SET X=$ORDER(^AUPNVMSR(XREF,DFN,VTYP,X))
SET VIEN=0
IF 'X
QUIT
Begin DoDot:1
+8 FOR
SET VIEN=$ORDER(^AUPNVMSR(XREF,DFN,VTYP,X,VIEN))
IF 'VIEN
QUIT
Begin DoDot:2
+9 SET Z=$GET(^AUPNVMSR(VIEN,0))
SET Y=+$GET(^(12))
SET Y=$SELECT(Y:9999999-Y,1:X)
+10 SET Y=$SELECT(XREF="AA":Y,1:X)
+11 IF +Z'=VTYP
QUIT
+12 IF $PIECE(Z,U,2)'=DFN
QUIT
+13 IF VSIT
IF $PIECE(Z,U,3)'=VSIT
QUIT
+14 SET MDATE=$SELECT(XREF="AA":Y,1:X)
+15 IF MDATE<START
QUIT
+16 IF MDATE>END
QUIT
+17 ;IHS/MSC/MGH Quit if entered in error
+18 SET EIE=$$GET1^DIQ(9000010.01,VIEN,2,"I")
+19 IF EIE=1
QUIT
+20 ;IHS/MSC/MGH Check for inpt or outpt status
+21 IF PTST="I"!(PTST="O")
Begin DoDot:3
+22 SET CVISIT=$PIECE($GET(^AUPNVMSR(VIEN,0)),U,3)
+23 IF CVISIT'=""
SET CTYPE=$PIECE($GET(^AUPNVSIT(CVISIT,0)),U,7)
+24 IF PTST="H"&(CTYPE="H")
SET ^TMP("BEHOVM",$JOB,VTYP,MDATE,VIEN)=""
+25 IF PTST="O"&(CTYPE'="H")
SET ^TMP("BEHOVM",$JOB,VTYP,MDATE,VIEN)=""
End DoDot:3
+26 IF PTST=""
SET ^TMP("BEHOVM",$JOB,VTYP,MDATE,VIEN)=""
End DoDot:2
End DoDot:1
+27 QUIT
+28 ; Perform query callback
CALLBCK SET RESULT('VUNT)=$$CONVERT(RESULT(VUNT),VUNT,.SD)
+1 SET RESULT(VUNT)=$$ROUND(RESULT(VUNT),.SD)
+2 DO @RTN
+3 QUIT
+4 ; Return info for vital type
TYPEINFO(VCTL,VNAM,VABR,VUNT,VMSR,VTYP) ;EP
+1 NEW X
+2 SET VCTL=$$VCTL(VCTL)
+3 SET X=$GET(^BEHOVM(90460.01,VCTL,0))
+4 IF '$LENGTH(X)
SET (VNAM,VABR,VUNT,VCTL)=""
QUIT
+5 SET VNAM=$PIECE(X,U)
SET VABR=$PIECE(X,U,7)
+6 IF '$DATA(VMSR)
SET VMSR=$$VMSR
+7 FOR X=VABR,VNAM
Begin DoDot:1
+8 SET VTYP=$$VTYPE(X,VMSR)
End DoDot:1
IF VTYP
QUIT
+9 ;I 'VTYP S (VNAM,VABR,VUNT,VCTL)="" Q
+10 DO UNITS(.VUNT)
+11 QUIT
+12 ; Returns IEN of vital control ien
VCTL(X) QUIT $SELECT(X=+X:X,1:+$ORDER(^BEHOVM(90460.01,"B",X,0)))
+1 ; Returns vital control IEN given measure type IEN
TYP2CTL(VTYP,VMSR) ;
+1 NEW FNUM,X
+2 IF '$DATA(VMSR)
SET VMSR=$$VMSR
+3 SET FNUM=$SELECT(VMSR:9999999.07,1:120.51)
+4 SET X=$$GET1^DIQ(FNUM,VTYP,.01)
+5 IF $LENGTH(X)
SET X=$$VCTL(X)
+6 IF X
QUIT X
+7 SET X=$$GET1^DIQ(FNUM,VTYP,$SELECT(VMSR:.02,1:7))
+8 QUIT $SELECT($LENGTH(X):$$VCTL(X),1:"")
+9 ; Gets vital type based on name or abbreviation
VTYPE(X,VMSR) ;
+1 NEW FNUM
+2 IF '$DATA(VMSR)
SET VMSR=$$VMSR
+3 SET FNUM=$SELECT(VMSR:9999999.07,1:120.51)
+4 QUIT +$$FIND1^DIC(FNUM,"","X",$$UP^XLFSTR(X),"B^"_$SELECT(VMSR:"D",1:"APCE^C"))
+5 ; Returns true if V file is used for vital measurements
VMSR() QUIT ''$$GET^XPAR("ALL","BEHOVM USE VMSR")
+1 ; Get default units
DEFUNIT(VCTL,VUNT) ;
+1 NEW UNIT
+2 DO GETPAR^CIAVMRPC(.UNIT,"BEHOVM DEFAULT UNITS",,"`"_VCTL)
+3 ;S UNIT=$$GET^XPAR("ALL","BEHOVM DEFAULT UNITS","`"_VCTL)
+4 IF UNIT=""
Begin DoDot:1
+5 IF $GET(VUNT)=""
DO TYPEINFO(VCTL,,,.VUNT)
+6 SET UNIT=VUNT
End DoDot:1
+7 QUIT UNIT
+8 ; Get vital list
+9 ; PRM = Name of parameter containing vital list
+10 ; LOC = Optional hosp location IEN
VLIST(DATA,PRM,LOC) ;
+1 NEW ENT
+2 SET ENT=$$ENT^CIAVMRPC(PRM)
+3 ;S ENT=$S($G(LOC)>0:"ALL^LOC.`"_LOC,1:"ALL")
+4 DO GETLST^XPAR(.DATA,ENT,PRM,"I")
+5 QUIT
+6 ; Return units+normal range
+7 ; .VUNT = Returned unit values as:
+8 ; VUNT = Default system (0=US, 1=Metric)
+9 ; VUNT(0) = US unit^LO^HI
+10 ; VUNT(1) = Metric unit^LO^HI
+11 ; Return value = US unit^LO^HI^Metric unit^LO^HI
UNITS(VUNT) ;
+1 NEW LO,HI,X
+2 IF 'VCTL
SET VUNT=0
SET (VUNT(0),VUNT(1))="^^"
+3 IF '$TEST
Begin DoDot:1
+4 SET X=^BEHOVM(90460.01,VCTL,0)
SET VUNT=+$PIECE(X,U,2)
SET LO=$PIECE(X,U,5)
SET HI=$PIECE(X,U,6)
+5 SET VUNT(VUNT)=$PIECE(X,U,3+VUNT)_U_LO_U_HI
+6 SET VUNT('VUNT)=$PIECE(X,U,4-VUNT)
+7 IF '$LENGTH(VUNT('VUNT))
SET VUNT('VUNT)=VUNT(VUNT)
+8 IF '$TEST
SET VUNT('VUNT)=VUNT('VUNT)_U_$$CONVERT(LO,VUNT)_U_$$CONVERT(HI,VUNT)
End DoDot:1
+9 IF $QUIT
QUIT VUNT(0)_U_VUNT(1)
+10 QUIT
+11 ; RPC: Return help text for vital type
HELP(DATA,VCTL) ;EP
+1 MERGE DATA=^BEHOVM(90460.01,VCTL,99)
+2 KILL DATA(0)
+3 IF $DATA(DATA)'>1
SET DATA(1)="No help is available for this item."
+4 QUIT
+5 ; RPC: Return percentile values
PCTILE(DATA,VCTL,DFN,START,END,METRIC) ;EP
+1 DO PCTILE^BEHOVM2(.DATA,VCTL,DFN,START,END,.METRIC)
+2 QUIT
+3 ; Round value to specified # fractional digits
ROUND(VAL,SD) ;
+1 IF VAL'=+VAL!($GET(SD)=0)
QUIT VAL
+2 QUIT +$JUSTIFY(VAL,0,$SELECT($DATA(SD):SD,VAL<1:2,VAL<10:2,1:2))
+3 ; Convert between metric and US
CONVERT(X,TOUS,SD) ;
+1 IF 'VCTL!'$LENGTH(X)
QUIT ""
+2 XECUTE $GET(^BEHOVM(90460.01,VCTL,$SELECT(TOUS:2,1:1)))
+3 SET X=$$ROUND(X,.SD)
+4 QUIT X
+5 ; Convert ff'ii" to inches
CVTFTIN(X) ;
+1 NEW F,I
+2 IF X'["'"
IF X'[""""
QUIT X
+3 SET X=$TRANSLATE(X," ")
+4 IF X["'"
SET F=$PIECE(X,"'")
SET I=$PIECE(X,"'",2,99)
IF F'=+F
QUIT X
+5 IF '$TEST
SET F=0
SET I=X
+6 IF $LENGTH(I)
IF $EXTRACT(I,$LENGTH(I))'=""""
QUIT X
SET I=$EXTRACT(I,1,$LENGTH(I)-1)
IF I'=+I
QUIT X
+7 QUIT F*12+I_"IN"
+8 ; Valid blood pressure
VALIDBP(VAL,SLO,SHI,DLO,DHI) ;EP
+1 NEW SBP,DBP
+2 IF VAL'?1.N1"/"1.N
SET VAL="-1^Format must be <systolic>/<diastolic>."
QUIT
+3 SET SBP=+$PIECE(VAL,"/")
SET DBP=+$PIECE(VAL,"/",2)
+4 DO VALIDNUM(.SBP,SLO,SHI)
+5 IF SBP[U
SET VAL="-1^Systolic pressure "_$PIECE(SBP," ",2,999)
QUIT
+6 DO VALIDNUM(.DBP,DLO,DHI)
+7 IF DBP[U
SET VAL="-1^Diastolic pressure "_$PIECE(DBP," ",2,999)
QUIT
+8 IF SBP'>DBP
SET VAL="-1^Systolic BP<Diastolic BP"
QUIT
+9 SET VAL=SBP_"/"_DBP
+10 QUIT
+11 ; Validate integer value
VALIDINT(VAL,LO,HI,INC) ;EP
+1 IF VAL\1'=VAL
SET VAL="-1^Input must be an integer value."
QUIT
+2 DO VALIDNUM(.VAL,LO,HI)
+3 IF $GET(INC)
IF VAL'[U
IF VAL#INC
SET VAL="-1^Input must be in increments of "_INC_"."
+4 QUIT
+5 ; Validate numeric value
VALIDNUM(VAL,LO,HI) ;EP
+1 IF VAL'=+VAL
SET VAL="-1^Input must be a numeric value."
+2 IF '$TEST
IF VAL<LO!(VAL>HI)
Begin DoDot:1
+3 NEW UNT
+4 IF VUNT'=METRIC
SET LO=$$CONVERT(LO,VUNT)
SET HI=$$CONVERT(HI,VUNT)
SET UNT=VUNT('VUNT)
+5 IF '$TEST
SET UNT=VUNT(VUNT)
+6 SET VAL="-1^Input must be between "_LO_" and "_HI_" "_$PIECE(UNT,U)_"."
End DoDot:1
+7 QUIT
+8 ; Validate tonometric value
VALIDTON(VAL) ;EP
+1 NEW LV,RV
+2 SET VAL=$$UP^XLFSTR(VAL)
+3 IF $LENGTH(VAL,"/")>2
SET VAL=-1
+4 IF '$TEST
Begin DoDot:1
+5 SET RV=$PIECE(VAL,"/")
SET LV=$PIECE(VAL,"/",2)
SET VAL=""
+6 IF $EXTRACT(RV)="L"
Begin DoDot:2
+7 IF LV=""
SET LV=RV
SET RV=""
+8 IF '$TEST
SET VAL=-1
End DoDot:2
IF VAL
QUIT
+9 DO VT1(.RV,"R")
DO VT1(.LV,"L")
End DoDot:1
+10 IF VAL
IF VAL'[U
SET $PIECE(VAL,U,2)="Invalid input format."
+11 IF '$TEST
SET VAL=RV_$SELECT($LENGTH(LV):"/",1:"")_LV
+12 QUIT
VT1(TON,PFX) ;
+1 IF $EXTRACT(TON)=PFX
SET TON=$EXTRACT(TON,2,999)
+2 IF '$LENGTH(TON)
QUIT
+3 IF $TRANSLATE(TON,"0123456789")'=""
SET VAL=-1
+4 IF '$TEST
Begin DoDot:1
+5 SET TON=+TON
+6 IF TON>80
SET VAL="-1^Value must be between 0 and 80, inclusive."
+7 IF '$TEST
SET TON=PFX_TON
End DoDot:1
+8 QUIT
+9 ; RPC: Validate value X for measurement type VCTL
+10 ; Returns normalized value in DATA if valid, or -1^error if not
VALIDATE(DATA,VCTL,METRIC,X) ;EP
+1 NEW VABR,VUNT,VMSR,LP,UNIT
+2 DO TYPEINFO(.VCTL,,,.VUNT)
+3 SET X=$$UP^XLFSTR($$TRIM^XLFSTR(X))
SET METRIC=$GET(METRIC,-1)
SET METRIC=$SELECT(METRIC<0:$$DEFUNIT(VCTL,VUNT),METRIC>0:1,1:0)
SET UNIT=-1
+4 SET X=$$CVTFTIN(X)
+5 FOR LP=VUNT,1-VUNT
Begin DoDot:1
+6 NEW Y,Z
+7 SET Y=$$UP^XLFSTR($PIECE(VUNT(LP),U))
+8 FOR Z=1:1:$LENGTH(Y)
Begin DoDot:2
+9 IF $EXTRACT(X,$LENGTH(X)-Z+1,99)=$EXTRACT(Y,1,Z)
SET UNIT=LP
SET X=$$TRIM^XLFSTR($EXTRACT(X,1,$LENGTH(X)-Z))
End DoDot:2
IF UNIT>-1
QUIT
End DoDot:1
IF UNIT>-1
QUIT
+10 IF UNIT<0
SET UNIT=METRIC
+11 IF UNIT'=VUNT
SET X=$$CONVERT(X,UNIT,0)
SET UNIT=VUNT
+12 XECUTE $GET(^BEHOVM(90460.01,VCTL,4))
+13 IF $GET(X)=""
SET X="-1^Invalid entry. Try again."
+14 IF X'[U
IF UNIT'=METRIC
SET X=$$CONVERT(X,UNIT,2)
+15 SET DATA=X
+16 QUIT
+17 ; Normalize value for storage
NORM(VTYP,VAL,UNT,VMSR) ;EP
+1 NEW VCTL,VUNT
+2 IF '$DATA(VMSR)
SET VMSR=$$VMSR
+3 SET VCTL=$SELECT(VTYP=+VTYP:$$TYP2CTL(VTYP,VMSR),1:VTYP)
+4 DO TYPEINFO(.VCTL,,,.VUNT,VMSR,.VTYP)
+5 IF 'VCTL!'VTYP
QUIT "-1^Unrecognized measurement type."
+6 IF VAL=" "
QUIT 0
+7 DO VALIDATE(.VAL,VCTL,VUNT,VAL_UNT)
+8 IF VAL[U
QUIT VAL
+9 SET UNT=$PIECE(VUNT(VUNT),U)
+10 QUIT 0
+11 ; RPC: Store vitals data
SAVE(DATA,DFN,VITS) ;EP
+1 NEW VMSR,LP,VCNT
+2 SET VMSR=$$VMSR
SET LP=""
SET VCNT=0
+3 ;IHS/MSC/MGH EHR Patch 13 Reorder the array so that HT is first
+4 DO REORDER(.VITS)
+5 FOR
SET LP=$ORDER(VITS(LP))
IF 'LP
QUIT
Begin DoDot:1
+6 NEW VTYP,VAL,UNT,DEL,X
+7 SET VITS=VITS(LP)
+8 IF $EXTRACT(VITS,1,3)'="VIT"
QUIT
+9 SET DEL=$PIECE(VITS,U)["-"
SET VTYP=$PIECE(VITS,U,2)
+10 SET VAL=$SELECT(DEL:" ",1:$PIECE(VITS,U,5))
SET UNT=$SELECT(DEL:"",1:$PIECE(VITS,U,7))
+11 IF $$NORM(.VTYP,.VAL,.UNT,VMSR)
SET VCNT=VCNT+1
+12 IF '$TEST
SET $PIECE(VITS,U,2)=VTYP
SET $PIECE(VITS,U,5)=VAL
SET $PIECE(VITS,U,7)=UNT
SET VITS(LP)=VITS
End DoDot:1
+13 IF VCNT
SET DATA="-1^"_$$SNGPLR^CIAU(VCNT," entry"," entries")_" failed validation. No results stored."
+14 IF '$TEST
DO SAVE^BEHOENPC(.DATA,.VITS)
+15 QUIT
REORDER(VITS) ;resort the list
+1 NEW LP,CNT,LIST,CNT2
+2 SET CNT=0
SET CNT2=1
SET LP=""
+3 FOR
SET LP=$ORDER(VITS(LP))
IF 'LP
QUIT
Begin DoDot:1
+4 SET CNT=LP
+5 IF $EXTRACT($PIECE(VITS(LP),U,1),1,3)="VIT"
Begin DoDot:2
+6 IF $PIECE(VITS(LP),U,2)="HT"
Begin DoDot:3
+7 SET LIST(1)=VITS(LP)
+8 KILL VITS(LP)
End DoDot:3
+9 IF '$TEST
Begin DoDot:3
+10 SET CNT2=CNT2+1
+11 SET LIST(CNT2)=VITS(LP)
+12 KILL VITS(LP)
End DoDot:3
End DoDot:2
End DoDot:1
+13 SET I=""
+14 FOR
SET I=$ORDER(LIST(I))
IF 'I
QUIT
Begin DoDot:1
+15 SET CNT=CNT+1
+16 SET VITS(CNT)=LIST(I)
End DoDot:1
+17 QUIT
+18 ; Add to output global
ADD(TXT,LBL,SUB) ;
+1 SET CNT=CNT+1
SET @DATA@($GET(SUB,0),CNT)=$SELECT($DATA(LBL):$$LJ^XLFSTR(LBL,20),1:"")_$GET(TXT)
SET LBL=""
+2 QUIT
