- 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
