VENPCC1M ; IHS/OIT/GIS - MEASUREMENTS FOR CLASSIC PCC+
;;2.6;PCC+;**4**;APR 03, 2012;Build 24
; PATCHED BY GIS/OIT 4/21/06 ; PCC + VERSION 2.5, PATCH 4
; PATCHED AGAIN FOR PCC+ 2.6, PATCH 4
;
;
MSR(DFN,CV,DEFEF) ; EP - STANDARD MEASUREMENTS
N VSFLAG,METRIC,DOB,%,SEX,HCFLAG,IDT,X,Y,Z,WCIEN,PCE,MN,FMDT,VDT,VIEN,M,QIEN,STOP,AGE,MAGE
S CV=$G(CV) I 'CV Q
S %=$G(^DPT(+$G(DFN),0)),DOB=$P(%,U,3),SEX=$P(%,U,2),METRIC=0,PCTILE=0
I 'DOB!'$L(SEX) G ETV
S AGE=(DT-DOB)\10000
S HCFLAG=(AGE<2) ; HEAD CIRC VS BMI
S MAGE=0
I AGE<18 S MAGE=$$FMDIFF^XLFDT(DT,DOB,1)\30.5 ; APPEND %ILE TO VALUE
ETV I $P($G(^VEN(7.41,+$G(DEFEF),14)),U,7),$D(^AUPNVSIT(+$G(CV),0)) S VSFLAG=$G(CV) ; EXCLUDE TODAYS VALUES FROM TABLE
S METRIC=$P($G(^VEN(7.41,+$G(DEFEF),0)),U,15) ; METRIC UNITS ; PATCHED BY GIS/OIT 6/12/06 ; PCC + VERSION 2.5, PATCH 5
I METRIC=2,$G(AGE) S METRIC=1
D BP(DFN),WT(DFN,MAGE),HT(DFN,MAGE),BMI(DFN),HC(DFN),O2(DFN),PA(DFN),PF(DFN),VS(CV,DFN,MAGE)
S X="ASQ"_U_"VENPCCQ" X "I $L($T("_X_"))" I D @X
Q
;
VS(CV,DFN,MAGE) ; EP - DISPLAY TODAY'S VS & MEASUREMENTS IN c26 AND AS INDIVIUAL MM FIELDS
; PATCHED BY GIS/OIT 4/21/06 ; PCC + VERSION 2.5, PATCH 5
N MIEN,STG,MSR,X,VAL,BMI,PCT,MMN,%,VDT
CKVISIT ; ABSOLUTELY CONFIRM THAT THE VS ARE ASSOCIATED WITH THE CORRECT/CURRENT VISIT
S VDT=+$G(^AUPNVSIT(+$G(CV),0)) I 'VDT Q ; MUST BE A VALID VISIT
I '$G(DEPTIEN) Q ; MAKE SURE THAT A VALID PCC+ CLINIC HAS BEEN DEFINED
I $P(^AUPNVSIT(CV,0),U,5)'=DFN Q ; PT MUST MATCH VISIT
I VDT<$$FMADD^XLFDT($$NOW^VENPCCU,0,-6,0,0) Q ; VISIT MUST BE WITHIN THE PAST 6 HRS
I $P(^AUPNVSIT(CV,0),U,8)'=$P($G(^VEN(7.95,DEPTIEN,0)),U,4) Q ; PCC+ CLINIC MUST MATCH THE VISIT'S CLINIC STOP
I '$D(^AUPNVMSR("AD",CV)) Q ; AT LEAST 1 VS MUST BE ASSOCIATED WITH THIS VISIT, OR QUIT NOW
GETVS S MIEN=0,STG=""
F S MIEN=$O(^AUPNVMSR("AD",+$G(CV),MIEN)) Q:'MIEN D ; FOR EA. MEASUREMENT FROM TODAY'S VISIT, THE LAST VALUE IS PLACED INT THE MSR ARRAY
. S X=$G(^AUPNVMSR(MIEN,0))
. S MMN=$P($G(^AUTTMSR(+X,0)),U) I '$L(MMN) Q
. S VAL=$P(X,U,4) I '$L(X) Q
. S MSR(MMN)=VAL
. I VAL?1.N1"."2.N S VAL=$J(VAL,"",2) ; PATCHED BY GIS 3/2/07
. Q
K BMI I $G(MSR("WT")) S BMI=$$TBMI(MSR("WT"),$G(MSR("HT")),DFN) ; COMPUTE TODAY'S BMI
I $D(MSR("HT")) D ; HT
. S PCT=""
. I MAGE,$G(MSR("HT")) S PCT=$$AUHTWT^APCHS2A2("HT",SEX,MAGE,MSR("HT"))
. I METRIC,$G(MSR("HT")) S MSR("HT")=$$LENGTH^XLFMSMT(MSR("HT"),"IN","CM")
. I PCT S MSR("HT")=MSR("HT")_" ("_PCT_"%)"
. S STG="Ht: "_MSR("HT")_" "
. S @TMP@("ht")=MSR("HT")
. Q
I $D(MSR("WT")) D ; WT
. S PCT=""
. I MAGE,MSR("WT") S PCT=$$AUHTWT^APCHS2A2("WT",SEX,MAGE,MSR("WT"))
. I METRIC S MSR("WT")=$$WEIGHT^XLFMSMT(MSR("WT"),"LB","KG")
. S STG=STG_"Wt: "_MSR("WT")_" "
. S @TMP@("wt")=MSR("WT")
. Q
I $L($G(BMI)) S STG=STG_"BMI: "_BMI_" " S @TMP@("bmi")=BMI ; BMI
I $D(MSR("HC")) S STG=STG_"Head Circ: "_MSR("HC")_" " S @TMP@("hc")=MSR("HC") ; HC
I $D(MSR("BP")) S STG=STG_"B/P: "_MSR("BP")_" " S @TMP@("bp")=MSR("BP") ; BP
I $D(MSR("TMP")) S STG=STG_"Temp: "_MSR("TMP")_" " S @TMP@("tmp")=MSR("TMP") ; TMP
I $D(MSR("PU")) S STG=STG_"Pulse: "_MSR("PU")_" " S @TMP@("pu")=MSR("PU") ; PU
I $D(MSR("RS")) S STG=STG_"Resp: "_MSR("RS")_" " S @TMP@("rs")=MSR("RS") ; RS
I $D(MSR("PA")) S STG=STG_"Pain: "_MSR("PA")_" " S @TMP@("pa")=MSR("PA") ; PA
I $D(MSR("O2")) S STG=STG_"O2 Sat: "_MSR("O2")_" " S @TMP@("o2")=MSR("O2") ; O2
I $D(MSR("PF")) S STG=STG_"Peak Flow: "_MSR("PF")_" " S @TMP@("pf")=MSR("PF") ; PF
S @TMP@("c26")=STG
Q
;
TBMI(WT,HT,DFN) ; EP - COMPUTE TODAY'S BMI
N BMI
I '$G(WT) Q ""
I '$G(DFN) Q ""
I '$G(HT) S HT=$$CHT(DFN,DT) I 'HT Q "" ; IF AGE>20, GET MOST RECENT HT
S BMI=$J(((WT/(HT*HT))*703),0,1)
Q BMI
;
CHT(DFN,XDT) ; EP - RETURN THE COMPUTED HEIGHT
N AGE,DOB,IDT,HT,MIEN,DATE
S DOB=$P(^DPT(DFN,0),U,3) I 'DOB Q ""
S AGE=XDT-DOB\10000 I AGE<21 Q "" ; PATIENT MUST BE OVER 21
S IDT=$O(^AUPNVMSR("AA",DFN,1,0)) I 'IDT Q ""
S DATE=9999999-IDT ; GET DATE OF LAST HT
I DATE-DOB\10000<21 Q "" ; LAST HT MEASUREMENT MUST BE TAKE AFTER PATIENT'S 21ST BIRTHDAY
I AGE>60,XDT-DATE\10000>2 Q "" ; IF OVER 60, MUST HAVE A HT AT LEAST EVERY 3 YEARS
S MIEN=$O(^AUPNVMSR("AA",DFN,1,IDT,0)) I 'MIEN Q ""
S HT=$P($G(^AUPNVMSR(MIEN,0)),U,4)
Q HT
;
BMI(DFN) ; EP - GET LAST 5 BMIs (bmi1-bmi5)
I $G(HCFLAG) Q ; LESS THAN AGE 2
N BMI,IDT,DATE,AGE,DOB,MIEN,WT,HT,STG,CNT,XDT
S IDT=0,STG="",CNT=0
F S IDT=$O(^AUPNVMSR("AA",DFN,2,IDT)) Q:'IDT D I CNT=5 Q
. S MIEN=$O(^AUPNVMSR("AA",DFN,2,IDT,0)) I 'MIEN Q
. S WT=$P($G(^AUPNVMSR(MIEN,0)),U,4) I 'WT Q
. S MIEN=+$O(^AUPNVMSR("AA",DFN,1,IDT,0))
. S HT=$P($G(^AUPNVMSR(MIEN,0)),U,4)
. S XDT=9999999-IDT
. I 'HT S HT=$$CHT(DFN,XDT) I 'HT Q
. S BMI=$J(((WT/(HT*HT))*703),0,1)
. S DATE=$$FMTE^XLFDT(XDT,"2D")
. I $L(STG) S STG=STG_U
. S STG=STG_BMI_"|"_DATE
. S CNT=CNT+1
. Q
D MSET(STG,"bmi","")
S @TMP@("msrhdr")="BMI"
Q
;
RESP(DFN) ; EP - RESPIRATORY INFO
D FEV(DFN) D FEF(DFN) D BPF(DFN) D ETS(DFN) D PART(DFN) D DUST(DFN) ; ASTHMA INFO
Q
;
BP(DFN) ; EP - GET LAST 5 B/Ps (bp1-bp5)
N STG,MN
S STG=$$MRES(+$G(DFN),"BP",5) I '$L(STG) Q
S MN="bp"
D MSET(STG,MN,"")
Q
;
WT(DFN,MAGE) ; EP - GET LAST 5 WTs (wt1-wt5)
N STG,MN
S STG=$$MRES(+$G(DFN),"WT",5,MAGE) I '$L(STG) Q
S MN="wt"
D MSET(STG,MN,"")
Q
;
HT(DFN,MAGE) ; EP - GET LAST 5 HEIGHTS (ht1-ht5)
N STG,MN
S STG=$$MRES(+$G(DFN),"HT",5,MAGE) I '$L(STG) Q
S MN="ht"
D MSET(STG,MN,"")
Q
;
HC(DFN) ; EP - GET LAST 5 HEAD CIRCs (hc1-hc5)
I '$G(HCFLAG) Q
N STG,MN
S STG=$$MRES(+$G(DFN),"HC",5) I '$L(STG) Q
S MN="hc"
D MSET(STG,MN,"")
S @TMP@("msrhdr")="HC"
Q
;
PA(DFN) ; EP - GET LAST 5 PAIN ASSESSMENTS (pa1-pa5)
I '$G(HCFLAG) Q
N STG,MN
S STG=$$MRES(+$G(DFN),"PA",5) I '$L(STG) Q
S MN="pa"
D MSET(STG,MN,"")
S @TMP@("msrhdr")="HC"
Q
;
O2(DFN) ; EP - GET LAST 5 O2 SATS (o21-o25)
N STG,MN
S STG=$$MRES(+$G(DFN),"O2",5) I '$L(STG) Q
S MN="o2"
D MSET(STG,MN,"")
Q
;
PF(DFN) ; EP - GET LAST 5 PEAK FLOW RESULTS (pf1-pf5)
N STG,MN
S STG=$$MRES(+$G(DFN),"PF",5) I '$L(STG) Q
S MN="pf"
D MSET(STG,MN,"")
Q
;
FEV(DFN) ; EP - GET LAST FEV (fev)
N MN
S MN="fev"
D LAST(DFN,5,MN)
Q
;
FEF(DFN) ; EP - GET LAST FEF (fef)
N MN
S MN="fef"
D LAST(DFN,6,MN)
Q
;
BPF(DFN) ; EP - GET LAST BEST PEAK FLOW (bpf)
N MN
S MN="bpf"
D LAST(DFN,7,MN)
Q
;
ETS(DFN) ; EP - GET LAST ETS (ets)
N MN
S MN="ets"
D LAST(DFN,8,MN)
Q
;
PART(DFN) ; EP-GET LAST PARTICULATE MATTER (part)
N MN
S MN="part"
D LAST(DFN,9,MN)
Q
;
DUST(DFN) ; EP-GET LAT DUST MITE (dust)
N MN
S MN="dust"
D LAST(DFN,11,MN)
Q
;
MSET(STG,MN,TITLE,NOCNT) ; EP-SET MAIL MERGE NODES FOR RESULTS
N TOT,CNT,PCE,VAL,DATE,RES,X
I '$D(TMP) Q
I '$L($G(STG)) Q
I '$L(MN) Q
S TOT=$L(STG,U) I 'TOT Q
S CNT=0
F PCE=1:1:TOT S X=$P(STG,U,PCE) D
. I '$L(X) Q
. S VAL=$P(X,"|") I '$L(VAL) Q
. I VAL?1.N1"."2.N S VAL=$J(VAL,"",2) ; PATCHED BY GIS 4/26/11
. S DATE=$P(X,"|",2) I '$L(DATE) Q
. S RES="" I $L(TITLE) S RES=TITLE_": "
. S RES=RES_VAL_" ["_DATE_"]"
. S CNT=CNT+1
. I $G(NOCNT) S @TMP@(MN,1)=RES Q
. S @TMP@(MN_CNT)=RES
. Q
Q
;
MRES(DFN,MMN,MAX,MAGE) ; EP-GIVEN PATIENT DFN, MEASUREMENT TYPE IEN AND MAX # RETURN A RESULT STG: VAL|FMDT^VAL|FMDT...
; PATCHED BY GIS/OIT 8/18/06 ; PCC + VERSION 2.5, PATCH 6 ; %ILES AND METRIC CONVERSIONS ADDED
I $D(^DPT(+$G(DFN),0)),$L($G(MMN))
E Q ""
N IDT,FMDT,DATE,RESULT,MIEN,X,TOT,VIEN,STG,VAL,STOP,MSS
S MSS=$O(^AUTTMSR("B",MMN,0)) I 'MSS Q ""
I '$D(^AUPNVMSR("AA",+$G(DFN),+$G(MSS))) Q ""
S IDT=0,TOT=0,STG="",STOP=0
I '$G(MAX) S MAX=1
F S IDT=$O(^AUPNVMSR("AA",DFN,MSS,IDT)) Q:'IDT D I STOP Q
. S MIEN=9999999999
. F S MIEN=$O(^AUPNVMSR("AA",DFN,MSS,IDT,MIEN),-1) Q:'MIEN D I STOP Q
.. S X=$G(^AUPNVMSR(MIEN,0)) I '$L(X) Q
.. S VAL=$P(X,U,4) I '$L(VAL) Q
.. S VIEN=$P(X,U,3) I 'VIEN Q
.. I VIEN=$G(VSFLAG) Q ; EXCLUDE TODAY'S MEASUREMENTS.
.. S FMDT=+$G(^AUPNVSIT(VIEN,0)) I 'FMDT Q
.. S DATE=$$FMTE^XLFDT(FMDT,"2D") I '$L(DATE) Q
.. N MAGE I $G(DOB) S MAGE=$$FMDIFF^XLFDT(FMDT,DOB)\30.5 ; PATCHED BY GIS 4/26/11
.. S PCT="" I $G(MAGE) D
... I MMN="WT" S PCT=$$AUHTWT^APCHS2A2("WT",SEX,MAGE,VAL)
... I MMN="HT" S PCT=$$AUHTWT^APCHS2A2("HT",SEX,MAGE,VAL)
... Q
.. I $G(METRIC)=1 D
... I MMN="WT" S VAL=$$WEIGHT^XLFMSMT(VAL,"LB","KG")
... I MMN="HT" S VAL=$$LENGTH^XLFMSMT(VAL,"IN","CM")
... Q
.. I $L(PCT) S VAL=VAL_" ("_PCT_"%)"
.. I STG'="" S STG=STG_U
.. S STG=STG_VAL_"|"_DATE
.. S TOT=TOT+1
.. I TOT=MAX S STOP=1
.. Q
. Q
Q STG
;
LAST(DFN,PCE,MN) ; EP-GIEN A PATIENT DFN, ASTHMA FIELD (PIECE), AND MAX #, RETURN THE LAST V ASTHMA RESULT(S)
I '$D(^AUPNVAST("AA",+$G(DFN))) Q
I '$G(PCE) Q
I '$L($G(MN)) Q
N IDT,FMDT,DATE,RESULT,AIEN,X,VIEN,VAL,STOP
S IDT=0,STOP=0
F S IDT=$O(^AUPNVAST("AA",DFN,IDT)) Q:'IDT D I STOP Q
. S AIEN=0
. F S AIEN=$O(^AUPNVAST("AA",DFN,IDT,AIEN)) Q:'AIEN D I STOP Q
.. S X=$G(^AUPNVAST(AIEN,0)) I '$L(X) Q
.. S VAL=$P(X,U,PCE) I '$L(VAL) Q
.. S VIEN=$P(X,U,3) I 'VIEN Q
.. S FMDT=+$G(^AUPNVSIT(VIEN,0)) I 'FMDT Q
.. S DATE=$$FMTE^XLFDT(FMDT,"2D") I '$L(DATE) Q
.. S @TMP@(MN)=VAL_" ("_DATE_")"
.. S STOP=1
.. Q
. Q
Q
;
VENPCC1M ; IHS/OIT/GIS - MEASUREMENTS FOR CLASSIC PCC+
+1 ;;2.6;PCC+;**4**;APR 03, 2012;Build 24
+2 ; PATCHED BY GIS/OIT 4/21/06 ; PCC + VERSION 2.5, PATCH 4
+3 ; PATCHED AGAIN FOR PCC+ 2.6, PATCH 4
+4 ;
+5 ;
MSR(DFN,CV,DEFEF) ; EP - STANDARD MEASUREMENTS
+1 NEW VSFLAG,METRIC,DOB,%,SEX,HCFLAG,IDT,X,Y,Z,WCIEN,PCE,MN,FMDT,VDT,VIEN,M,QIEN,STOP,AGE,MAGE
+2 SET CV=$GET(CV)
IF 'CV
QUIT
+3 SET %=$GET(^DPT(+$GET(DFN),0))
SET DOB=$PIECE(%,U,3)
SET SEX=$PIECE(%,U,2)
SET METRIC=0
SET PCTILE=0
+4 IF 'DOB!'$LENGTH(SEX)
GOTO ETV
+5 SET AGE=(DT-DOB)\10000
+6 ; HEAD CIRC VS BMI
SET HCFLAG=(AGE<2)
+7 SET MAGE=0
+8 ; APPEND %ILE TO VALUE
IF AGE<18
SET MAGE=$$FMDIFF^XLFDT(DT,DOB,1)\30.5
ETV ; EXCLUDE TODAYS VALUES FROM TABLE
IF $PIECE($GET(^VEN(7.41,+$GET(DEFEF),14)),U,7)
IF $DATA(^AUPNVSIT(+$GET(CV),0))
SET VSFLAG=$GET(CV)
+1 ; METRIC UNITS ; PATCHED BY GIS/OIT 6/12/06 ; PCC + VERSION 2.5, PATCH 5
SET METRIC=$PIECE($GET(^VEN(7.41,+$GET(DEFEF),0)),U,15)
+2 IF METRIC=2
IF $GET(AGE)
SET METRIC=1
+3 DO BP(DFN)
DO WT(DFN,MAGE)
DO HT(DFN,MAGE)
DO BMI(DFN)
DO HC(DFN)
DO O2(DFN)
DO PA(DFN)
DO PF(DFN)
DO VS(CV,DFN,MAGE)
+4 SET X="ASQ"_U_"VENPCCQ"
XECUTE "I $L($T("_X_"))"
IF $TEST
DO @X
+5 QUIT
+6 ;
VS(CV,DFN,MAGE) ; EP - DISPLAY TODAY'S VS & MEASUREMENTS IN c26 AND AS INDIVIUAL MM FIELDS
+1 ; PATCHED BY GIS/OIT 4/21/06 ; PCC + VERSION 2.5, PATCH 5
+2 NEW MIEN,STG,MSR,X,VAL,BMI,PCT,MMN,%,VDT
CKVISIT ; ABSOLUTELY CONFIRM THAT THE VS ARE ASSOCIATED WITH THE CORRECT/CURRENT VISIT
+1 ; MUST BE A VALID VISIT
SET VDT=+$GET(^AUPNVSIT(+$GET(CV),0))
IF 'VDT
QUIT
+2 ; MAKE SURE THAT A VALID PCC+ CLINIC HAS BEEN DEFINED
IF '$GET(DEPTIEN)
QUIT
+3 ; PT MUST MATCH VISIT
IF $PIECE(^AUPNVSIT(CV,0),U,5)'=DFN
QUIT
+4 ; VISIT MUST BE WITHIN THE PAST 6 HRS
IF VDT<$$FMADD^XLFDT($$NOW^VENPCCU,0,-6,0,0)
QUIT
+5 ; PCC+ CLINIC MUST MATCH THE VISIT'S CLINIC STOP
IF $PIECE(^AUPNVSIT(CV,0),U,8)'=$PIECE($GET(^VEN(7.95,DEPTIEN,0)),U,4)
QUIT
+6 ; AT LEAST 1 VS MUST BE ASSOCIATED WITH THIS VISIT, OR QUIT NOW
IF '$DATA(^AUPNVMSR("AD",CV))
QUIT
GETVS SET MIEN=0
SET STG=""
+1 ; FOR EA. MEASUREMENT FROM TODAY'S VISIT, THE LAST VALUE IS PLACED INT THE MSR ARRAY
FOR
SET MIEN=$ORDER(^AUPNVMSR("AD",+$GET(CV),MIEN))
IF 'MIEN
QUIT
Begin DoDot:1
+2 SET X=$GET(^AUPNVMSR(MIEN,0))
+3 SET MMN=$PIECE($GET(^AUTTMSR(+X,0)),U)
IF '$LENGTH(MMN)
QUIT
+4 SET VAL=$PIECE(X,U,4)
IF '$LENGTH(X)
QUIT
+5 SET MSR(MMN)=VAL
+6 ; PATCHED BY GIS 3/2/07
IF VAL?1.N1"."2.N
SET VAL=$JUSTIFY(VAL,"",2)
+7 QUIT
End DoDot:1
+8 ; COMPUTE TODAY'S BMI
KILL BMI
IF $GET(MSR("WT"))
SET BMI=$$TBMI(MSR("WT"),$GET(MSR("HT")),DFN)
+9 ; HT
IF $DATA(MSR("HT"))
Begin DoDot:1
+10 SET PCT=""
+11 IF MAGE
IF $GET(MSR("HT"))
SET PCT=$$AUHTWT^APCHS2A2("HT",SEX,MAGE,MSR("HT"))
+12 IF METRIC
IF $GET(MSR("HT"))
SET MSR("HT")=$$LENGTH^XLFMSMT(MSR("HT"),"IN","CM")
+13 IF PCT
SET MSR("HT")=MSR("HT")_" ("_PCT_"%)"
+14 SET STG="Ht: "_MSR("HT")_" "
+15 SET @TMP@("ht")=MSR("HT")
+16 QUIT
End DoDot:1
+17 ; WT
IF $DATA(MSR("WT"))
Begin DoDot:1
+18 SET PCT=""
+19 IF MAGE
IF MSR("WT")
SET PCT=$$AUHTWT^APCHS2A2("WT",SEX,MAGE,MSR("WT"))
+20 IF METRIC
SET MSR("WT")=$$WEIGHT^XLFMSMT(MSR("WT"),"LB","KG")
+21 SET STG=STG_"Wt: "_MSR("WT")_" "
+22 SET @TMP@("wt")=MSR("WT")
+23 QUIT
End DoDot:1
+24 ; BMI
IF $LENGTH($GET(BMI))
SET STG=STG_"BMI: "_BMI_" "
SET @TMP@("bmi")=BMI
+25 ; HC
IF $DATA(MSR("HC"))
SET STG=STG_"Head Circ: "_MSR("HC")_" "
SET @TMP@("hc")=MSR("HC")
+26 ; BP
IF $DATA(MSR("BP"))
SET STG=STG_"B/P: "_MSR("BP")_" "
SET @TMP@("bp")=MSR("BP")
+27 ; TMP
IF $DATA(MSR("TMP"))
SET STG=STG_"Temp: "_MSR("TMP")_" "
SET @TMP@("tmp")=MSR("TMP")
+28 ; PU
IF $DATA(MSR("PU"))
SET STG=STG_"Pulse: "_MSR("PU")_" "
SET @TMP@("pu")=MSR("PU")
+29 ; RS
IF $DATA(MSR("RS"))
SET STG=STG_"Resp: "_MSR("RS")_" "
SET @TMP@("rs")=MSR("RS")
+30 ; PA
IF $DATA(MSR("PA"))
SET STG=STG_"Pain: "_MSR("PA")_" "
SET @TMP@("pa")=MSR("PA")
+31 ; O2
IF $DATA(MSR("O2"))
SET STG=STG_"O2 Sat: "_MSR("O2")_" "
SET @TMP@("o2")=MSR("O2")
+32 ; PF
IF $DATA(MSR("PF"))
SET STG=STG_"Peak Flow: "_MSR("PF")_" "
SET @TMP@("pf")=MSR("PF")
+33 SET @TMP@("c26")=STG
+34 QUIT
+35 ;
TBMI(WT,HT,DFN) ; EP - COMPUTE TODAY'S BMI
+1 NEW BMI
+2 IF '$GET(WT)
QUIT ""
+3 IF '$GET(DFN)
QUIT ""
+4 ; IF AGE>20, GET MOST RECENT HT
IF '$GET(HT)
SET HT=$$CHT(DFN,DT)
IF 'HT
QUIT ""
+5 SET BMI=$JUSTIFY(((WT/(HT*HT))*703),0,1)
+6 QUIT BMI
+7 ;
CHT(DFN,XDT) ; EP - RETURN THE COMPUTED HEIGHT
+1 NEW AGE,DOB,IDT,HT,MIEN,DATE
+2 SET DOB=$PIECE(^DPT(DFN,0),U,3)
IF 'DOB
QUIT ""
+3 ; PATIENT MUST BE OVER 21
SET AGE=XDT-DOB\10000
IF AGE<21
QUIT ""
+4 SET IDT=$ORDER(^AUPNVMSR("AA",DFN,1,0))
IF 'IDT
QUIT ""
+5 ; GET DATE OF LAST HT
SET DATE=9999999-IDT
+6 ; LAST HT MEASUREMENT MUST BE TAKE AFTER PATIENT'S 21ST BIRTHDAY
IF DATE-DOB\10000<21
QUIT ""
+7 ; IF OVER 60, MUST HAVE A HT AT LEAST EVERY 3 YEARS
IF AGE>60
IF XDT-DATE\10000>2
QUIT ""
+8 SET MIEN=$ORDER(^AUPNVMSR("AA",DFN,1,IDT,0))
IF 'MIEN
QUIT ""
+9 SET HT=$PIECE($GET(^AUPNVMSR(MIEN,0)),U,4)
+10 QUIT HT
+11 ;
BMI(DFN) ; EP - GET LAST 5 BMIs (bmi1-bmi5)
+1 ; LESS THAN AGE 2
IF $GET(HCFLAG)
QUIT
+2 NEW BMI,IDT,DATE,AGE,DOB,MIEN,WT,HT,STG,CNT,XDT
+3 SET IDT=0
SET STG=""
SET CNT=0
+4 FOR
SET IDT=$ORDER(^AUPNVMSR("AA",DFN,2,IDT))
IF 'IDT
QUIT
Begin DoDot:1
+5 SET MIEN=$ORDER(^AUPNVMSR("AA",DFN,2,IDT,0))
IF 'MIEN
QUIT
+6 SET WT=$PIECE($GET(^AUPNVMSR(MIEN,0)),U,4)
IF 'WT
QUIT
+7 SET MIEN=+$ORDER(^AUPNVMSR("AA",DFN,1,IDT,0))
+8 SET HT=$PIECE($GET(^AUPNVMSR(MIEN,0)),U,4)
+9 SET XDT=9999999-IDT
+10 IF 'HT
SET HT=$$CHT(DFN,XDT)
IF 'HT
QUIT
+11 SET BMI=$JUSTIFY(((WT/(HT*HT))*703),0,1)
+12 SET DATE=$$FMTE^XLFDT(XDT,"2D")
+13 IF $LENGTH(STG)
SET STG=STG_U
+14 SET STG=STG_BMI_"|"_DATE
+15 SET CNT=CNT+1
+16 QUIT
End DoDot:1
IF CNT=5
QUIT
+17 DO MSET(STG,"bmi","")
+18 SET @TMP@("msrhdr")="BMI"
+19 QUIT
+20 ;
RESP(DFN) ; EP - RESPIRATORY INFO
+1 ; ASTHMA INFO
DO FEV(DFN)
DO FEF(DFN)
DO BPF(DFN)
DO ETS(DFN)
DO PART(DFN)
DO DUST(DFN)
+2 QUIT
+3 ;
BP(DFN) ; EP - GET LAST 5 B/Ps (bp1-bp5)
+1 NEW STG,MN
+2 SET STG=$$MRES(+$GET(DFN),"BP",5)
IF '$LENGTH(STG)
QUIT
+3 SET MN="bp"
+4 DO MSET(STG,MN,"")
+5 QUIT
+6 ;
WT(DFN,MAGE) ; EP - GET LAST 5 WTs (wt1-wt5)
+1 NEW STG,MN
+2 SET STG=$$MRES(+$GET(DFN),"WT",5,MAGE)
IF '$LENGTH(STG)
QUIT
+3 SET MN="wt"
+4 DO MSET(STG,MN,"")
+5 QUIT
+6 ;
HT(DFN,MAGE) ; EP - GET LAST 5 HEIGHTS (ht1-ht5)
+1 NEW STG,MN
+2 SET STG=$$MRES(+$GET(DFN),"HT",5,MAGE)
IF '$LENGTH(STG)
QUIT
+3 SET MN="ht"
+4 DO MSET(STG,MN,"")
+5 QUIT
+6 ;
HC(DFN) ; EP - GET LAST 5 HEAD CIRCs (hc1-hc5)
+1 IF '$GET(HCFLAG)
QUIT
+2 NEW STG,MN
+3 SET STG=$$MRES(+$GET(DFN),"HC",5)
IF '$LENGTH(STG)
QUIT
+4 SET MN="hc"
+5 DO MSET(STG,MN,"")
+6 SET @TMP@("msrhdr")="HC"
+7 QUIT
+8 ;
PA(DFN) ; EP - GET LAST 5 PAIN ASSESSMENTS (pa1-pa5)
+1 IF '$GET(HCFLAG)
QUIT
+2 NEW STG,MN
+3 SET STG=$$MRES(+$GET(DFN),"PA",5)
IF '$LENGTH(STG)
QUIT
+4 SET MN="pa"
+5 DO MSET(STG,MN,"")
+6 SET @TMP@("msrhdr")="HC"
+7 QUIT
+8 ;
O2(DFN) ; EP - GET LAST 5 O2 SATS (o21-o25)
+1 NEW STG,MN
+2 SET STG=$$MRES(+$GET(DFN),"O2",5)
IF '$LENGTH(STG)
QUIT
+3 SET MN="o2"
+4 DO MSET(STG,MN,"")
+5 QUIT
+6 ;
PF(DFN) ; EP - GET LAST 5 PEAK FLOW RESULTS (pf1-pf5)
+1 NEW STG,MN
+2 SET STG=$$MRES(+$GET(DFN),"PF",5)
IF '$LENGTH(STG)
QUIT
+3 SET MN="pf"
+4 DO MSET(STG,MN,"")
+5 QUIT
+6 ;
FEV(DFN) ; EP - GET LAST FEV (fev)
+1 NEW MN
+2 SET MN="fev"
+3 DO LAST(DFN,5,MN)
+4 QUIT
+5 ;
FEF(DFN) ; EP - GET LAST FEF (fef)
+1 NEW MN
+2 SET MN="fef"
+3 DO LAST(DFN,6,MN)
+4 QUIT
+5 ;
BPF(DFN) ; EP - GET LAST BEST PEAK FLOW (bpf)
+1 NEW MN
+2 SET MN="bpf"
+3 DO LAST(DFN,7,MN)
+4 QUIT
+5 ;
ETS(DFN) ; EP - GET LAST ETS (ets)
+1 NEW MN
+2 SET MN="ets"
+3 DO LAST(DFN,8,MN)
+4 QUIT
+5 ;
PART(DFN) ; EP-GET LAST PARTICULATE MATTER (part)
+1 NEW MN
+2 SET MN="part"
+3 DO LAST(DFN,9,MN)
+4 QUIT
+5 ;
DUST(DFN) ; EP-GET LAT DUST MITE (dust)
+1 NEW MN
+2 SET MN="dust"
+3 DO LAST(DFN,11,MN)
+4 QUIT
+5 ;
MSET(STG,MN,TITLE,NOCNT) ; EP-SET MAIL MERGE NODES FOR RESULTS
+1 NEW TOT,CNT,PCE,VAL,DATE,RES,X
+2 IF '$DATA(TMP)
QUIT
+3 IF '$LENGTH($GET(STG))
QUIT
+4 IF '$LENGTH(MN)
QUIT
+5 SET TOT=$LENGTH(STG,U)
IF 'TOT
QUIT
+6 SET CNT=0
+7 FOR PCE=1:1:TOT
SET X=$PIECE(STG,U,PCE)
Begin DoDot:1
+8 IF '$LENGTH(X)
QUIT
+9 SET VAL=$PIECE(X,"|")
IF '$LENGTH(VAL)
QUIT
+10 ; PATCHED BY GIS 4/26/11
IF VAL?1.N1"."2.N
SET VAL=$JUSTIFY(VAL,"",2)
+11 SET DATE=$PIECE(X,"|",2)
IF '$LENGTH(DATE)
QUIT
+12 SET RES=""
IF $LENGTH(TITLE)
SET RES=TITLE_": "
+13 SET RES=RES_VAL_" ["_DATE_"]"
+14 SET CNT=CNT+1
+15 IF $GET(NOCNT)
SET @TMP@(MN,1)=RES
QUIT
+16 SET @TMP@(MN_CNT)=RES
+17 QUIT
End DoDot:1
+18 QUIT
+19 ;
MRES(DFN,MMN,MAX,MAGE) ; EP-GIVEN PATIENT DFN, MEASUREMENT TYPE IEN AND MAX # RETURN A RESULT STG: VAL|FMDT^VAL|FMDT...
+1 ; PATCHED BY GIS/OIT 8/18/06 ; PCC + VERSION 2.5, PATCH 6 ; %ILES AND METRIC CONVERSIONS ADDED
+2 IF $DATA(^DPT(+$GET(DFN),0))
IF $LENGTH($GET(MMN))
+3 IF '$TEST
QUIT ""
+4 NEW IDT,FMDT,DATE,RESULT,MIEN,X,TOT,VIEN,STG,VAL,STOP,MSS
+5 SET MSS=$ORDER(^AUTTMSR("B",MMN,0))
IF 'MSS
QUIT ""
+6 IF '$DATA(^AUPNVMSR("AA",+$GET(DFN),+$GET(MSS)))
QUIT ""
+7 SET IDT=0
SET TOT=0
SET STG=""
SET STOP=0
+8 IF '$GET(MAX)
SET MAX=1
+9 FOR
SET IDT=$ORDER(^AUPNVMSR("AA",DFN,MSS,IDT))
IF 'IDT
QUIT
Begin DoDot:1
+10 SET MIEN=9999999999
+11 FOR
SET MIEN=$ORDER(^AUPNVMSR("AA",DFN,MSS,IDT,MIEN),-1)
IF 'MIEN
QUIT
Begin DoDot:2
+12 SET X=$GET(^AUPNVMSR(MIEN,0))
IF '$LENGTH(X)
QUIT
+13 SET VAL=$PIECE(X,U,4)
IF '$LENGTH(VAL)
QUIT
+14 SET VIEN=$PIECE(X,U,3)
IF 'VIEN
QUIT
+15 ; EXCLUDE TODAY'S MEASUREMENTS.
IF VIEN=$GET(VSFLAG)
QUIT
+16 SET FMDT=+$GET(^AUPNVSIT(VIEN,0))
IF 'FMDT
QUIT
+17 SET DATE=$$FMTE^XLFDT(FMDT,"2D")
IF '$LENGTH(DATE)
QUIT
+18 ; PATCHED BY GIS 4/26/11
NEW MAGE
IF $GET(DOB)
SET MAGE=$$FMDIFF^XLFDT(FMDT,DOB)\30.5
+19 SET PCT=""
IF $GET(MAGE)
Begin DoDot:3
+20 IF MMN="WT"
SET PCT=$$AUHTWT^APCHS2A2("WT",SEX,MAGE,VAL)
+21 IF MMN="HT"
SET PCT=$$AUHTWT^APCHS2A2("HT",SEX,MAGE,VAL)
+22 QUIT
End DoDot:3
+23 IF $GET(METRIC)=1
Begin DoDot:3
+24 IF MMN="WT"
SET VAL=$$WEIGHT^XLFMSMT(VAL,"LB","KG")
+25 IF MMN="HT"
SET VAL=$$LENGTH^XLFMSMT(VAL,"IN","CM")
+26 QUIT
End DoDot:3
+27 IF $LENGTH(PCT)
SET VAL=VAL_" ("_PCT_"%)"
+28 IF STG'=""
SET STG=STG_U
+29 SET STG=STG_VAL_"|"_DATE
+30 SET TOT=TOT+1
+31 IF TOT=MAX
SET STOP=1
+32 QUIT
End DoDot:2
IF STOP
QUIT
+33 QUIT
End DoDot:1
IF STOP
QUIT
+34 QUIT STG
+35 ;
LAST(DFN,PCE,MN) ; EP-GIEN A PATIENT DFN, ASTHMA FIELD (PIECE), AND MAX #, RETURN THE LAST V ASTHMA RESULT(S)
+1 IF '$DATA(^AUPNVAST("AA",+$GET(DFN)))
QUIT
+2 IF '$GET(PCE)
QUIT
+3 IF '$LENGTH($GET(MN))
QUIT
+4 NEW IDT,FMDT,DATE,RESULT,AIEN,X,VIEN,VAL,STOP
+5 SET IDT=0
SET STOP=0
+6 FOR
SET IDT=$ORDER(^AUPNVAST("AA",DFN,IDT))
IF 'IDT
QUIT
Begin DoDot:1
+7 SET AIEN=0
+8 FOR
SET AIEN=$ORDER(^AUPNVAST("AA",DFN,IDT,AIEN))
IF 'AIEN
QUIT
Begin DoDot:2
+9 SET X=$GET(^AUPNVAST(AIEN,0))
IF '$LENGTH(X)
QUIT
+10 SET VAL=$PIECE(X,U,PCE)
IF '$LENGTH(VAL)
QUIT
+11 SET VIEN=$PIECE(X,U,3)
IF 'VIEN
QUIT
+12 SET FMDT=+$GET(^AUPNVSIT(VIEN,0))
IF 'FMDT
QUIT
+13 SET DATE=$$FMTE^XLFDT(FMDT,"2D")
IF '$LENGTH(DATE)
QUIT
+14 SET @TMP@(MN)=VAL_" ("_DATE_")"
+15 SET STOP=1
+16 QUIT
End DoDot:2
IF STOP
QUIT
+17 QUIT
End DoDot:1
IF STOP
QUIT
+18 QUIT
+19 ;