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

APCHPWH8.m

Go to the documentation of this file. 
  1. APCHPWH8 ; IHS/CMI/LAB - PCC HEALTH SUMMARY - MAIN DRIVER PART 2 ;  
  1.  ;;2.0;IHS PCC SUITE;**7,8,11**;MAY 14, 2009;Build 58
  1.  ;
  1.  ;
  1. ADOLHTWT ;EP - ht/wt/bmi component
  1.  I $$LASTVPP^APCHPWH2(APCHSDFN,$$FMADD^XLFDT(DT,-(30*3)),DT) Q  ;last visit dx was pregnancy
  1.  D SUBHEAD^APCHPWHU
  1.  NEW APCHHT,APCHWT,APCHAGE,APCHNOBM,APCHHTA,APCHWTA,APCHFEET,APCHINCH,APCHHWO,APCLBMI
  1.  D S^APCHPWH1("ADOLESCENT WEIGHT AND HEIGHT")
  1.  D S^APCHPWH1("Weight and Body Mass Index are good measures of your health.  Determining")
  1.  D S^APCHPWH1("a healthy weight and Body Mass Index also depends on your age and how")
  1.  D S^APCHPWH1("tall you are.")
  1.  D S^APCHPWH1(" ")
  1.  S APCHAGE=$$AGE^AUPNPAT(DT)
  1.  S APCHHWO=0,APCHFEET="",APCHINCH=""  ;ht/wt is good if 0
  1.  S APCHHT=$$LASTITEM^APCLAPIU(APCHSDFN,"HT","MEASUREMENT",,,"A")
  1.  I $P(APCHHT,U)<$$FMADD^XLFDT(DT,-365) S APCHHWO=1
  1.  S APCHWT=$$LASTITEM^APCLAPIU(APCHSDFN,"WT","MEASUREMENT",,,"A")
  1.  I $P(APCHWT,U)<$$FMADD^XLFDT(DT,-365) S APCHHWO=1
  1.  I APCHHT]"" S APCHFEET=$P(APCHHT,U,3)/12,APCHINCH=$P(APCHFEET,".",2),APCHINCH="."_APCHINCH*12,APCHINCH=$J(APCHINCH,2,0),APCHFEET=$P(APCHFEET,".")
  1.  S APCHWTLB=$J($P(APCHWT,U,3),3,0)
  1.  I 'APCHHWO D  Q
  1.  .D S^APCHPWH1("You are "_APCHFEET_" feet and "_APCHINCH_" inches tall.")
  1.  .D S^APCHPWH1("Your last weight was "_APCHWTLB_" pounds on "_$$FMTE^XLFDT($P(APCHWT,U,1))_".")
  1.  I APCHWT]"" D
  1.  .D S^APCHPWH1("Your last weight was "_APCHWTLB_" pounds on "_$$FMTE^XLFDT($P(APCHWT,U,1))_".")
  1.  ;D S^APCHPWH1("No recent weight on file.  We recommend that you have your weight rechecked at ") D S^APCHPWH1("your next visit.")
  1.  I APCHHT]"" D
  1.  .D S^APCHPWH1("On "_$$FMTE^XLFDT($P(APCHHT,U,1))_" your height was "_APCHFEET_" feet and "_APCHINCH_" inches.")
  1.  D S^APCHPWH1("We recommend that you have your height and weight rechecked at your next visit.")
  1.  Q
  1.  ;
  1. PEDHTWT ;EP - ht/wt/bmi component
  1.  ;GET LAST VISIT THAT IS A,O,H
  1.  I $$LASTVPP^APCHPWH2(APCHSDFN,$$FMADD^XLFDT(DT,-(30*3)),DT) Q  ;last visit dx was pregnancy
  1.  D SUBHEAD^APCHPWHU
  1.  NEW APCHHT,APCHWT,APCHAGE,APCHNOBM,APCHHTA,APCHWTA,APCHFEET,APCHINCH,APCHHWO,APCLBMI,APCHHC,APCHAM,APCHHWOD
  1.  D S^APCHPWH1("PEDIATRIC WEIGHT/HEIGHT/HEAD CIRCUMFERENCE")
  1.  S APCHAGE=$$AGE^AUPNPAT(DT)
  1.  I APCHAGE<4 D
  1.  .D S^APCHPWH1("Weight, height, and head circumference can help you see how your")
  1.  .D S^APCHPWH1("child is growing.")
  1.  I APCHAGE>3,APCHAGE<13 D
  1.  .D S^APCHPWH1("Weight and height can help you and your doctor see how well your")
  1.  .D S^APCHPWH1("child is growing.")
  1.  D S^APCHPWH1(" ")
  1.  S APCHHWO=0,APCHFEET="",APCHINCH=""  ;ht/wt is good if 0
  1.  S APCHAM=$$AGE(APCHSDFN,2)
  1.  I APCHAM>24 S APCHHWOD=-365
  1.  I APCHAM>6,APCHAM<25 S APCHHWOD=-90
  1.  I APCHAM<7 S APCHHWOD=-30
  1.  S APCHHWOD=$$FMADD^XLFDT(DT,APCHHWOD)
  1.  S APCHHT=$$LASTITEM^APCLAPIU(APCHSDFN,"HT","MEASUREMENT",,,"A")
  1.  I $P(APCHHT,U)<APCHHWOD S APCHHWO=1
  1.  S APCHWT=$$LASTITEM^APCLAPIU(APCHSDFN,"WT","MEASUREMENT",,,"A")
  1.  I $P(APCHWT,U)<APCHHWOD S APCHHWO=1
  1.  I APCHHT]"" S APCHFEET=$P(APCHHT,U,3)/12,APCHINCH=$P(APCHFEET,".",2),APCHINCH="."_APCHINCH*12,APCHINCH=$J(APCHINCH,2,0),APCHFEET=$P(APCHFEET,".")
  1.  S APCHWTLB=$J($P(APCHWT,U,3),3,0)
  1.  I 'APCHHWO D  G HC
  1.  .D S^APCHPWH1("Your child is "_APCHFEET_" feet and "_APCHINCH_" inches tall.")
  1.  .D S^APCHPWH1("Your child's last weight was "_APCHWTLB_" pounds on "_$$FMTE^XLFDT($P(APCHWT,U,1))_".")
  1.  I APCHWT]"" D  I 1
  1.  .D S^APCHPWH1("Your child's last weight was "_APCHWTLB_" pounds on "_$$FMTE^XLFDT($P(APCHWT,U,1))_".")
  1.  E  D S^APCHPWH1("No recent weight on file.  We recommend that you have your child's weight ") D S^APCHPWH1("rechecked at your next visit.")
  1.  I APCHHT]"" D  I 1
  1.  .D S^APCHPWH1("On "_$$FMTE^XLFDT($P(APCHHT,U,1))_" your child's height was "_APCHFEET_" feet and "_APCHINCH_" inches.",1)
  1.  E  D S^APCHPWH1("No recent height on file.  We recommend that you have your child's height "),S^APCHPWH1("rechecked at your next visit.")
  1. HC ;
  1.  I APCHAGE<3 D HC1
  1.  Q
  1. HC1 ;
  1.  S APCHHC=$$LASTITEM^APCLAPIU(APCHSDFN,"HC","MEASUREMENT",,,"A")
  1.  ;I $P(APCHHT,U)<DT S APCHHWO=1
  1.  D S^APCHPWH1(" ")
  1.  I APCHHC]"" D  Q
  1.  .D S^APCHPWH1("Your child's most recent head circumference is "_$J($P(APCHHC,U,3),5,2)_" on "_$$FMTE^XLFDT($P(APCHHC,U,1))_".")
  1.  D S^APCHPWH1("No recent head circumference on file.  We recommend that you have your ") D S^APCHPWH1("child's head circumference rechecked at your next visit.")
  1.  Q
  1. BMI(H,W) ;
  1.  NEW %
  1.  S %=""
  1.  S W=W*.45359,H=(H*0.0254),H=(H*H),%=(W/H),%=$J(%,4,1)
  1.  Q %
  1.  ;
  1. LASTVPP(P,BDATE,EDATE) ;
  1.  I '$D(^AUPNVSIT("AC",P)) Q ""
  1.  NEW APCHV,A,B,X,E,V,RAPCHR,D
  1.  K APCHV
  1.  S A="APCHV(",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1.  I '$D(APCHV) Q ""
  1.  ;
  1.  S X=0 F  S X=$O(APCHV(X)) Q:X'=+X  S V=$P(APCHV(X),U,5),APCHR((9999999-$P(APCHV(X),U,1)),V)=APCHV(X)
  1.  S (X,G,R,D)=0 F  S D=$O(APCHR(D)) Q:D'=+D!(G)  S X=0 F  S X=$O(APCHR(D,X)) Q:X'=+X!(G)  S V=$P(APCHR(D,X),U,5) D
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .Q:'$P(^AUPNVSIT(V,0),U,9)
  1.  .Q:$P(^AUPNVSIT(V,0),U,11)
  1.  .Q:'$D(^AUPNVPOV("AD",V))
  1.  .Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
  1.  .S A=0 F  S A=$O(^AUPNVPOV("AD",V,A)) Q:A'=+A!(G)  D
  1.  ..Q:'$D(^AUPNVPOV(A,0))
  1.  ..S E=$P(^AUPNVPOV(A,0),U)
  1.  ..Q:'$$ICD^ATXAPI(E,$O(^ATXAX("B","BGP GPRA PREGNANCY DIAGNOSES",0)),9)
  1.  ..S G=1
  1.  .Q
  1.  Q G
  1. RECENTWT ;EP - called from various handouts
  1.  D SUBHEAD^APCHPWHU
  1.  NEW APCHHT,APCHWT,X,E
  1.  D S^APCHPWH1("Here are "_$S($$AGE^AUPNPAT(APCHSDFN,DT)<13:"your child's",1:"your")_" most recent weights.")
  1.  D S^APCHPWH1(" ")
  1.  K APCHWT
  1.  S X=APCHSDFN_"^LAST 5 MEAS WT;DURING "_$$DOB^AUPNPAT(APCHSDFN)_"-"_DT S E=$$START1^APCLDF(X,"APCHWT(")
  1.  I '$D(APCHWT) D S^APCHPWH1("No weight values have been recorded.  We recommend that you have"),S^APCHPWH1($S($$AGE^AUPNPAT(APCHSDFN,DT)<13:"your child's",1:"your")_" weight rechecked at your next visit.") Q
  1.  S E="",$E(E,5)="Date",$E(E,18)="Weight (lbs)" D S^APCHPWH1(E)
  1.  S X=0 F  S X=$O(APCHWT(X)) Q:X'=+X  D
  1.  .S E=""
  1.  .S $E(E,2)=$$FMTE^XLFDT($P(APCHWT(X),U,1))
  1.  .S $E(E,20)=$J($P(APCHWT(X),U,2),3,0)
  1.  .D S^APCHPWH1(E)
  1.  Q
  1. TOBACCO ;EP
  1.  NEW X,Y,G
  1.  S G=0
  1.  S X=$$LASTHF^APCHSMU(APCHSDFN,"TOBACCO (SMOKING)","N")
  1.  S Y=$$LASTHF^APCHSMU(APCHSDFN,"TOBACCO (SMOKELESS - CHEWING/DIP)","N")
  1.  I X["CURRENT"!(Y["CURRENT") S G=1
  1.  Q:'G  ;last health factor was not a current user
  1.  D SUBHEAD^APCHPWHU
  1.  D S^APCHPWH1(" ")
  1.  D S^APCHPWH1("TOBACCO USE AND CESSATION")
  1.  D S^APCHPWH1("Talk to your health care provider or smoking cessation program about")
  1.  D S^APCHPWH1("ways that you can quit using tobacco.")
  1.  I $P($G(^APCCCTRL(DUZ(2),12)),U,1)]"" D
  1.  .D S^APCHPWH1("Your smoking cessation program's phone number is "_$P(^APCCCTRL(DUZ(2),12),U,1)_".")
  1.  I $P($G(^APCCCTRL(DUZ(2),12)),U,2)]"" D
  1.  .D S^APCHPWH1("For additional support, call your tobacco quit line at "_$P(^APCCCTRL(DUZ(2),12),U,2)_".")
  1.  Q
  1. INTAKE ;EP - PWH COMPONENT
  1.  I '$O(^APCHPWHT(APCHPWHT,1,APCHSORD,12,0)) Q  ;no measures defined
  1.  NEW APCHSTO,APCHSTM,APCHSTCE
  1.  ;D SUBHEAD^APCHPWHU
  1.  ;
  1.  ;go through each one
  1.  S APCHSTO=0 F  S APCHSTO=$O(^APCHPWHT(APCHPWHT,1,APCHSORD,12,APCHSTO)) Q:APCHSTO'=+APCHSTO  D
  1.  .S APCHSTM=$P($G(^APCHPWHT(APCHPWHT,1,APCHSORD,12,APCHSTO,0)),U,2)
  1.  .Q:'APCHSTM
  1.  .Q:'$D(^APCHPWHF(APCHSTM,0))
  1.  .S APCHSTCE=$P(^APCHPWHF(APCHSTM,0),U,1)
  1.  .;D S^APCHPWH1(APCHSTCE_" INTAKE FORM")
  1.  .I $G(^APCHPWHF(APCHSTM,1))]"" X ^APCHPWHF(APCHSTM,1) Q
  1.  .;D WRITEF^APCHPWHU(APCHSTCE)  ;just write the text from the form file so sites can add their own
  1.  .Q
  1.  Q
  1. EDUC ;EP - PWH COMPONENT
  1.  I '$O(^APCHPWHT(APCHPWHT,1,APCHSORD,13,0)) Q  ;no measures defined
  1.  NEW APCHSTO,APCHSTM,APCHSTCE
  1.  ;D SUBHEAD^APCHPWHU
  1.  ;
  1.  ;go through each one
  1.  S APCHSTO=0 F  S APCHSTO=$O(^APCHPWHT(APCHPWHT,1,APCHSORD,13,APCHSTO)) Q:APCHSTO'=+APCHSTO  D
  1.  .S APCHSTM=$P($G(^APCHPWHT(APCHPWHT,1,APCHSORD,13,APCHSTO,0)),U,2)
  1.  .Q:'APCHSTM
  1.  .Q:'$D(^APCHPWHF(APCHSTM,0))
  1.  .S APCHSTCE=$P(^APCHPWHF(APCHSTM,0),U,1)
  1.  .;D S^APCHPWH1(APCHSTCE_" INTAKE FORM")
  1.  .I $G(^APCHPWHF(APCHSTM,1))]"" X ^APCHPWHF(APCHSTM,1) Q
  1.  .D WRITEF^APCHPWHU(APCHSTCE)  ;just write the text from the form file so sites can add their own
  1.  .Q
  1.  Q
  1. BIGFIVE ;EP - form print
  1.  I $$AGE^AUPNPAT(APCHSDFN)>21 Q  ;no one over 21
  1.  D SUBHEAD^APCHPWHU
  1.  I $$AGE^AUPNPAT(APCHSDFN)>15 D
  1.  .D S^APCHPWH1(" ")
  1.  .D S^APCHPWH1("Please answer the following questions that are related to your health. ")
  1.  .D S^APCHPWH1("Your answers will help your provider give you the best health care.")
  1.  .D S^APCHPWH1(" ")
  1.  .D WRITEF^APCHPWHU(APCHSTM,"OVER 15")
  1.  I $$AGE^AUPNPAT(APCHSDFN)<16 D
  1.  .D S^APCHPWH1(" ")
  1.  .D S^APCHPWH1("Please answer the following questions that are related to your child's health.")
  1.  .D S^APCHPWH1("Your answers will help your provider give your child the best health care.")
  1.  .D S^APCHPWH1(" ")
  1.  .D WRITEF^APCHPWHU(APCHSTM,"UNDER 16")
  1.  Q
  1. AGEFORM ;
  1.  D SUBHEAD^APCHPWHU
  1.  I $$AGE^AUPNPAT(APCHSDFN)<1 D
  1.  .D S^APCHPWH1(" ")
  1.  .D S^APCHPWH1("Please answer the following questions that are related to your child's health.")
  1.  .D S^APCHPWH1("Your answers will help your provider give your child the best health care.")
  1.  .D S^APCHPWH1(" ")
  1.  .D WRITEF^APCHPWHU(APCHSTM,"0-1 YEAR")
  1.  I $$AGE^AUPNPAT(APCHSDFN)>0,$$AGE^AUPNPAT(APCHSDFN)<5 D
  1.  .D S^APCHPWH1(" ")
  1.  .D S^APCHPWH1("Please answer the following questions that are related to your child's health.")
  1.  .D S^APCHPWH1("Your answers will help your provider give your child the best health care.")
  1.  .D S^APCHPWH1(" ")
  1.  .D WRITEF^APCHPWHU(APCHSTM,"1-4 YEARS")
  1.  I $$AGE^AUPNPAT(APCHSDFN)>4,$$AGE^AUPNPAT(APCHSDFN)<12 D
  1.  .D S^APCHPWH1(" ")
  1.  .D S^APCHPWH1("Please answer the following questions that are related to your child's health.")
  1.  .D S^APCHPWH1("Your answers will help your provider give your child the best health care.")
  1.  .D S^APCHPWH1(" ")
  1.  .D WRITEF^APCHPWHU(APCHSTM,"5-11 YEARS")
  1.  I $$AGE^AUPNPAT(APCHSDFN)>11,$$AGE^AUPNPAT(APCHSDFN)<19 D
  1.  .D S^APCHPWH1(" ")
  1.  .D S^APCHPWH1("Please answer the following questions that are related to your child's health.")
  1.  .D S^APCHPWH1("Your answers will help your provider give your child the best health care.")
  1.  .D S^APCHPWH1(" ")
  1.  .D WRITEF^APCHPWHU(APCHSTM,"12-18 YEARS")
  1.  I $$AGE^AUPNPAT(APCHSDFN)>18 D
  1.  .D S^APCHPWH1(" ")
  1.  .D S^APCHPWH1("Please answer the following questions that are related to your health. ")
  1.  .D S^APCHPWH1("Your answers will help your provider give you the best health care.")
  1.  .D S^APCHPWH1(" ")
  1.  .D WRITEF^APCHPWHU(APCHSTM,"OVER 18 YEARS")
  1.  I $$DMPV^APCHPWH9(APCHSDFN) D
  1.  .I $$AGE^AUPNPAT(APCHSDFN)>18 D WRITEF^APCHPWHU(APCHSTM,"2 DIABETES POVS") Q
  1.  .I $$AGE^AUPNPAT(APCHSDFN)>18 D WRITEF^APCHPWHU(APCHSTM,"2 DIABETES POVS <18")
  1.  I $$AGE^AUPNPAT(APCHSDFN)>64 D
  1.  .D WRITEF^APCHPWHU(APCHSTM,"OVER 65")
  1.  Q
  1. PATED ;EP
  1.  D SUBHEAD^APCHPWHU
  1.  I $$AGE^AUPNPAT(APCHSDFN)>0,$$AGE^AUPNPAT(APCHSDFN)<5 D
  1.  .D WRITEF^APCHPWHU(APCHSTM,"1-4 YEARS")
  1.  I $$AGE^AUPNPAT(APCHSDFN)>4,$$AGE^AUPNPAT(APCHSDFN)<12 D
  1.  .D WRITEF^APCHPWHU(APCHSTM,"5-11 YEARS")
  1.  Q
  1. PREGNANT ;EP -
  1.  I $P($G(^AUPNREP(APCHSDFN,11)),U,1)="Y" D
  1.  .D SUBHEAD^APCHPWHU
  1.  .D S^APCHPWH1(" ")
  1.  .D S^APCHPWH1("Please answer the following questions that are related to your health. ")
  1.  .D S^APCHPWH1("Your answers will help your provider give you the best health care.")
  1.  .D S^APCHPWH1(" ")
  1.  .D WRITEF^APCHPWHU(APCHSTM,"PREGNANT")
  1.  .D S^APCHPWH1(" ")
  1.  Q
  1. PREGED ;EP
  1.  I $P($G(^AUPNREP(APCHSDFN,11)),U,1)="Y" D
  1.  .D SUBHEAD^APCHPWHU
  1.  .D WRITEF^APCHPWHU(APCHSTM,"PREGNANCY")
  1.  Q
  1.  ;----------
  1. AGE(DFN,APCHZ,APCHDT) ;EP
  1.  ;---> Return Patient's Age.
  1.  ;---> Parameters:
  1.  ;     1 - DFN  (req) IEN in PATIENT File.
  1.  ;     2 - APCHZ  (opt) APCHZ=1,2,3  1=years, 2=months, 3=days.
  1.  ;                               2 will be assumed if not passed.
  1.  ;     3 - APCHDT (opt) Date on which Age should be calculated.
  1.  ;
  1.  N APCHDOB,X,X1,X2  S:$G(APCHZ)="" APCHZ=2
  1.  Q:'$G(DFN) ""
  1.  S APCHDOB=$$DOB(DFN)
  1.  Q:'APCHDOB ""
  1.  S:'$G(DT) DT=$$DT^XLFDT
  1.  S:'$G(APCHDT) APCHDT=DT
  1.  Q:APCHDT<APCHDOB ""
  1.  ;
  1.  ;---> Age in Years.
  1.  N APCHAGEY,APCHAGEM,APCHD1,APCHD2,APCHM1,APCHM2,APCHY1,APCHY2
  1.  S APCHM1=$E(APCHDOB,4,7),APCHM2=$E(APCHDT,4,7)
  1.  S APCHY1=$E(APCHDOB,1,3),APCHY2=$E(APCHDT,1,3)
  1.  S APCHAGEY=APCHY2-APCHY1 S:APCHM2<APCHM1 APCHAGEY=APCHAGEY-1
  1.  S:APCHAGEY<1 APCHAGEY="<1"
  1.  Q:APCHZ=1 APCHAGEY
  1.  ;
  1.  ;---> Age in Months.
  1.  S APCHD1=$E(APCHM1,3,4),APCHM1=$E(APCHM1,1,2)
  1.  S APCHD2=$E(APCHM2,3,4),APCHM2=$E(APCHM2,1,2)
  1.  S APCHAGEM=12*APCHAGEY
  1.  I APCHM2=APCHM1&(APCHD2<APCHD1) S APCHAGEM=APCHAGEM+12
  1.  I APCHM2>APCHM1 S APCHAGEM=APCHAGEM+APCHM2-APCHM1
  1.  I APCHM2<APCHM1 S APCHAGEM=APCHAGEM+APCHM2+(12-APCHM1)
  1.  S:APCHD2<APCHD1 APCHAGEM=APCHAGEM-1
  1.  Q:APCHZ=2 APCHAGEM
  1.  ;
  1.  ;---> Age in Days.
  1.  S X1=APCHDT,X2=APCHDOB
  1.  D ^%DTC
  1.  Q X
  1.  ;
  1.  ;----------
  1. DOB(DFN) ;EP
  1.  ;---> Return Patient's Date of APCLrth in Fileman format.
  1.  ;---> Parameters:
  1.  ;     1 - DFN   (req) Patient's IEN (DFN).
  1.  ;
  1.  Q:'$G(DFN) "NO PATIENT"
  1.  Q:'$P($G(^DPT(DFN,0)),U,3) "NOT ENTERED"
  1.  Q $P(^DPT(DFN,0),U,3)
  1.  ;
  1.  ;