VENPCCS3 ; IHS/OIT/GIS - RESULT GRAPHING ;
;;2.6;PCC+;;NOV 12, 2007
;
; GRAPH RESULTS IN 2.5
;
GRAPH(DFN,DEFEF) ; EP-GIVEN PT DFN AND ENCOUNTER FORM IEN, RETURN ALL DATA TO MAKE ALL OF THAT FORMS GRAPHS
I '$D(^VEN(7.41,+$G(DEFEF),6)) Q ; NO GRAPHS ASSOCIATED WITH THIS FORM
I '$D(^DPT(+$G(DFN),0)) Q ; INVALID PATIENT DFN
N RIEN,GIEN,NAME,GNAME,XAX,YAX,UNITS,MVS,MVSTG,OTRANS
N VAL3,VAL,MAXM,MAXDP,RTYPE,LIEN,MIEN,OBFLD,DATA,TOT,STG,X,Y,%
S GIEN=0,TOT=0,STG=""
F S GIEN=$O(^VEN(7.41,DEFEF,6,GIEN)) Q:'GIEN S RIEN=+$G(^VEN(7.41,DEFEF,6,GIEN,0)) I RIEN D
. S X=$G(^VEN(7.63,RIEN,0)) I '$L(X) Q
. S NAME=$P(X,U),RTYPE=$P(X,U,2),MAXM=$P(X,U,3),MAXDP=$P(X,U,4),GNAME=$P(X,U,5),XAX=$P(X,U,6)
. S YAX=$P(X,U,7),UNITS=$P(X,U,8),MIEN=$P(X,U,11),LIEN=$P(X,U,12),OBFLD=$P(X,U,13),MVS=$G(^VEN(7.63,RIEN,1)),OTRANS=$G(^VEN(7.63,RIEN,2))
. I 'RTYPE Q
. I GNAME="" S GNAME=NAME ; GRAPH NAME
. I MAXM="" S MAXM=24 ; MAX MONTHS
. I MAXDP="" S MAXDP=25 ; MAX DATA POINTS
. S MVSTG=$$MVS(MVS) ; MULTIVALUED RESULTS
. S DATA=$$DATA(RTYPE) I DATA="" S DATA="NO DATA AVAILABLE"
. S TOT=TOT+1
. S $P(STG,"`",TOT)=GNAME_"\"_XAX_"\"_YAX_"\"_UNITS_"\"_$P(MVSTG,"~",2,99)_"\"_DATA
S SPECHOLD("u90")=STG ; ALL GRAPH RESULTS STORED IN MAIL MERGE FIELD "u90"
Q
;
MVS(MVS) ; EP-GET MULTIVALUED DATA ELEMENT NAMES AND DELIMITER
N STG,PCE,DELIM
I MVS["-" S DELIM="-" G MVS1
I MVS["/" S DELIM="/" G MVS1
I MVS[":" S DELIM=":" G MVS1
I MVS[";" S DELIM=";" G MVS1
Q ""
MVS1 I $L(MVS)<3 Q ""
S STG=DELIM
F PCE=1:1:$L(MVS,DELIM) S STG=STG_"~"_$P(MVS,DELIM,PCE)
Q STG
;
DATA(RTYPE) ; EP-RETURN THE DATA STRING
N RES,DATE,VAL1,VAL2
I RTYPE=1 Q $$MEAS(DFN,MAXM,MAXDP,MIEN,MVSTG,OTRANS)
I RTYPE=2 Q $$LAB(DFN,MAXM,MAXDP,LIEN,MVSTG,OTRANS)
I RTYPE=3 Q $$OB(DFN,MAXM,MAXDP,OBFLD,MVSTG,OTRANS)
Q ""
;
LAB(DFN,MAXM,MAXDP,LIEN,MVSTG,OTRANS) ; EP-RETURN LAB RESULTS
N VLIEN,IDATE,X,Y,DATE,STG,RES,DELIM,TOT,STOP,VIEN,PCE
S IDATE=0,STG="",TOT=0
F Q:$G(STOP) S IDATE=$O(^AUPNVLAB("AA",DFN,LIEN,IDATE)) Q:'IDATE S VLIEN=0 F Q:$G(STOP) S VLIEN=$O(^AUPNVLAB("AA",DFN,LIEN,IDATE,VLIEN)) Q:'VLIEN D
. S X=$G(^AUPNVLAB(VLIEN,0)) I '$L(X) Q
. S VIEN=+$P(X,U,3) I 'VIEN Q
. S Y=+$G(^AUPNVSIT(VIEN,0)) I 'Y Q
. S Y=Y\1
. I $$CHKDT(Y,MAXM) S DATE=$$DT(Y)
. E S STOP=1 Q
. S RES=$P($G(^AUPNVLAB(VLIEN,0)),U,4)
. I '$L(RES) Q
. I $L(MVSTG) S DELIM=$P(MVSTG,"~"),RES=$TR(RES,DELIM,"~")
. I $L(OTRANS) F PCE=1:1:$L(RES,"~") S X=$P(RES,"~",PCE) X OTRANS S $P(RES,"~",PCE)=X
. I STG'="" S STG=STG_"|"
. S STG=STG_DATE_"~"_RES
. S TOT=TOT+1
. I TOT=MAXDP S STOP=1
. Q
Q STG
;
MEAS(DFN,MAXM,MAXDP,MIEN,MVSTG,OTRANS) ; EP-RETURN MEASUREMENT RESULTS
N VMIEN,IDATE,X,Y,DATE,STG,RES,DELIM,TOT,STOP,VIEN,PCE,FLD,SS,PCE,FLDN
S IDATE=0,STG="",TOT=0
F Q:$G(STOP) S IDATE=$O(^AUPNVMSR("AA",DFN,MIEN,IDATE)) Q:'IDATE S VMIEN=0 F Q:$G(STOP) S VMIEN=$O(^AUPNVMSR("AA",DFN,MIEN,IDATE,VMIEN)) Q:'VMIEN D
. S X=$G(^AUPNVMSR(VMIEN,0)) I '$L(X) Q
. S VIEN=+$P(X,U,3) I 'VIEN Q
. S Y=+$G(^AUPNVSIT(VIEN,0)) I 'Y Q
. S Y=Y\1
. I $$CHKDT(Y,MAXM) S DATE=$$DT(Y)
. E S STOP=1 Q
. S RES=$P($G(^AUPNVMSR(VMIEN,0)),U,4)
. I '$L(RES) Q
. F Q:RES'["/20" S RES=$P(RES,"/20",1)_$P(RES,"/20",2,99)
. I $L(MVSTG) S DELIM=$P(MVSTG,"~"),RES=$TR(RES,DELIM,"~")
. I $L(OTRANS) F PCE=1:1:$L(RES,"~") S X=$P(RES,"~",PCE) X OTRANS S $P(RES,"~",PCE)=X
. I STG'="" S STG=STG_"|"
. S STG=STG_DATE_"~"_RES
. S TOT=TOT+1
. I TOT=MAXDP S STOP=1
. Q
Q STG
;
OB(DFN,MAXM,MAXDP,OBFLD,MVSTG,OTRANS) ; EP-RETURN PRENATAL RESULTS
N VOBIEN,IDATE,X,Y,DATE,STG,RES,DELIM,TOT,STOP,VIEN,PCE,SS,PCE,FLDN,%
S IDATE=0,STG="",TOT=0
I '$L($G(OBFLD)) Q
S FLDN=$O(^DD(9000010.43,"B",OBFLD,0)) I 'FLDN Q
S %=$P($G(^DD(9000010.43,FLDN,0)),U,4),SS=$P(%,";"),PCE=$P(%,";",2) ; GET DATA LOCATION PARAMETERS
I $L(SS),PCE
E Q
F Q:$G(STOP) S IDATE=$O(^AUPNVOB("AA",DFN,IDATE)) Q:'IDATE S VOBIEN=0 F Q:$G(STOP) S VOBIEN=$O(^AUPNVOB("AA",DFN,IDATE,VOBIEN)) Q:'VOBIEN D
. S X=$G(^AUPNVOB(VOBIEN,0)) I '$L(X) Q
. S VIEN=+$P(X,U,3) I 'VIEN Q
. S Y=+$G(^AUPNVSIT(VIEN,0)) I 'Y Q
. S Y=Y\1
. I $$CHKDT(Y,MAXM) S DATE=$$DT(Y)
. E S STOP=1 Q
. S RES=$P($G(^AUPNVOB(VOBIEN,SS)),U,PCE)
. I '$L(RES) Q
. I $L(MVSTG) S DELIM=$P(MVSTG,"~"),RES=$TR(RES,DELIM,"~")
. I $L(OTRANS) F PCE=1:1:$L(RES,"~") S X=$P(RES,"~",PCE) X OTRANS S $P(RES,"~",PCE)=X
. I STG'="" S STG=STG_"|"
. S STG=STG_DATE_"~"_RES
. S TOT=TOT+1
. I TOT=MAXDP S STOP=1
. Q
Q STG
;
DT(X) ; CONVERT A DATE
N D,M,Y
S D=$E(X,6,7)
S M=$E(X,4,5)
S Y=$E(X,1,3)+1700
Q M_"/"_D_"/"_Y
;
CHKDT(DATE,MAXM) ; CHECK DATE
N M,D,Y,X,Z,R
S Y=$E(DT,1,3),M=$E(DT,4,5),D=$E(DT,6,7)
I MAXM>11 D G C1
. S X=MAXM\12,Y=Y-X
. S R=MAXM#12
. I M>R S M=M-R Q
. S Y=Y-1,M=12-(R-M)
. Q
I M>MAXM S M=M-MAXM
E S Y=Y-1,M=12-(MAXM-M)
C1 S M=+M
I M=2,D>28 S D=28
I D=31,M=11 S D=30
I D=31,"469"[M S D=30
I $L(M)=1 S M="0"_M
S Z=(Y_M_D)
I DATE<Z Q 0
Q 1
;
BMI(DFN,WT,IDATE) ; EP- GIVEN PT DFN, WT AND INVERSE DATE, RETURN THE BMI FOR THAT DATE
N X
I $D(^DPT(+$G(DFN),0)),$G(WT),$G(IDATE)
E Q ""
S X=$$BMI^APCHS2A3(DFN,WT,IDATE)
S X=+$$STRIP^VENPCCU(X)
I 'X Q ""
Q X
;
FUND(VOBIEN,PCE) ; EP-GIVEN V OB IEN AND RESULT PIECE RETURN THE COMPOUND VALUE FUNDAL HT / EGW
N X,EWG,FH
I '$D(^AUPNVOB(+$G(VOBIEN),1)) Q ""
I $G(PCE)'=1 Q ""
S X=^AUPNVOB(VOBIEN,1),FH=$P(X,U,3),EWG=$P(X,U,13)
I FH,EWG
E Q ""
Q FH_"~"_EWG
;
VENPCCS3 ; IHS/OIT/GIS - RESULT GRAPHING ;
+1 ;;2.6;PCC+;;NOV 12, 2007
+2 ;
+3 ; GRAPH RESULTS IN 2.5
+4 ;
GRAPH(DFN,DEFEF) ; EP-GIVEN PT DFN AND ENCOUNTER FORM IEN, RETURN ALL DATA TO MAKE ALL OF THAT FORMS GRAPHS
+1 ; NO GRAPHS ASSOCIATED WITH THIS FORM
IF '$DATA(^VEN(7.41,+$GET(DEFEF),6))
QUIT
+2 ; INVALID PATIENT DFN
IF '$DATA(^DPT(+$GET(DFN),0))
QUIT
+3 NEW RIEN,GIEN,NAME,GNAME,XAX,YAX,UNITS,MVS,MVSTG,OTRANS
+4 NEW VAL3,VAL,MAXM,MAXDP,RTYPE,LIEN,MIEN,OBFLD,DATA,TOT,STG,X,Y,%
+5 SET GIEN=0
SET TOT=0
SET STG=""
+6 FOR
SET GIEN=$ORDER(^VEN(7.41,DEFEF,6,GIEN))
IF 'GIEN
QUIT
SET RIEN=+$GET(^VEN(7.41,DEFEF,6,GIEN,0))
IF RIEN
Begin DoDot:1
+7 SET X=$GET(^VEN(7.63,RIEN,0))
IF '$LENGTH(X)
QUIT
+8 SET NAME=$PIECE(X,U)
SET RTYPE=$PIECE(X,U,2)
SET MAXM=$PIECE(X,U,3)
SET MAXDP=$PIECE(X,U,4)
SET GNAME=$PIECE(X,U,5)
SET XAX=$PIECE(X,U,6)
+9 SET YAX=$PIECE(X,U,7)
SET UNITS=$PIECE(X,U,8)
SET MIEN=$PIECE(X,U,11)
SET LIEN=$PIECE(X,U,12)
SET OBFLD=$PIECE(X,U,13)
SET MVS=$GET(^VEN(7.63,RIEN,1))
SET OTRANS=$GET(^VEN(7.63,RIEN,2))
+10 IF 'RTYPE
QUIT
+11 ; GRAPH NAME
IF GNAME=""
SET GNAME=NAME
+12 ; MAX MONTHS
IF MAXM=""
SET MAXM=24
+13 ; MAX DATA POINTS
IF MAXDP=""
SET MAXDP=25
+14 ; MULTIVALUED RESULTS
SET MVSTG=$$MVS(MVS)
+15 SET DATA=$$DATA(RTYPE)
IF DATA=""
SET DATA="NO DATA AVAILABLE"
+16 SET TOT=TOT+1
+17 SET $PIECE(STG,"`",TOT)=GNAME_"\"_XAX_"\"_YAX_"\"_UNITS_"\"_$PIECE(MVSTG,"~",2,99)_"\"_DATA
End DoDot:1
+18 ; ALL GRAPH RESULTS STORED IN MAIL MERGE FIELD "u90"
SET SPECHOLD("u90")=STG
+19 QUIT
+20 ;
MVS(MVS) ; EP-GET MULTIVALUED DATA ELEMENT NAMES AND DELIMITER
+1 NEW STG,PCE,DELIM
+2 IF MVS["-"
SET DELIM="-"
GOTO MVS1
+3 IF MVS["/"
SET DELIM="/"
GOTO MVS1
+4 IF MVS[":"
SET DELIM=":"
GOTO MVS1
+5 IF MVS[";"
SET DELIM=";"
GOTO MVS1
+6 QUIT ""
MVS1 IF $LENGTH(MVS)<3
QUIT ""
+1 SET STG=DELIM
+2 FOR PCE=1:1:$LENGTH(MVS,DELIM)
SET STG=STG_"~"_$PIECE(MVS,DELIM,PCE)
+3 QUIT STG
+4 ;
DATA(RTYPE) ; EP-RETURN THE DATA STRING
+1 NEW RES,DATE,VAL1,VAL2
+2 IF RTYPE=1
QUIT $$MEAS(DFN,MAXM,MAXDP,MIEN,MVSTG,OTRANS)
+3 IF RTYPE=2
QUIT $$LAB(DFN,MAXM,MAXDP,LIEN,MVSTG,OTRANS)
+4 IF RTYPE=3
QUIT $$OB(DFN,MAXM,MAXDP,OBFLD,MVSTG,OTRANS)
+5 QUIT ""
+6 ;
LAB(DFN,MAXM,MAXDP,LIEN,MVSTG,OTRANS) ; EP-RETURN LAB RESULTS
+1 NEW VLIEN,IDATE,X,Y,DATE,STG,RES,DELIM,TOT,STOP,VIEN,PCE
+2 SET IDATE=0
SET STG=""
SET TOT=0
+3 FOR
IF $GET(STOP)
QUIT
SET IDATE=$ORDER(^AUPNVLAB("AA",DFN,LIEN,IDATE))
IF 'IDATE
QUIT
SET VLIEN=0
FOR
IF $GET(STOP)
QUIT
SET VLIEN=$ORDER(^AUPNVLAB("AA",DFN,LIEN,IDATE,VLIEN))
IF 'VLIEN
QUIT
Begin DoDot:1
+4 SET X=$GET(^AUPNVLAB(VLIEN,0))
IF '$LENGTH(X)
QUIT
+5 SET VIEN=+$PIECE(X,U,3)
IF 'VIEN
QUIT
+6 SET Y=+$GET(^AUPNVSIT(VIEN,0))
IF 'Y
QUIT
+7 SET Y=Y\1
+8 IF $$CHKDT(Y,MAXM)
SET DATE=$$DT(Y)
+9 IF '$TEST
SET STOP=1
QUIT
+10 SET RES=$PIECE($GET(^AUPNVLAB(VLIEN,0)),U,4)
+11 IF '$LENGTH(RES)
QUIT
+12 IF $LENGTH(MVSTG)
SET DELIM=$PIECE(MVSTG,"~")
SET RES=$TRANSLATE(RES,DELIM,"~")
+13 IF $LENGTH(OTRANS)
FOR PCE=1:1:$LENGTH(RES,"~")
SET X=$PIECE(RES,"~",PCE)
XECUTE OTRANS
SET $PIECE(RES,"~",PCE)=X
+14 IF STG'=""
SET STG=STG_"|"
+15 SET STG=STG_DATE_"~"_RES
+16 SET TOT=TOT+1
+17 IF TOT=MAXDP
SET STOP=1
+18 QUIT
End DoDot:1
+19 QUIT STG
+20 ;
MEAS(DFN,MAXM,MAXDP,MIEN,MVSTG,OTRANS) ; EP-RETURN MEASUREMENT RESULTS
+1 NEW VMIEN,IDATE,X,Y,DATE,STG,RES,DELIM,TOT,STOP,VIEN,PCE,FLD,SS,PCE,FLDN
+2 SET IDATE=0
SET STG=""
SET TOT=0
+3 FOR
IF $GET(STOP)
QUIT
SET IDATE=$ORDER(^AUPNVMSR("AA",DFN,MIEN,IDATE))
IF 'IDATE
QUIT
SET VMIEN=0
FOR
IF $GET(STOP)
QUIT
SET VMIEN=$ORDER(^AUPNVMSR("AA",DFN,MIEN,IDATE,VMIEN))
IF 'VMIEN
QUIT
Begin DoDot:1
+4 SET X=$GET(^AUPNVMSR(VMIEN,0))
IF '$LENGTH(X)
QUIT
+5 SET VIEN=+$PIECE(X,U,3)
IF 'VIEN
QUIT
+6 SET Y=+$GET(^AUPNVSIT(VIEN,0))
IF 'Y
QUIT
+7 SET Y=Y\1
+8 IF $$CHKDT(Y,MAXM)
SET DATE=$$DT(Y)
+9 IF '$TEST
SET STOP=1
QUIT
+10 SET RES=$PIECE($GET(^AUPNVMSR(VMIEN,0)),U,4)
+11 IF '$LENGTH(RES)
QUIT
+12 FOR
IF RES'["/20"
QUIT
SET RES=$PIECE(RES,"/20",1)_$PIECE(RES,"/20",2,99)
+13 IF $LENGTH(MVSTG)
SET DELIM=$PIECE(MVSTG,"~")
SET RES=$TRANSLATE(RES,DELIM,"~")
+14 IF $LENGTH(OTRANS)
FOR PCE=1:1:$LENGTH(RES,"~")
SET X=$PIECE(RES,"~",PCE)
XECUTE OTRANS
SET $PIECE(RES,"~",PCE)=X
+15 IF STG'=""
SET STG=STG_"|"
+16 SET STG=STG_DATE_"~"_RES
+17 SET TOT=TOT+1
+18 IF TOT=MAXDP
SET STOP=1
+19 QUIT
End DoDot:1
+20 QUIT STG
+21 ;
OB(DFN,MAXM,MAXDP,OBFLD,MVSTG,OTRANS) ; EP-RETURN PRENATAL RESULTS
+1 NEW VOBIEN,IDATE,X,Y,DATE,STG,RES,DELIM,TOT,STOP,VIEN,PCE,SS,PCE,FLDN,%
+2 SET IDATE=0
SET STG=""
SET TOT=0
+3 IF '$LENGTH($GET(OBFLD))
QUIT
+4 SET FLDN=$ORDER(^DD(9000010.43,"B",OBFLD,0))
IF 'FLDN
QUIT
+5 ; GET DATA LOCATION PARAMETERS
SET %=$PIECE($GET(^DD(9000010.43,FLDN,0)),U,4)
SET SS=$PIECE(%,";")
SET PCE=$PIECE(%,";",2)
+6 IF $LENGTH(SS)
IF PCE
+7 IF '$TEST
QUIT
+8 FOR
IF $GET(STOP)
QUIT
SET IDATE=$ORDER(^AUPNVOB("AA",DFN,IDATE))
IF 'IDATE
QUIT
SET VOBIEN=0
FOR
IF $GET(STOP)
QUIT
SET VOBIEN=$ORDER(^AUPNVOB("AA",DFN,IDATE,VOBIEN))
IF 'VOBIEN
QUIT
Begin DoDot:1
+9 SET X=$GET(^AUPNVOB(VOBIEN,0))
IF '$LENGTH(X)
QUIT
+10 SET VIEN=+$PIECE(X,U,3)
IF 'VIEN
QUIT
+11 SET Y=+$GET(^AUPNVSIT(VIEN,0))
IF 'Y
QUIT
+12 SET Y=Y\1
+13 IF $$CHKDT(Y,MAXM)
SET DATE=$$DT(Y)
+14 IF '$TEST
SET STOP=1
QUIT
+15 SET RES=$PIECE($GET(^AUPNVOB(VOBIEN,SS)),U,PCE)
+16 IF '$LENGTH(RES)
QUIT
+17 IF $LENGTH(MVSTG)
SET DELIM=$PIECE(MVSTG,"~")
SET RES=$TRANSLATE(RES,DELIM,"~")
+18 IF $LENGTH(OTRANS)
FOR PCE=1:1:$LENGTH(RES,"~")
SET X=$PIECE(RES,"~",PCE)
XECUTE OTRANS
SET $PIECE(RES,"~",PCE)=X
+19 IF STG'=""
SET STG=STG_"|"
+20 SET STG=STG_DATE_"~"_RES
+21 SET TOT=TOT+1
+22 IF TOT=MAXDP
SET STOP=1
+23 QUIT
End DoDot:1
+24 QUIT STG
+25 ;
DT(X) ; CONVERT A DATE
+1 NEW D,M,Y
+2 SET D=$EXTRACT(X,6,7)
+3 SET M=$EXTRACT(X,4,5)
+4 SET Y=$EXTRACT(X,1,3)+1700
+5 QUIT M_"/"_D_"/"_Y
+6 ;
CHKDT(DATE,MAXM) ; CHECK DATE
+1 NEW M,D,Y,X,Z,R
+2 SET Y=$EXTRACT(DT,1,3)
SET M=$EXTRACT(DT,4,5)
SET D=$EXTRACT(DT,6,7)
+3 IF MAXM>11
Begin DoDot:1
+4 SET X=MAXM\12
SET Y=Y-X
+5 SET R=MAXM#12
+6 IF M>R
SET M=M-R
QUIT
+7 SET Y=Y-1
SET M=12-(R-M)
+8 QUIT
End DoDot:1
GOTO C1
+9 IF M>MAXM
SET M=M-MAXM
+10 IF '$TEST
SET Y=Y-1
SET M=12-(MAXM-M)
C1 SET M=+M
+1 IF M=2
IF D>28
SET D=28
+2 IF D=31
IF M=11
SET D=30
+3 IF D=31
IF "469"[M
SET D=30
+4 IF $LENGTH(M)=1
SET M="0"_M
+5 SET Z=(Y_M_D)
+6 IF DATE<Z
QUIT 0
+7 QUIT 1
+8 ;
BMI(DFN,WT,IDATE) ; EP- GIVEN PT DFN, WT AND INVERSE DATE, RETURN THE BMI FOR THAT DATE
+1 NEW X
+2 IF $DATA(^DPT(+$GET(DFN),0))
IF $GET(WT)
IF $GET(IDATE)
+3 IF '$TEST
QUIT ""
+4 SET X=$$BMI^APCHS2A3(DFN,WT,IDATE)
+5 SET X=+$$STRIP^VENPCCU(X)
+6 IF 'X
QUIT ""
+7 QUIT X
+8 ;
FUND(VOBIEN,PCE) ; EP-GIVEN V OB IEN AND RESULT PIECE RETURN THE COMPOUND VALUE FUNDAL HT / EGW
+1 NEW X,EWG,FH
+2 IF '$DATA(^AUPNVOB(+$GET(VOBIEN),1))
QUIT ""
+3 IF $GET(PCE)'=1
QUIT ""
+4 SET X=^AUPNVOB(VOBIEN,1)
SET FH=$PIECE(X,U,3)
SET EWG=$PIECE(X,U,13)
+5 IF FH
IF EWG
+6 IF '$TEST
QUIT ""
+7 QUIT FH_"~"_EWG
+8 ;
