Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VENPCC1M

VENPCC1M.m

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