APCDMSR1 ; IHS/CMI/LAB - Cumulative Vital Measurement Report 22-Jun-2007 15:09 PLS ;
;;2.0;IHS PCC SUITE;**10**;MAY 14, 2009;Build 88
Q
; Generate a cumulative report
CRPT(DFN,SDT,EDT) ; PEP - API FOR PATIENT CUMULATIVE VITALS REPORT
; INPUT VARIABLES: DFN=PATIENT NUMBER
; SDT=START DATE
; EDT=FINISH DATE OF REPORT
N HOSPLOC,VITDATE,PAGE,VITOR,GBED,VIT1ST,PDT,DASH,VTYPE,VTYPEI
N VA,GWARD,GMRS,GFLAG,VDT,VDA,VBMI,VAL,GPRT
S VITOR=1
S (OUT,PAGE)=0 D DEM^VADPT,INP^VADPT S GBED=$S(VAIN(5)'="":VAIN(5),1:" "),GWARD=$S($P(VAIN(4),"^",2)="":" ",1:$P(VAIN(4),"^",2))
S VIT1ST=1,VITDATE(0)=0
S PDT=$$FMTE^XLFDT($$NOW^XLFDT())
S PDT=$P(PDT,"@")_" ( "_$P($P(PDT,"@",2),":",1,2)_")"
S $P(DASH,"-",81)=""
;
K ^TMP($J,"APCD")
F VTYPE="TMP","PU","RS","BP","HT","WT","AG","WC","PA" D
.S VTYPEI=$$FIND1^DIC(9999999.07,,,VTYPE)
.I VTYPEI>0 D SETAR
;
U IO D HDR
;
I $O(^TMP($J,"APCD",0))'>0 D G Q3
.W !!,"No cumulative vitals data for "_$S($D(OPSPNM):ORSPNM,1:"this patient"),!
.S:$D(ORSPNM) OUT=1
F VITDATE=0:0 S VITDATE=$O(VDT(VITDATE)) Q:VITDATE'>0!OUT D
.I $D(^TMP($J,"APCD",VITDATE)) D PRT
Q3 I IOSL'<($Y+10) F X=1:1 W ! Q:IOSL<($Y+10)
I 'OUT W ! D
.D FOOTER
.I '$D(VITOR),$E(IOST)'="P",'OUT D Q:OUT
..W !,"Press return to continue or ""^"" to exit " R X:DTIME S:'$T!(X["^") OUT=1
D KVAR^VADPT
K ^TMP($J,"APCD")
I $D(ORSPNM) S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC
Q
;
HDR ;
I 'VIT1ST D FOOTER
I $E(IOST)'="P",'VIT1ST D Q:OUT
.W "Press return to continue ""^"" to escape " R X:DTIME I X="^"!'$T S OUT=1
W:'($E(IOST)'="C"&'$D(GFLAG)) @IOF
S PAGE=PAGE+1,GFLAG=1
W !,PDT,?25,"Cumulative Vitals/Measurements Report",?70,"Page ",PAGE,!!,$E(DASH,1,78)
I 'VIT1ST,$P(VITDATE,".")=VITDATE(0) D
.W !,$$FMTE^XLFDT(VITDATE,"5DZ")_" (continued)",! ;$E(VITDATE(0),4,5)_"/"_$E(VITDATE(0),6,7)_"/"_$E(VITDATE,2,3)_" (continued)",!
S VIT1ST=0
Q
W !!,"*** (E) - Error entry",!!
W:VADM(1)'="" ?$X-3,$E(VADM(1),1,15)
W ?17,$G(VA("PID"))
W:VADM(3) ?30,$P(VADM(3),U,2)
W:VADM(4)'="" ?43,$P(VADM(4),U)_" YRS"
W:VADM(5)'="" ?51,$P(VADM(5),U,2)
W !,"Unit: "_$S($P(VAIN(4),U,2)'="":$P(VAIN(4),U,2),1:" "),?32,"Room: "_$S($P(VAIN(5),U)'="":$P(VAIN(5),U),1:" "),!
I '$D(HOSPLOC) S HOSPLOC=$P($G(^DIC(42,+$G(VAIN(4)),44)),U)
W "Division: "_$S(HOSPLOC>0:$$GET1^DIQ(4,+$$GET1^DIQ(44,+HOSPLOC,3,"I"),.01,"I"),1:""),!
Q
BLNK ;
F I=1:1:$L(VAL) Q:$E(VAL,I)'=" "
S VAL=$E(VAL,I,$L(VAL))
Q
SETAR ;
S VDT=0 F S VDT=$O(^AUPNVMSR("AA",DFN,VTYPEI,VDT)) Q:VDT'>0 D
.S VITDATE=9999999-VDT ;I '(VITDATE>EDT!(VITDATE<SDT)) D SETND
.D SETND
Q
SETND ;
S VDA=0 F S VDA=$O(^AUPNVMSR("AA",DFN,VTYPEI,VDT,VDA)) Q:VDA'>0 D SETUT
Q
SETUT N EVDATE
S EVDATE=+$P($G(^AUPNVMSR(VDA,12)),U)
S EVDATE=$S(EVDATE:EVDATE,1:VITDATE)
S EVDATE=$E(EVDATE,1,12)
S EVDATE=+EVDATE ;ihs/cmi/maw 07/16/2013 patch 10
Q:(EVDATE<SDT)!(EVDATE>EDT)
S ^TMP($J,"APCD",EVDATE,VTYPE,VDA)=0
S VDT(EVDATE)=""
Q
; Return date/time associated with Vital entry
VITDATE(IEN) ;
Q RES
PRT ;PRINT V/M BY DATE/TIME
D:IOSL<($Y+9) HDR Q:OUT
I $P(VITDATE,".")'=VITDATE(0) D
.W !,$$FMTE^XLFDT(VITDATE,"5Z")
.S VITDATE(0)=$P(VITDATE,".")
D:IOSL<($Y+9) HDR Q:OUT
W !,$P($P($$FMTE^XLFDT(VITDATE),"@",2),":",1,2)
I $D(^TMP($J,"APCD",VITDATE)) D
.K APCDLN,GERROR
.F VTYPE="TMP","PU","RS","BP","HT","WT","AG","WC","PA" S GPRT(VTYPE)=0 D
..I $D(^TMP($J,"APCD",VITDATE,VTYPE)) F VDA=0:0 S VDA=$O(^TMP($J,"APCD",VITDATE,VTYPE,VDA)) Q:VDA'>0!OUT D SETLN
Q
SETLN ;
S VVER=^TMP($J,"APCD",VITDATE,VTYPE,VDA) N VPO
D:IOSL<($Y+9) HDR Q:OUT W ! W:VVER "(E)"
I GPRT(VTYPE)=0 D
. W ?4,$S(VTYPE="TMP":"TMP: ",VTYPE="PU":"PU: ",VTYPE="RS":"RS: ",VTYPE="BP":"B/P: ",VTYPE="WT":"Wt: ",VTYPE="HT":"Ht: ",VTYPE="AG":"Abdominal Girth: ",VTYPE="WC":"Waist Circumference: ",1:" ") ;VTYPE="PA":"Pain: ",1:" ")
. I VTYPE="PA" W ?4,"Pain: "
S GPRT(VTYPE)=1
S VDAT=^AUPNVMSR(VDA,0)
I "PURSBPWCAGPA"[VTYPE S VVX=VTYPE,VVX(0)=$P(VDAT,U,4) D
. I "UNAVAILABLEPASSREFUSED"[$$UP^XLFSTR(VVX(0)) W ?9,VVX(0) Q
. I VTYPE="PA" D
. . I VVX(0)=0 W ?9,VVX(0)_" - No pain" Q
. . I VVX(0)=99 W ?9,VVX(0)_" - Unable to respond" Q
. . I VVX(0)=10 W ?9,VVX(0)_" - Worst imaginable pain" Q
. . W ?9,VVX(0) Q
. S VAL=$S(VTYPE="AG"!(VTYPE="WC"):$J($P(VDAT,U,4),0,2),VTYPE'="BP":$J($P(VDAT,U,4),3,0),1:$P(VDAT,U,4)) D:VTYPE'="BP" BLNK W:VTYPE'="PA" ?9,VAL_$S('$D(VVX(1)):" ",'VVX(1):"",1:"*")
. I VTYPE="AG" W " in ("_$J(VAL/.3937,0,2)_" cm)"
. I VTYPE="WC" W " in ("_$J(VAL/.3937,0,2)_" cm)"
I VTYPE="TMP" S X=$P(VDAT,U,4) D
. I X'>0 W ?9,X Q
. S VVX=VTYPE,VVX(0)=X
. S Y=$J(X-32*5/9,0,1)
. S:'Y Y="" S VAL=$J(X,5,1) D BLNK W ?9,VAL_" F " S VAL=$J(Y,4,1) D BLNK W "("_VAL_" C)"_$S('$D(VVX(1)):" ",'VVX(1):"",1:"*")
I VTYPE="HT" S X=$P(VDAT,U,4) D
. I X'>0 W ?9,X Q
. S Y=$J(2.54*X,0,2)
. S:'Y Y="" S VAL=$J(X,5,2) D BLNK W ?9,VAL_" in " S VAL=$J(Y,5,2) D BLNK W "("_VAL_" cm)" I 'VVER S GMRVHT=VAL/100
I VTYPE="WT" S X=$P(VDAT,U,4) D
. I X'>0 W ?9,X Q
. S Y=$J(X/2.2,0,2)
. S:'Y Y="" S VAL=$J(X,7,2) D BLNK W ?9,VAL_" lb " S VAL=$J(Y,6,2) D BLNK W "("_VAL_" kg)"
I VTYPE="WT",'VVER S VBMI="",VBMI(1)=$P(VDAT,"^"),VBMI(2)=+$P(VDAT,U,4) D
.S VBMI=+$$TRIM^XLFSTR($$GETBMI(DFN,$P(VDAT,U,4),VITDATE))
.W:VBMI !,?4,"Body Mass Index: "_VBMI
Q
GETBMI(DFN,WT,DATE) ;EP
N X,Y
Q $$BMI^APCHS2A3(DFN,WT,DATE)
;
APCDMSR1 ; IHS/CMI/LAB - Cumulative Vital Measurement Report 22-Jun-2007 15:09 PLS ;
+1 ;;2.0;IHS PCC SUITE;**10**;MAY 14, 2009;Build 88
+2 QUIT
+3 ; Generate a cumulative report
CRPT(DFN,SDT,EDT) ; PEP - API FOR PATIENT CUMULATIVE VITALS REPORT
+1 ; INPUT VARIABLES: DFN=PATIENT NUMBER
+2 ; SDT=START DATE
+3 ; EDT=FINISH DATE OF REPORT
+4 NEW HOSPLOC,VITDATE,PAGE,VITOR,GBED,VIT1ST,PDT,DASH,VTYPE,VTYPEI
+5 NEW VA,GWARD,GMRS,GFLAG,VDT,VDA,VBMI,VAL,GPRT
+6 SET VITOR=1
+7 SET (OUT,PAGE)=0
DO DEM^VADPT
DO INP^VADPT
SET GBED=$SELECT(VAIN(5)'="":VAIN(5),1:" ")
SET GWARD=$SELECT($PIECE(VAIN(4),"^",2)="":" ",1:$PIECE(VAIN(4),"^",2))
+8 SET VIT1ST=1
SET VITDATE(0)=0
+9 SET PDT=$$FMTE^XLFDT($$NOW^XLFDT())
+10 SET PDT=$PIECE(PDT,"@")_" ( "_$PIECE($PIECE(PDT,"@",2),":",1,2)_")"
+11 SET $PIECE(DASH,"-",81)=""
+12 ;
+13 KILL ^TMP($JOB,"APCD")
+14 FOR VTYPE="TMP","PU","RS","BP","HT","WT","AG","WC","PA"
Begin DoDot:1
+15 SET VTYPEI=$$FIND1^DIC(9999999.07,,,VTYPE)
+16 IF VTYPEI>0
DO SETAR
End DoDot:1
+17 ;
+18 USE IO
DO HDR
+19 ;
+20 IF $ORDER(^TMP($JOB,"APCD",0))'>0
Begin DoDot:1
+21 WRITE !!,"No cumulative vitals data for "_$SELECT($DATA(OPSPNM):ORSPNM,1:"this patient"),!
+22 IF $DATA(ORSPNM)
SET OUT=1
End DoDot:1
GOTO Q3
+23 FOR VITDATE=0:0
SET VITDATE=$ORDER(VDT(VITDATE))
IF VITDATE'>0!OUT
QUIT
Begin DoDot:1
+24 IF $DATA(^TMP($JOB,"APCD",VITDATE))
DO PRT
End DoDot:1
Q3 IF IOSL'<($Y+10)
FOR X=1:1
WRITE !
IF IOSL<($Y+10)
QUIT
+1 IF 'OUT
WRITE !
Begin DoDot:1
+2 DO FOOTER
+3 IF '$DATA(VITOR)
IF $EXTRACT(IOST)'="P"
IF 'OUT
Begin DoDot:2
+4 WRITE !,"Press return to continue or ""^"" to exit "
READ X:DTIME
IF '$TEST!(X["^")
SET OUT=1
End DoDot:2
IF OUT
QUIT
End DoDot:1
+5 DO KVAR^VADPT
+6 KILL ^TMP($JOB,"APCD")
+7 IF $DATA(ORSPNM)
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
DO ^%ZISC
+8 QUIT
+9 ;
HDR ;
+1 IF 'VIT1ST
DO FOOTER
+2 IF $EXTRACT(IOST)'="P"
IF 'VIT1ST
Begin DoDot:1
+3 WRITE "Press return to continue ""^"" to escape "
READ X:DTIME
IF X="^"!'$TEST
SET OUT=1
End DoDot:1
IF OUT
QUIT
+4 IF '($EXTRACT(IOST)'="C"&'$DATA(GFLAG))
WRITE @IOF
+5 SET PAGE=PAGE+1
SET GFLAG=1
+6 WRITE !,PDT,?25,"Cumulative Vitals/Measurements Report",?70,"Page ",PAGE,!!,$EXTRACT(DASH,1,78)
+7 IF 'VIT1ST
IF $PIECE(VITDATE,".")=VITDATE(0)
Begin DoDot:1
+8 ;$E(VITDATE(0),4,5)_"/"_$E(VITDATE(0),6,7)_"/"_$E(VITDATE,2,3)_" (continued)",!
WRITE !,$$FMTE^XLFDT(VITDATE,"5DZ")_" (continued)",!
End DoDot:1
+9 SET VIT1ST=0
+10 QUIT
+1 WRITE !!,"*** (E) - Error entry",!!
+2 IF VADM(1)'=""
WRITE ?$X-3,$EXTRACT(VADM(1),1,15)
+3 WRITE ?17,$GET(VA("PID"))
+4 IF VADM(3)
WRITE ?30,$PIECE(VADM(3),U,2)
+5 IF VADM(4)'=""
WRITE ?43,$PIECE(VADM(4),U)_" YRS"
+6 IF VADM(5)'=""
WRITE ?51,$PIECE(VADM(5),U,2)
+7 WRITE !,"Unit: "_$SELECT($PIECE(VAIN(4),U,2)'="":$PIECE(VAIN(4),U,2),1:" "),?32,"Room: "_$SELECT($PIECE(VAIN(5),U)'="":$PIECE(VAIN(5),U),1:" "),!
+8 IF '$DATA(HOSPLOC)
SET HOSPLOC=$PIECE($GET(^DIC(42,+$GET(VAIN(4)),44)),U)
+9 WRITE "Division: "_$SELECT(HOSPLOC>0:$$GET1^DIQ(4,+$$GET1^DIQ(44,+HOSPLOC,3,"I"),.01,"I"),1:""),!
+10 QUIT
BLNK ;
+1 FOR I=1:1:$LENGTH(VAL)
IF $EXTRACT(VAL,I)'=" "
QUIT
+2 SET VAL=$EXTRACT(VAL,I,$LENGTH(VAL))
+3 QUIT
SETAR ;
+1 SET VDT=0
FOR
SET VDT=$ORDER(^AUPNVMSR("AA",DFN,VTYPEI,VDT))
IF VDT'>0
QUIT
Begin DoDot:1
+2 ;I '(VITDATE>EDT!(VITDATE<SDT)) D SETND
SET VITDATE=9999999-VDT
+3 DO SETND
End DoDot:1
+4 QUIT
SETND ;
+1 SET VDA=0
FOR
SET VDA=$ORDER(^AUPNVMSR("AA",DFN,VTYPEI,VDT,VDA))
IF VDA'>0
QUIT
DO SETUT
+2 QUIT
SETUT NEW EVDATE
+1 SET EVDATE=+$PIECE($GET(^AUPNVMSR(VDA,12)),U)
+2 SET EVDATE=$SELECT(EVDATE:EVDATE,1:VITDATE)
+3 SET EVDATE=$EXTRACT(EVDATE,1,12)
+4 ;ihs/cmi/maw 07/16/2013 patch 10
SET EVDATE=+EVDATE
+5 IF (EVDATE<SDT)!(EVDATE>EDT)
QUIT
+6 SET ^TMP($JOB,"APCD",EVDATE,VTYPE,VDA)=0
+7 SET VDT(EVDATE)=""
+8 QUIT
+9 ; Return date/time associated with Vital entry
VITDATE(IEN) ;
+1 QUIT RES
PRT ;PRINT V/M BY DATE/TIME
+1 IF IOSL<($Y+9)
DO HDR
IF OUT
QUIT
+2 IF $PIECE(VITDATE,".")'=VITDATE(0)
Begin DoDot:1
+3 WRITE !,$$FMTE^XLFDT(VITDATE,"5Z")
+4 SET VITDATE(0)=$PIECE(VITDATE,".")
End DoDot:1
+5 IF IOSL<($Y+9)
DO HDR
IF OUT
QUIT
+6 WRITE !,$PIECE($PIECE($$FMTE^XLFDT(VITDATE),"@",2),":",1,2)
+7 IF $DATA(^TMP($JOB,"APCD",VITDATE))
Begin DoDot:1
+8 KILL APCDLN,GERROR
+9 FOR VTYPE="TMP","PU","RS","BP","HT","WT","AG","WC","PA"
SET GPRT(VTYPE)=0
Begin DoDot:2
+10 IF $DATA(^TMP($JOB,"APCD",VITDATE,VTYPE))
FOR VDA=0:0
SET VDA=$ORDER(^TMP($JOB,"APCD",VITDATE,VTYPE,VDA))
IF VDA'>0!OUT
QUIT
DO SETLN
End DoDot:2
End DoDot:1
+11 QUIT
SETLN ;
+1 SET VVER=^TMP($JOB,"APCD",VITDATE,VTYPE,VDA)
NEW VPO
+2 IF IOSL<($Y+9)
DO HDR
IF OUT
QUIT
WRITE !
IF VVER
WRITE "(E)"
+3 IF GPRT(VTYPE)=0
Begin DoDot:1
+4 ;VTYPE="PA":"Pain: ",1:" ")
WRITE ?4,$SELECT(VTYPE="TMP":"TMP: ",VTYPE="PU":"PU: ",VTYPE="RS":"RS: ",VTYPE="BP":"B/P: ",VTYPE="WT":"Wt: ",VTYPE="HT":"Ht: ",VTYPE="AG":"Abdominal Girth: ",VTYPE="WC":"Waist Circumference: ",1:" ")
+5 IF VTYPE="PA"
WRITE ?4,"Pain: "
End DoDot:1
+6 SET GPRT(VTYPE)=1
+7 SET VDAT=^AUPNVMSR(VDA,0)
+8 IF "PURSBPWCAGPA"[VTYPE
SET VVX=VTYPE
SET VVX(0)=$PIECE(VDAT,U,4)
Begin DoDot:1
+9 IF "UNAVAILABLEPASSREFUSED"[$$UP^XLFSTR(VVX(0))
WRITE ?9,VVX(0)
QUIT
+10 IF VTYPE="PA"
Begin DoDot:2
+11 IF VVX(0)=0
WRITE ?9,VVX(0)_" - No pain"
QUIT
+12 IF VVX(0)=99
WRITE ?9,VVX(0)_" - Unable to respond"
QUIT
+13 IF VVX(0)=10
WRITE ?9,VVX(0)_" - Worst imaginable pain"
QUIT
+14 WRITE ?9,VVX(0)
QUIT
End DoDot:2
+15 SET VAL=$SELECT(VTYPE="AG"!(VTYPE="WC"):$JUSTIFY($PIECE(VDAT,U,4),0,2),VTYPE'="BP":$JUSTIFY($PIECE(VDAT,U,4),3,0),1:$PIECE(VDAT,U,4))
IF VTYPE'="BP"
DO BLNK
IF VTYPE'="PA"
WRITE ?9,VAL_$SELECT('$DATA(VVX(1)):" ",'VVX(1):"",1:"*")
+16 IF VTYPE="AG"
WRITE " in ("_$JUSTIFY(VAL/.3937,0,2)_" cm)"
+17 IF VTYPE="WC"
WRITE " in ("_$JUSTIFY(VAL/.3937,0,2)_" cm)"
End DoDot:1
+18 IF VTYPE="TMP"
SET X=$PIECE(VDAT,U,4)
Begin DoDot:1
+19 IF X'>0
WRITE ?9,X
QUIT
+20 SET VVX=VTYPE
SET VVX(0)=X
+21 SET Y=$JUSTIFY(X-32*5/9,0,1)
+22 IF 'Y
SET Y=""
SET VAL=$JUSTIFY(X,5,1)
DO BLNK
WRITE ?9,VAL_" F "
SET VAL=$JUSTIFY(Y,4,1)
DO BLNK
WRITE "("_VAL_" C)"_$SELECT('$DATA(VVX(1)):" ",'VVX(1):"",1:"*")
End DoDot:1
+23 IF VTYPE="HT"
SET X=$PIECE(VDAT,U,4)
Begin DoDot:1
+24 IF X'>0
WRITE ?9,X
QUIT
+25 SET Y=$JUSTIFY(2.54*X,0,2)
+26 IF 'Y
SET Y=""
SET VAL=$JUSTIFY(X,5,2)
DO BLNK
WRITE ?9,VAL_" in "
SET VAL=$JUSTIFY(Y,5,2)
DO BLNK
WRITE "("_VAL_" cm)"
IF 'VVER
SET GMRVHT=VAL/100
End DoDot:1
+27 IF VTYPE="WT"
SET X=$PIECE(VDAT,U,4)
Begin DoDot:1
+28 IF X'>0
WRITE ?9,X
QUIT
+29 SET Y=$JUSTIFY(X/2.2,0,2)
+30 IF 'Y
SET Y=""
SET VAL=$JUSTIFY(X,7,2)
DO BLNK
WRITE ?9,VAL_" lb "
SET VAL=$JUSTIFY(Y,6,2)
DO BLNK
WRITE "("_VAL_" kg)"
End DoDot:1
+31 IF VTYPE="WT"
IF 'VVER
SET VBMI=""
SET VBMI(1)=$PIECE(VDAT,"^")
SET VBMI(2)=+$PIECE(VDAT,U,4)
Begin DoDot:1
+32 SET VBMI=+$$TRIM^XLFSTR($$GETBMI(DFN,$PIECE(VDAT,U,4),VITDATE))
+33 IF VBMI
WRITE !,?4,"Body Mass Index: "_VBMI
End DoDot:1
+34 QUIT
GETBMI(DFN,WT,DATE) ;EP
+1 NEW X,Y
+2 QUIT $$BMI^APCHS2A3(DFN,WT,DATE)
+3 ;
