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