BEHOVMC ;IHS/MSC/MGH - CUMULATIVE VITALS/MEASUREMENTS FOR PATIENT OVER GIVEN DATE RANGE ;07-Jun-2010 09:17;MGH
;;1.1;BEH COMPONENTS;**001004,001005**;March 20,2007
DEV ;S %ZIS="Q",%ZIS("B")="" D ^%ZIS K %ZIS G:POP Q3 I $E(IOST)="P",'$D(IO("Q")),'$D(IO("S")) D ^%ZISC W !,?3,"PRINTED REPORTS MUST BE QUEUED!!",$C(7) G DEV
;I $D(IO("Q")) S (ZTSAVE("^TMP($J,"),ZTSAVE("GMRVSDT"),ZTSAVE("GMRVFDT"))="",ZTIO=ION,ZTDESC="Cumulative vital/measurement report",ZTRTN="START^GMRVSC0" D ^%ZTLOAD K IO("Q"),ZTSK,ZTIO G Q3
;W !!,"*** (E) - Error entry",
W !! W:VADM(1)'="" ?$X-3,$E(VADM(1),1,15) W:VADM(2)'="" ?17,$P(VADM(2),"^",2) W:VADM(3)'="" ?30,$P(VADM(3),"^",2) W:VADM(4)'="" ?43,$P(VADM(4),"^")_" YRS"
W:VADM(5)'="" ?51,$P(VADM(5),"^",2)
W ?65,"VAF 10-7987j" W !,"Unit: "_$S($P(VAIN(4),"^",2)'="":$P(VAIN(4),"^",2),1:" "),?32,"Room: "_$S($P(VAIN(5),"^")'="":$P(VAIN(5),"^"),1:" "),!
I '$D(BEHVHLOC) S BEHVHLOC=$P($G(^DIC(42,+$G(VAIN(4)),44)),"^")
W "Division: "_$S(BEHVHLOC>0:$$GET1^DIQ(4,+$$GET1^DIQ(44,+BEHVHLOC,3,"I"),.01,"I"),1:""),!
Q
WRT ;
S GMR1ST=1 K GMRSITE D DEM^VADPT,INP^VADPT S GWARD=$S($P(VAIN(4),"^",2)'="":$P(VAIN(4),"^",2),1:" "),GBED=$S(VAIN(5)'="":$P(VAIN(5),"^"),1:" ") D HDR^BEHOVMC2
Q
EN3(DFN,BEHVSDT,BEHVFDT) ; APPLICATION PROGRAM INTERFACE FOR PATIENT CUMULATIVE VITALS REPORT
; INPUT VARIABLES: DFN=PATIENT NUMBER
; BEHVSDT=START DATE
; BEHVFDT=FINISH DATE OF REPORT
S BEHVOR=1
EN5 S (BEHOUT,BEHPG)=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 BEH1ST=1,BEHDATE(0)=0 D NOW^%DTC S Y=% D D^DIQ S BEHPDT=$P(Y,"@")_" ("_$P($P(Y,"@",2),":",1,2)_")",$P(BEHDSH,"-",81)=""
N GPEDIS S GPEDIS=$O(^GMRD(120.52,"B","DORSALIS PEDIS",0)) Q:GPEDIS'>0
K ^TMP("BEHV",$J)
;Find the vitals from the parameter
S PRM="BEHOVM VITAL LIST"
N ENT,DATA
S ENT=$$ENT^CIAVMRPC(PRM)
D GETLST^XPAR(.DATA,ENT,PRM,"I")
;F I=1:1:DATA S BEHVTYP=$G(DATA(I)) D
S I="" F S I=$O(DATA(I)) Q:I="" D
.;Get the abbreviation
.S BEHVTYP=$G(DATA(I))
.Q:BEHVTYP=""
.S BEHVITY=$P($G(^BEHOVM(90460.01,BEHVTYP,0)),U,7)
.D SETVAR
U IO D HDR^BEHOVMC2
I $O(^TMP("BEHV",$J,0))'>0 W !!,"No cumulative vitals data for "_$S($D(OPSPNM):ORSPNM,1:"this patient"),! S:$D(ORSPNM) BEHOUT=1 G Q3
F BEHDATE=0:0 S BEHDATE=$O(BEHVDT(BEHDATE)) Q:BEHDATE'>0!BEHOUT I $D(^TMP("BEHV",$J,BEHDATE)) D PRT
Q3 I IOSL'<($Y+10) F X=1:1 W ! Q:IOSL<($Y+10)
I 'BEHOUT W ! D FOOTER^BEHOVMC
D KVAR^VADPT K BEHVOR,VA,GBED,GWARD,^TMP("BEHV",$J),BEH1ST,BEHVTY,BEHVITY,BEHVDATE,BEHSITE,BEHDSH,BEHQUAL,BEHVX,GMRX,GX,BEHDAT,GMRLN,GMRPDT,GMRSP,GMRVDA,GMRY,%,BEHDATE
K BEHDT,BEHPDT,BEHPG,BEHVDA,BEHVDT,BEHVHLOC,BEHVTYP,GMR1ST,GPRT,I,PRM,X,Y,AGE
I $D(ORSPNM) K GMRPG,BEHVSDT,BEHVFDT S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC
Q
SETVAR ;Get the vital data
S BEHDT="" F S BEHDT=$O(^AUPNVMSR("AE",DFN,BEHVTYP,BEHDT)) Q:BEHDT'>0 S BEHDATE=9999999-BEHDT I '(BEHDATE>BEHVFDT!(BEHDATE<BEHVSDT)) D SETND
Q
SETND ;
S BEHVDA="" F S BEHVDA=$O(^AUPNVMSR("AE",DFN,BEHVTYP,BEHDT,BEHVDA)) Q:BEHVDA'>0 D SETUT
Q
SETUT N STIM
;S STIM=$P($G(^AUPNVMSR(BEHVDA,0)),U,7)
S STIM=$P($G(^AUPNVMSR(BEHVDA,12)),U,1)
I STIM="" S STIM=BEHDATE
S ^TMP("BEHV",$J,+$E(STIM,1,12),BEHVITY,BEHVDA)=$S('$D(^AUPNVMSR(BEHVDA,2)):0,1:+$P(^(2),"^"))
S BEHVDT(+$E(STIM,1,12))="" Q
Q
PRT ;PRINT V/M BY DATE/TIME
D:IOSL<($Y+9) HDR^BEHOVMC2 Q:BEHOUT
S Y=BEHDATE X ^DD("DD") I $P(BEHDATE,".")'=BEHDATE(0) W !,$E(BEHDATE,4,5)_"/"_$E(BEHDATE,6,7)_"/"_$E(BEHDATE,2,3) S BEHDATE(0)=$P(BEHDATE,".")
D:IOSL<($Y+9) HDR^BEHOVMC2 Q:BEHOUT W !,?2,$P($P(Y,"@",2),":",1,2)
I $D(^TMP("BEHV",$J,BEHDATE)) D
.K BEHLN,GERROR S BEHVTY="" F S BEHVTY=$O(^TMP("BEHV",$J,BEHDATE,BEHVTY)) Q:BEHVTY="" D
..S GPRT(BEHVTY)=0 I $D(^TMP("BEHV",$J,BEHDATE,BEHVTY)) D
...F BEHVDA=0:0 S BEHVDA=$O(^TMP("BEHV",$J,BEHDATE,BEHVTY,BEHVDA)) Q:BEHVDA'>0!BEHOUT D SETLN^BEHOVMC2
Q
BEHOVMC ;IHS/MSC/MGH - CUMULATIVE VITALS/MEASUREMENTS FOR PATIENT OVER GIVEN DATE RANGE ;07-Jun-2010 09:17;MGH
+1 ;;1.1;BEH COMPONENTS;**001004,001005**;March 20,2007
DEV ;S %ZIS="Q",%ZIS("B")="" D ^%ZIS K %ZIS G:POP Q3 I $E(IOST)="P",'$D(IO("Q")),'$D(IO("S")) D ^%ZISC W !,?3,"PRINTED REPORTS MUST BE QUEUED!!",$C(7) G DEV
+1 ;I $D(IO("Q")) S (ZTSAVE("^TMP($J,"),ZTSAVE("GMRVSDT"),ZTSAVE("GMRVFDT"))="",ZTIO=ION,ZTDESC="Cumulative vital/measurement report",ZTRTN="START^GMRVSC0" D ^%ZTLOAD K IO("Q"),ZTSK,ZTIO G Q3
+1 ;W !!,"*** (E) - Error entry",
+2 WRITE !!
IF VADM(1)'=""
WRITE ?$X-3,$EXTRACT(VADM(1),1,15)
IF VADM(2)'=""
WRITE ?17,$PIECE(VADM(2),"^",2)
IF VADM(3)'=""
WRITE ?30,$PIECE(VADM(3),"^",2)
IF VADM(4)'=""
WRITE ?43,$PIECE(VADM(4),"^")_" YRS"
+3 IF VADM(5)'=""
WRITE ?51,$PIECE(VADM(5),"^",2)
+4 WRITE ?65,"VAF 10-7987j"
WRITE !,"Unit: "_$SELECT($PIECE(VAIN(4),"^",2)'="":$PIECE(VAIN(4),"^",2),1:" "),?32,"Room: "_$SELECT($PIECE(VAIN(5),"^")'="":$PIECE(VAIN(5),"^"),1:" "),!
+5 IF '$DATA(BEHVHLOC)
SET BEHVHLOC=$PIECE($GET(^DIC(42,+$GET(VAIN(4)),44)),"^")
+6 WRITE "Division: "_$SELECT(BEHVHLOC>0:$$GET1^DIQ(4,+$$GET1^DIQ(44,+BEHVHLOC,3,"I"),.01,"I"),1:""),!
+7 QUIT
WRT ;
+1 SET GMR1ST=1
KILL GMRSITE
DO DEM^VADPT
DO INP^VADPT
SET GWARD=$SELECT($PIECE(VAIN(4),"^",2)'="":$PIECE(VAIN(4),"^",2),1:" ")
SET GBED=$SELECT(VAIN(5)'="":$PIECE(VAIN(5),"^"),1:" ")
DO HDR^BEHOVMC2
+2 QUIT
EN3(DFN,BEHVSDT,BEHVFDT) ; APPLICATION PROGRAM INTERFACE FOR PATIENT CUMULATIVE VITALS REPORT
+1 ; INPUT VARIABLES: DFN=PATIENT NUMBER
+2 ; BEHVSDT=START DATE
+3 ; BEHVFDT=FINISH DATE OF REPORT
+4 SET BEHVOR=1
EN5 SET (BEHOUT,BEHPG)=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))
+1 SET BEH1ST=1
SET BEHDATE(0)=0
DO NOW^%DTC
SET Y=%
DO D^DIQ
SET BEHPDT=$PIECE(Y,"@")_" ("_$PIECE($PIECE(Y,"@",2),":",1,2)_")"
SET $PIECE(BEHDSH,"-",81)=""
+2 NEW GPEDIS
SET GPEDIS=$ORDER(^GMRD(120.52,"B","DORSALIS PEDIS",0))
IF GPEDIS'>0
QUIT
+3 KILL ^TMP("BEHV",$JOB)
+4 ;Find the vitals from the parameter
+5 SET PRM="BEHOVM VITAL LIST"
+6 NEW ENT,DATA
+7 SET ENT=$$ENT^CIAVMRPC(PRM)
+8 DO GETLST^XPAR(.DATA,ENT,PRM,"I")
+9 ;F I=1:1:DATA S BEHVTYP=$G(DATA(I)) D
+10 SET I=""
FOR
SET I=$ORDER(DATA(I))
IF I=""
QUIT
Begin DoDot:1
+11 ;Get the abbreviation
+12 SET BEHVTYP=$GET(DATA(I))
+13 IF BEHVTYP=""
QUIT
+14 SET BEHVITY=$PIECE($GET(^BEHOVM(90460.01,BEHVTYP,0)),U,7)
+15 DO SETVAR
End DoDot:1
+16 USE IO
DO HDR^BEHOVMC2
+17 IF $ORDER(^TMP("BEHV",$JOB,0))'>0
WRITE !!,"No cumulative vitals data for "_$SELECT($DATA(OPSPNM):ORSPNM,1:"this patient"),!
IF $DATA(ORSPNM)
SET BEHOUT=1
GOTO Q3
+18 FOR BEHDATE=0:0
SET BEHDATE=$ORDER(BEHVDT(BEHDATE))
IF BEHDATE'>0!BEHOUT
QUIT
IF $DATA(^TMP("BEHV",$JOB,BEHDATE))
DO PRT
Q3 IF IOSL'<($Y+10)
FOR X=1:1
WRITE !
IF IOSL<($Y+10)
QUIT
+1 IF 'BEHOUT
WRITE !
DO FOOTER^BEHOVMC
+2 DO KVAR^VADPT
KILL BEHVOR,VA,GBED,GWARD,^TMP("BEHV",$JOB),BEH1ST,BEHVTY,BEHVITY,BEHVDATE,BEHSITE,BEHDSH,BEHQUAL,BEHVX,GMRX,GX,BEHDAT,GMRLN,GMRPDT,GMRSP,GMRVDA,GMRY,%,BEHDATE
+3 KILL BEHDT,BEHPDT,BEHPG,BEHVDA,BEHVDT,BEHVHLOC,BEHVTYP,GMR1ST,GPRT,I,PRM,X,Y,AGE
+4 IF $DATA(ORSPNM)
KILL GMRPG,BEHVSDT,BEHVFDT
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
DO ^%ZISC
+5 QUIT
SETVAR ;Get the vital data
+1 SET BEHDT=""
FOR
SET BEHDT=$ORDER(^AUPNVMSR("AE",DFN,BEHVTYP,BEHDT))
IF BEHDT'>0
QUIT
SET BEHDATE=9999999-BEHDT
IF '(BEHDATE>BEHVFDT!(BEHDATE<BEHVSDT))
DO SETND
+2 QUIT
SETND ;
+1 SET BEHVDA=""
FOR
SET BEHVDA=$ORDER(^AUPNVMSR("AE",DFN,BEHVTYP,BEHDT,BEHVDA))
IF BEHVDA'>0
QUIT
DO SETUT
+2 QUIT
SETUT NEW STIM
+1 ;S STIM=$P($G(^AUPNVMSR(BEHVDA,0)),U,7)
+2 SET STIM=$PIECE($GET(^AUPNVMSR(BEHVDA,12)),U,1)
+3 IF STIM=""
SET STIM=BEHDATE
+4 SET ^TMP("BEHV",$JOB,+$EXTRACT(STIM,1,12),BEHVITY,BEHVDA)=$SELECT('$DATA(^AUPNVMSR(BEHVDA,2)):0,1:+$PIECE(^(2),"^"))
+5 SET BEHVDT(+$EXTRACT(STIM,1,12))=""
QUIT
+6 QUIT
PRT ;PRINT V/M BY DATE/TIME
+1 IF IOSL<($Y+9)
DO HDR^BEHOVMC2
IF BEHOUT
QUIT
+2 SET Y=BEHDATE
XECUTE ^DD("DD")
IF $PIECE(BEHDATE,".")'=BEHDATE(0)
WRITE !,$EXTRACT(BEHDATE,4,5)_"/"_$EXTRACT(BEHDATE,6,7)_"/"_$EXTRACT(BEHDATE,2,3)
SET BEHDATE(0)=$PIECE(BEHDATE,".")
+3 IF IOSL<($Y+9)
DO HDR^BEHOVMC2
IF BEHOUT
QUIT
WRITE !,?2,$PIECE($PIECE(Y,"@",2),":",1,2)
+4 IF $DATA(^TMP("BEHV",$JOB,BEHDATE))
Begin DoDot:1
+5 KILL BEHLN,GERROR
SET BEHVTY=""
FOR
SET BEHVTY=$ORDER(^TMP("BEHV",$JOB,BEHDATE,BEHVTY))
IF BEHVTY=""
QUIT
Begin DoDot:2
+6 SET GPRT(BEHVTY)=0
IF $DATA(^TMP("BEHV",$JOB,BEHDATE,BEHVTY))
Begin DoDot:3
+7 FOR BEHVDA=0:0
SET BEHVDA=$ORDER(^TMP("BEHV",$JOB,BEHDATE,BEHVTY,BEHVDA))
IF BEHVDA'>0!BEHOUT
QUIT
DO SETLN^BEHOVMC2
End DoDot:3
End DoDot:2
End DoDot:1
+8 QUIT
