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