- 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 ;