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

VENPCCS1.m

Go to the documentation of this file. 
  1. VENPCCS1 ; IHS/OIT/GIS - POPULATE OCX OBJECTS FOR WELL BABY FORMS ; 
  1.  ;;2.6;PCC+;**1,2,3**;APR 03, 2012;Build 24
  1.  ;
  1.  ; 
  1.  ;
  1. GGD(OUT,IN) ; EP - RPC: VEN WCM GET GROWTH DATA ; IN = DFN    OUT = DELEMITED GROWTH DATA STRING
  1.  I $D(^DPT(+$G(IN),0))
  1.  E  Q
  1.  N GUIRPC
  1.  S GUIRPC=1
  1.  S OUT=$$VISIT^VENPCCS1(IN)
  1.  Q
  1.  ;
  1. GGDI(OUT,IN) ; EP - RPC: VEN WCM INIT GROWTH DATA
  1.  I $D(^DPT(+$G(IN),0))
  1.  E  Q
  1.  N MOS,SEX
  1.  S SEX=$P(^DPT(IN,0),U,2)
  1.  S MOS=$$AGEM(IN)
  1.  S OUT=SEX_"|"_MOS
  1.  Q
  1.  ; 
  1. FORMAT(DFN,AMOS,DOB,SEX,VTYPE) ; EP-RETURN THE OUTPUT STRING
  1.  I $G(DFN),$G(AMOS),$G(DOB),$L($G(TYPE)),$L($G(SEX))
  1.  E  Q ""
  1.  N STG,S,VIEN
  1.  S STG="",VIEN=999999999999
  1.  F  S VIEN=$O(@TMP@(VIEN),-1) Q:'VIEN  S STG=STG_@TMP@(VIEN)_"|"
  1.  Q STG
  1.  ; 
  1. AIM(DOB,DATE) ; EP-GIVEN THE FM DOB RETURN THE AGE IN MONTHS
  1.  S DOB=DOB\1 I DOB'?7N Q ""
  1.  I '$G(DATE) S DATE=$G(DT)
  1.  I 'DATE Q ""
  1.  I DOB>DATE Q ""
  1.  N Y,M,D,YR,MB,DAY,MOS,F
  1.  S MOS=0
  1.  S Y=$E(DATE,1,3),D=$E(DATE,6,7),M=$E(DATE,4,5)
  1.  S YR=$E(DOB,1,3),DAY=$E(DOB,6,7),MB=$E(DOB,4,5)
  1.  I Y>YR S MOS=12*(Y-YR)
  1.  I M'<MB S MOS=MOS+(M-MB)
  1.  E  S MOS=MOS-(MB-M)
  1.  I D<DAY S MOS=MOS-1
  1.  I D=DAY Q MOS
  1.  I DAY>D S F=(30.5-(DAY-D))/30.5
  1.  E  S F=(D-DAY)/30.5
  1.  S F=$J(F,1,1) I F S MOS=MOS+F
  1.  Q MOS
  1.  ; 
  1. PCT(VMIEN,AGEM,SEX,TYPE) ; EP-RETURN THE VALUE AND PERCENTILE
  1.  N VAL,PCT
  1.  I $G(AGEM)="" Q ""
  1.  I '$L(SEX) Q ""
  1.  I '$L(TYPE) Q ""
  1.  S AGEM=$J(AGEM,1,0)
  1.  S VAL=$P($G(^AUPNVMSR(+$G(VMIEN),0)),U,4) I VAL="" Q ""
  1.  I '$G(GUIRPC) D  ; ONLY JUSTIFY FOR TRADITIONAL PAPER BASED PCC+
  1.  . S VAL=$J(VAL,1,1) ; PATCHED BY GIS 5/7/07
  1.  . I VAL[".0" S VAL=VAL\1
  1.  . Q
  1.  I AGEM>216!(TYPE="HC") Q VAL_U ; gis/1/28/10
  1.  S PCT=$$AUHTWT^APCHS2A2(TYPE,SEX,AGEM,VAL)
  1.  Q VAL_U_PCT
  1.  ; 
  1. BMI(W,H) ; EP-RETURN THE BMI
  1.  N BMI
  1.  I $G(W),$G(H)
  1.  E  Q ""
  1.  I '$G(GUIRPC) S BMI=W/((H*H)/10000)
  1.  E  S BMI=W/(H*H)*703
  1.  S BMI=$J(BMI,0,1)
  1.  Q BMI
  1.  ; 
  1. KG(WT) ; EP-CONVERT LBS TO KGS
  1.  I '$G(WT) Q ""
  1.  N %
  1.  S %=+$$WEIGHT^XLFMSMT(WT,"lb","kg")
  1.  I % Q $J(%,1,2)
  1.  Q ""
  1.  ; 
  1. CM(HT) ; EP-COVERT INS TO CMS
  1.  I '$G(HT) Q ""
  1.  N %
  1.  S %=+$$LENGTH^XLFMSMT(HT,"in","cm")
  1.  I % Q $J(%,1,2)
  1.  Q ""
  1.  ; 
  1. EXDT(DATE) ; EP-CONVERT FM DATE TO AN EXTERNAL DATE
  1.  I '$G(DATE) Q ""
  1.  S DATE=DATE\1 I DATE'?7N Q ""
  1.  N Y,M,D
  1.  S Y=$E(DATE,1,3) S Y=1700+Y
  1.  S M=$E(DATE,4,5)
  1.  S D=$E(DATE,6,7)
  1.  Q (M_"/"_D_"/"_Y)
  1.  ; 
  1. NAME(DFN) ; EP-GIVEN A DFN REURN FNAME LNAME
  1.  N NAME,X
  1.  S X=$P($G(^DPT(+$G(DFN),0)),U) I X="" Q ""
  1.  S NAME=$P(X,",",2)_" "_$P(X,",",1)
  1.  Q NAME
  1.  ; 
  1. DOB(DFN) ; EP-RETURN DOB IN MM/DD/YYYY
  1.  N DOB,X
  1.  S DOB=$P($G(^DPT(+$G(DFN),0)),U,3) I 'DOB Q ""
  1.  S X=$E(DOB,4,5)_"/"_$E(DOB,6,7)_"/"_(1700+$E(DOB,1,3))
  1.  Q X
  1.  ; 
  1. GENDER(DFN) ; EP-RETURN FORMATTED GENDER
  1.  N SEX,X
  1.  S SEX=$P($G(^DPT(+$G(DFN),0)),U,2) I SEX="" Q ""
  1.  S X=$S(SEX="M":"Male",SEX="F":"Female",1:"")
  1.  Q X
  1.  ; 
  1. BF(DFN) ; EP-RETIRN BMI OR FOC
  1.  N AGEM,X
  1.  S AGEM=$$AGEM(DFN) I 'AGEM Q ""
  1.  S X=$S(AGEM<24:"FOC",1:"BMI")
  1.  Q X
  1.  ; 
  1. AGEM(DFN) ; EP-RETURN THE AGE IN MONTHS
  1.  N AGEM,DOB
  1.  S DOB=$P($G(^DPT(+$G(DFN),0)),U,3) I 'DOB Q ""
  1.  S AGEM=$$AIM(DOB)
  1.  Q AGEM
  1.  ; 
  1. VISIT(DFN) ; EP-GET LAST 100 VISITS FOR A PT AND RETURN REQUESTED DATA IN A FORMATTED STRING
  1.  ; RETURN MEASUREMENTS AND PERCENTILES
  1.  ; PATCHED BY GIS/OIT 1/10/11 ; INCLUDES FIXES FOR VEN 2.6, PATCH 2
  1.  N VIEN,TOT,WTT,HTT,HCT,DIC,X,Y,%,DOB,VDATE,OK,VMIEN,TYPE,TMP,SEX,STOP,STG,AMOS,BMI,AGEM,HT,WT,HC,VTYPE,XDATE
  1.  S DOB=$P($G(^DPT(+$G(DFN),0)),U,3) I 'DOB Q ""
  1.  S SEX=$P($G(^DPT(+$G(DFN),0)),U,2) I SEX="" Q ""
  1.  S DIC="^AUTTMSR(",DIC(0)="",X="WT" D ^DIC Q:Y=-1 "" S WTT=+Y
  1.  S X="HT" D ^DIC Q:Y=-1 "" S HTT=+Y
  1.  S X="HC" D ^DIC Q:Y=-1 "" S HCT=+Y
  1.  S TOT=0,VIEN=999999999999,TMP="^TMP(""VEN WBC"","""_$J_""")" K @TMP
  1.  S AMOS=$$AIM(DOB) I 'AMOS Q "" ; CURRENT AGE IN MONTHS
  1.  S VTYPE=$S(AMOS<24:"FOC",1:"BMI") ; IF <24 MOS SHOW HC CHART - OTHERWISE SHOW BMI
  1.  F  S VIEN=$O(^AUPNVSIT("AC",DFN,VIEN),-1) Q:'VIEN  D  I TOT>99 Q
  1.  . K ARR
  1.  . S VDATE=$P($G(^AUPNVSIT(VIEN,0)),U) I 'VDATE Q
  1.  . S VMIEN=999999999,STOP=0,HT="",WT="",HC="",BMI=""
  1.  . F  S VMIEN=$O(^AUPNVMSR("AD",VIEN,VMIEN),-1) Q:'VMIEN  D  ; FOR EACH TYPE, GET ONLY THE MOST RECENT RESULT (NOT ENTERED IN ERROR) FOR THAT VISIT
  1.  .. I $P($G(^AUPNVMSR(VMIEN,2)),U) Q  ; FILTER OUT ANY RESULTS ENTERED IN ERROR
  1.  .. S XDATE=$P($G(^AUPNVMSR(VMIEN,12)),U)
  1.  .. I 'XDATE S XDATE=VDATE
  1.  .. S XDATE=XDATE\1
  1.  .. I $G(ARR(XDATE,"WT")),$G(ARR(XDATE,"HT")),$G(ARR(XDATE,"HC")) Q  ; GOT ALL 3 MEASUREMENTS - NO NEED TO LOOK AT THIS VISIT DATE ANY MORE
  1.  .. S TYPE=$P($G(^AUPNVMSR(VMIEN,0)),U)
  1.  .. I TYPE'=WTT,TYPE'=HTT,TYPE'=HCT Q  ; NOT A REQUIRED MEASUREMENT
  1.  .. S AGEM=$$AIM(DOB,XDATE) I AGEM="" Q  ; AGE IN MONTHS WHEN MEASUREMENT WAS TAKEN
  1.  .. I TYPE=WTT,'$D(ARR(XDATE,"WT")) S WT=$$PCT(VMIEN,AGEM,SEX,"WT"),ARR(XDATE,"WT")=WT_U_AGEM Q
  1.  .. I TYPE=HTT,'$D(ARR(XDATE,"HT")) S HT=$$PCT(VMIEN,AGEM,SEX,"HT"),ARR(XDATE,"HT")=HT_U_AGEM Q
  1.  .. I TYPE=HCT,'$D(ARR(XDATE,"HC")) S HC=$$PCT(VMIEN,AGEM,SEX,"HC"),ARR(XDATE,"HC")=HC_U_AGEM Q
  1.  .. Q
  1.  . I '$O(ARR(0)) Q  ; NO MEASUREMENTS RECORDED ON THIS VISIT
  1.  . D XRES(.ARR,SEX,DFN,VTYPE) ; FORMAT INDIVIDUAL EVENT RESULTS
  1.  . K ARR
  1.  . S TOT=TOT+1
  1.  . Q
  1.  S STG=$$FORMAT(DFN,AMOS,DOB,SEX,VTYPE) ; EP-CREATE THE OUTPUT STRING
  1.  K @TMP
  1.  ; F %=1:1:5 S X=$P(STG,"|",%) Q:'$L(X)  S $P(X,"~",6,7)="~",$P(STG,"|",%)=X
  1.  Q STG
  1.  ;
  1. XRES(ARR,SEX,DFN,VTYPE) ; EP-FORMAT INDIVIDUAL VISIT RESULTS AND STORE IN TMP ARRAY
  1.  N TYPE,W,H,FOC,DATE,WP,HP,T,XDATE,AGEM,BMI
  1.  I $O(ARR(0)),$L(SEX),$D(^DPT(+$G(DFN),0)),$L($G(VTYPE))
  1.  E  Q
  1.  S XDATE=9999999,T="~"
  1.  F  S XDATE=$O(ARR(XDATE),-1) Q:'XDATE  D
  1.  . S TYPE=""
  1.  . K W,H,WP,HP,FOC,BMI
  1.  . F  S TYPE=$O(ARR(XDATE,TYPE)) Q:TYPE=""  D
  1.  .. S DATE=$$EXDT(XDATE) I '$L(DATE) Q
  1.  .. S %=$G(ARR(XDATE,TYPE)) I %="" Q
  1.  .. S AGEM=$P(%,U,3) I AGEM="" Q
  1.  .. I TYPE="WT" D  Q
  1.  ... S W=$P(%,U),WP=$P(%,U,2)
  1.  ... I W,'$G(GUIRPC) S W=$$KG(W)
  1.  ... Q
  1.  .. I TYPE="HT" D  Q
  1.  ... S H=$P(%,U),HP=$P(%,U,2)
  1.  ... I H,'$G(GUIRPC) S H=$$CM(H)
  1.  ... Q
  1.  .. I TYPE="HC" D  Q
  1.  ... S FOC=""
  1.  ... I VTYPE="FOC" S FOC=$P(%,U) ; GIS/OIT/2/22/11
  1.  ... I FOC,'$G(GUIRPC) S FOC=$$CM(FOC)
  1.  ... Q
  1.  .. Q
  1.  . I VTYPE="BMI" D
  1.  .. S BMI=""
  1.  .. I AGEM>23,$G(W),$G(H) S BMI=$$BMI(W,H)
  1.  .. Q
  1.  . I $D(@TMP@(XDATE)) D  Q  ; MANAGE CASES WITH MULTIPLE VISITS ON THE SAME DAY ; ALWAYS USE ONLY THE MOST RECENT VALUE ; PATCHED BY GIS/OIT/3/23/11
  1.  .. I $G(W),$P(@TMP@(XDATE),T,3)="" S $P(@TMP@(XDATE),T,3,4)=$G(W)_T_$G(WP)
  1.  .. I $G(H),$P(@TMP@(XDATE),T,5)="" S $P(@TMP@(XDATE),T,5,6)=$G(H)_T_$G(HP)
  1.  .. I $G(@VTYPE),$P(@TMP@(XDATE),T,7)="" S $P(@TMP@(XDATE),T,7)=@VTYPE
  1.  .. Q
  1.  . S @TMP@(XDATE)=DATE_T_AGEM_T_$G(W)_T_$G(WP)_T_$G(H)_T_$G(HP)_T_$G(@VTYPE)_T
  1.  . Q
  1.  Q
  1.  ;