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