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