Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BEHOVMER

BEHOVMER.m

Go to the documentation of this file. 
  1. BEHOVMER ;MSC/IND/MGH - VITALS ENTERED IN ERROR REPORT ;07-Jun-2010 11:06;MGH
  1.  ;;1.1;BEH COMPONENTS;**001004,001005**;Mar 20, 2007
  1.  ;=================================================================
  1. EN1 ; EP Entry point
  1.  D DEM^VADPT D NOW^%DTC S Y=% X ^DD("DD") S BEHPDT=$P(Y,"@")_" ("_$P($P(Y,"@",2),":",1,2)_")",(BEHOUT,BEHPG)=0,BEH1ST=1,$P(BEHDSH,"-",81)=""
  1.  F BEHVITY=0:0 S BEHVITY=$O(^AUPNVMSR("AE",DFN,BEHVITY)) Q:BEHVITY'>0  F BEHVDT=0:0 S BEHVDT=$O(^AUPNVMSR("AE",DFN,BEHVITY,BEHVDT)) Q:BEHVDT'>0  S BEHVDATE=9999999-BEHVDT I BEHVDATE'<BEHVSDT,BEHVDATE'>BEHVFDT D SORT
  1.  U IO D HDR I $O(^TMP("BEHOERR",$J,0))'>0 W !,"THERE IS NO DATA FOR THIS REPORT" G QT
  1.  F BEHDATE=0:0 S BEHDATE=$O(^TMP("BEHOERR",$J,BEHDATE)) Q:BEHDATE'>0!BEHOUT  D
  1.  .F BEHVITY=0:0 S BEHVITY=$O(^TMP("BEHOERR",$J,BEHDATE,BEHVITY)) Q:BEHVITY'>0!BEHOUT  D
  1.  ..F BEHVDA=0:0 S BEHVDA=$O(^TMP("BEHOERR",$J,BEHDATE,BEHVITY,BEHVDA)) Q:BEHVDA'>0  D WRT Q:BEHOUT
  1. QT ;
  1.  I IOSL'<($Y+8) F X=1:1 W ! Q:IOSL<($Y+8)
  1.  I 'BEHOUT,$E(IOST)'="P" W !!,"Press return to continue ""^"" to escape " R X:DTIME
  1. Q ; KILL VARIBLES
  1.  K ^TMP("BEHOERR",$J),DFN,BEH1ST,BEHDAT,BEHDATE,BEHDSH,BEHOUT,BEHPDT,BEHPG,BEHPR,BEHSITE,BEHVDA,BEHVDATE,BEHVDT,BEHVERR
  1.  K BEHVFDT,BEHVITY,BEHVSDT,BEHVX,POP,DIPGM,BEHP,BEHTYPE,BEHOV,DIPGM,%T,%
  1.  D KVAR^VADPT K VA
  1.  K GREASON,BEHZZ,BEHTAKEN,BEHVARY,GX,BEHQUAL,BEHVPO D ^%ZISC Q
  1. SORT ;
  1.  F BEHVDA=0:0 S BEHVDA=$O(^AUPNVMSR("AE",DFN,BEHVITY,BEHVDT,BEHVDA)) Q:BEHVDA'>0  D
  1.  .I $D(^AUPNVMSR(BEHVDA,2)) D
  1.  ..S BEHVERR=$G(^AUPNVMSR(BEHVDA,0))
  1.  ..;Get the time taken
  1.  ..S BEHTAKEN=$P($G(^AUPNVMSR(BEHVDA,12)),U,1)
  1.  ..S BEHTAKEN=9999999-BEHTAKEN
  1.  ..I BEHTAKEN="" S BEHTAKEN=BEHVDT
  1.  ..S ^TMP("BEHOERR",$J,BEHTAKEN,BEHVITY,BEHVDA)=BEHVERR
  1.  Q
  1. WRT ;
  1.  D:IOSL<($Y+8) HDR Q:BEHOUT  K BEHPR
  1.  S BEHVERR=^TMP("BEHOERR",$J,BEHDATE,BEHVITY,BEHVDA)
  1.  I $D(^AUPNVMSR(BEHVDA,0)) D
  1.  . S BEHDAT("BAD")=$S($D(^AUPNVMSR(+BEHVDA,0)):^(0),1:"")
  1.  . K BEHVX,BEHVX(0),BEHVX(1)
  1.  . S BEHVX=$P(^AUTTMSR(BEHVITY,0),"^",2)
  1.  . S BEHVX(0)=$P(BEHDAT("BAD"),"^",4) D
  1.  ..I BEHVX(0)>0 S BEHVX(0)=$$VALUE(BEHVITY,BEHVX(0)) S BEHVX(1)=""
  1.  . S BEHZZ="" I +$D(^AUPNVMSR(BEHVDA,5)) K BEHVARY S BEHVARY="" D
  1.  ..S BEHZZ=$$QUAL^BEHOVMC2(BEHVDA)
  1.  ..S BEHVX(1)=" ("_BEHZZ_")"
  1.  . S BEHVPO=$P($G(^AUPNVSMR(BEHVDA,0)),"^",10)
  1.  . S $P(BEHDAT("BAD"),"^",4)=BEHVX(0)_BEHVX(1)_$S(BEHVPO'="":" with supplemental O2 "_$S(BEHVPO["l/min":$P(BEHVPO," l/min")_"L/min",1:"")_$S(BEHVPO["l/min":$P(BEHVPO," l/min",2),1:BEHVPO),1:"")_$S(BEHZZ'=""&(BEHVX="O2"):" via ",1:"")
  1.  . S GREASON="" D ERREASON
  1.  S Y=9999999-BEHDATE D D^DIQ S BEHPR("VSDT")=Y
  1.  S EIE=$P($G(^AUPNVMSR(BEHVDA,2)),U,2)
  1.  I EIE'="" S BEHPR("ENUS")=$P($G(^VA(200,EIE,0)),U,1)
  1.  E  S BEHPR("ENUS")=""
  1.  S BEHPR("TYPE")=$S(BEHVITY="":"",$D(^AUTTMSR(BEHVITY,0)):$P(^(0),"^"),1:"")
  1.  W !,BEHPR("VSDT"),?23,BEHPR("TYPE"),?58,BEHPR("ENUS"),!,?3,"Reason: ",GREASON
  1.  I BEHVDA>0 W !,?3,"(Bad data)  ",$P(BEHDAT("BAD"),"^",4)
  1.  W ! Q
  1. HDR ;
  1.  I $E(IOST)'="P",'BEH1ST W !,"Press return to continue ""^"" to escape " R X:DTIME I X="^"!'$T S GMROUT=1 Q
  1.  W:'($E(IOST)'="C"&'BEHPG) @IOF S BEH1ST=0,BEHPG=BEHPG+1
  1.  W !,BEHPDT,?22,"ENTERED IN ERROR VITAL/MEASUREMENT REPORT",?70,"PAGE ",BEHPG
  1.  W !,"Patient: ",VADM(1),?$X+5,$P(VADM(2),"^",2),!!,"Date Vit./Meas. taken",?58,"User who made error",!,BEHDSH,!
  1.  Q
  1. VALUE(TYPE,DATA) ;Get the value for this result
  1.  N TYP,VAL,AGE,BEH,DATAG,DEFAULT,DEFU,ALTU,VALUE
  1.  S TYP=$P(^AUPNVMSR(BEHVDA,0),U)
  1.  S VAL=$P($G(^AUPNVMSR(BEHVDA,0)),U,4)
  1.  S:'$G(DAT) DAT=DT
  1.  S AGE=$$PTAGE^BGOUTL(DFN,$S(X:X,1:DAT))
  1.  S TYP=$P($G(^BEHOVM(90460.01,TYP,0)),U,7)
  1.  S BEH="" S BEH=$O(^BEHOVM(90460.01,"B",TYP,BEH))
  1.  I TYP="" S VALUE=$$RND(VAL)
  1.  E  D
  1.  .S DATAG=$G(^BEHOVM(90460.01,BEH,0))
  1.  .S DEFAULT=$P(DATAG,U,2)
  1.  .I DEFAULT=1 D
  1.  ..S DEFU=$P(DATAG,U,4),ALTU=$P(DATAG,U,3)
  1.  ..I ALTU=""!(DEFU=ALTU) S VALUE=$$RND(VAL)_" "_DEFU
  1.  ..E  S X=VAL I $D(^BEHOVM(90460.01,BEH,2)) X $G(^BEHOVM(90460.01,BEH,2)) D
  1.  ...S VALUE=$$RND(VAL)_" "_DEFU_" ("_$$RND(X)_" "_ALTU_")"
  1.  .I DEFAULT=0 D
  1.  ..S DEFU=$P(DATAG,U,3),ALTU=$P(DATAG,U,4)
  1.  ..I ALTU=""!(DEFU=ALTU) S VALUE=$$RND(VAL)_" "_DEFU
  1.  ..E  S X=VAL I $D(^BEHOVM(90460.01,BEH,1)) X $G(^BEHOVM(90460.01,BEH,1)) D
  1.  ...S VALUE=$$RND(VAL)_" "_DEFU_" ("_$$RND(X)_" "_ALTU_")"
  1.  .I DEFAULT="" S VALUE=$$RND(VAL)
  1.  Q VALUE
  1. ERREASON ;Reason for entered in error
  1.  Q:'$D(^AUPNVMSR(+BEHVDA,2.1))
  1.  S GER=0 F  S GER=$O(^AUPNVMSR(+BEHVDA,2.1,GER)) Q:GER'>0  S GER(1)=$G(^AUPNVMSR(+BEHVDA,2.1,GER,0)) D
  1.  . S GER(2)=$S(GER(1)=1:"incorrect date/time",GER(1)=2:"incorrect reading",GER(1)=3:"incorrect patient",GER(1)=4:"invalid record",1:GER(1))
  1.  . I GER(2)'="" S GREASON=GREASON_$S(GREASON'="":", ",1:"")_GER(2)
  1.  .Q
  1.  K GER Q
  1. RND(X) Q $S(X=+X:+$J(X,0,2),1:X)