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

BSTSMSR.m

Go to the documentation of this file. 
  1. BSTSMSR ;GDIT/HS/BEE-Standard Terminology API Program - Return Measurements ; 5 Nov 2012  9:53 AM
  1.  ;;2.0;IHS STANDARD TERMINOLOGY;;Dec 01, 2016;Build 62
  1.  ;
  1.  Q
  1.  ;
  1.  ;Adapted from BTIUPCC1 - Needed to put in BSTS so TIU application would not be required
  1.  ;
  1. LASTMSR(DFN,BSTSMSR,BSTSCAP,BSTSDAT) ;EP; -- returns last measurement for patient
  1.  ; BSTSMSR=measurement name
  1.  ; BSTSCAP=1 if caption with measurement name is to be returned
  1.  ; BSTSDAT=1 return date measurement taken
  1.  NEW LINE,X,VAIN
  1.  ;Run different routine if patient is an inpatient
  1.  ;Added in patch 4
  1.  D INP^VADPT
  1.  I $G(VAIN(1)) S LINE=$$ILSTMEAS(DFN,BSTSMSR,.VAIN)
  1.  I '$G(VAIN(1)) S LINE=$$LSTMEAS(DFN,BSTSMSR)
  1.  S X=$S($G(BSTSCAP):"Last "_BSTSMSR_": ",1:"")
  1.  ;
  1.  NEW Y,RET,VMIEN
  1.  I $P(LINE,U,2)="" Q X_$P(LINE,U)
  1.  I BSTSMSR="TMP" S Y=$P(LINE,U),Y=Y_" F ["_$J((Y-32)*(5/9),3,1)_" C]",$P(LINE,U)=Y
  1.  I ((BSTSMSR="HT")!(BSTSMSR="HC")!(BSTSMSR="WC")!(BSTSMSR="AG")) S Y=$P(LINE,U),Y=$J(Y,5,2)_" in ["_$J((Y*2.54),5,2)_" cm]",$P(LINE,U)=Y
  1.  I BSTSMSR="WT" S Y=$P(LINE,U),Y=$J(Y,5,2)_" lb ["_$J((Y*.454),5,2)_" kg]",$P(LINE,U)=Y
  1.  I BSTSMSR="BMI" D
  1.  .S VMIEN=$P(LINE,U,2)
  1.  .S Y=$P(LINE,U),Y=$J(Y,5,2)
  1.  .I $$PREG(DFN,VMIEN)=1 S Y=Y_"*"
  1.  .S $P(LINE,U)=Y
  1.  I $P(LINE,U,4)="" S RET=X_$P(LINE,U)_$$LSTDATE($P(LINE,U,2),$P(LINE,U,3),$G(BSTSDAT))
  1.  I $P(LINE,U,4)'="" S RET=X_$P(LINE,U)_$$LSTDATE($P(LINE,U,2),$P(LINE,U,3),$G(BSTSDAT))_" Qualifiers: "_$P(LINE,U,4)
  1.  Q RET
  1.  ;
  1. LSTMEAS(DFN,BSTSMSR) ; -- returns most current measurement (internal values)
  1.  NEW MSR,VDT,IEN,X,Y,TIU,LINE,ARR,DATE,STOP,QUALIF
  1.  S MSR=$O(^AUTTMSR("B",BSTSMSR,0)) I MSR="" Q ""
  1.  ;
  1.  S VDT=0
  1.  S LINE=""
  1.  F  S VDT=$O(^AUPNVMSR("AA",DFN,MSR,VDT)) Q:'VDT!(LINE'="")  D
  1.  . S IEN=0
  1.  . F  S IEN=$O(^AUPNVMSR("AA",DFN,MSR,VDT,IEN)) Q:'IEN  D
  1.  .. K TIU D ENP^XBDIQ1(9000010.01,IEN,".03;.04;2;1201","TIU(","I")
  1.  .. ; value ^ visit ien ^ event date internal format
  1.  .. Q:TIU(2,"I")=1                ;Quit if entered in error
  1.  .. S LINE=$G(TIU(.04))_U_$G(TIU(.03,"I"))_U_$G(TIU(1201,"I"))
  1.  .. S DATE=$S($G(TIU(1201,"I"))]"":TIU(1201,"I"),1:(9999999-$P(VDT,"."))_"."_$P(VDT,".",2))
  1.  .. S QUALIF=$$QUAL(IEN)
  1.  .. S ARR(DATE,IEN)=LINE_U_QUALIF_U_IEN
  1.  ;
  1.  I '$D(ARR) Q "None found"
  1.  S DATE=$O(ARR(""),-1),IEN=$O(ARR(DATE,""),-1),LINE=ARR(DATE,IEN)
  1.  Q $G(LINE)
  1.  ;
  1. LSTDATE(DATE1,DATE2,YES) ;EP -- returns event date or visit date;PATCH 1002 fixed typo
  1.  I 'YES Q ""  ;no date asked for
  1.  ;
  1.  I $G(DATE2) Q "  ("_$$FMTE^XLFDT(DATE2)_")"  ;event date
  1.  I 'DATE1 Q " "
  1.  N Y S Y=$$GET1^DIQ(9000010,+DATE1,.01,"I") ;visit date from visit ien
  1.  Q "  ("_$$FMTE^XLFDT(Y)_")"  ;visit date from visit ien
  1.  ;
  1.  ;Adapted from BTIUPCC4 - Needed to put in BSTS so TIU application would not be required
  1.  ;
  1. ILSTMEAS(DFN,TIUMSR,VAIN) ; -- returns most current measurement (internal values)
  1.  ;Designed to return most recent vital signs for inpatients
  1.  NEW MSR,VDT,IEN,X,TIU,LINE,ARR,DATE,STOP,ISINP,QUALIF
  1.  S MSR=$O(^AUTTMSR("B",TIUMSR,0)) I MSR="" Q ""
  1.  ;
  1.  ;Check whether patient is an inpatient or not
  1.  I $G(VAIN(1)) D
  1.  .S STOP=(9999999-$P(VAIN(7),U,1)\1)+1
  1.  I 'STOP Q "Patient is not an inpatient"         ;none to be found
  1.  S VDT=0
  1.  F  S VDT=$O(^AUPNVMSR("AE",DFN,MSR,VDT)) Q:'VDT!(VDT>STOP)  D
  1.  . S IEN=0
  1.  . F  S IEN=$O(^AUPNVMSR("AE",DFN,MSR,VDT,IEN)) Q:'IEN  D
  1.  .. K TIU D ENP^XBDIQ1(9000010.01,IEN,".03;.04;1201;2","TIU(","I")
  1.  .. ; value ^ visit ien ^ event date internal format
  1.  .. Q:TIU(2,"I")=1    ;Quit if entered in error
  1.  .. S QUALIF=$$QUAL(IEN)
  1.  .. S LINE=$G(TIU(.04))_U_$G(TIU(.03,"I"))_U_$G(TIU(1201,"I"))_U_QUALIF
  1.  .. S DATE=$S($G(TIU(1201,"I"))]"":TIU(1201,"I"),1:(9999999-$P(VDT,"."))_"."_$P(VDT,".",2))
  1.  .. S ARR(DATE,IEN)=LINE
  1.  ;
  1.  I '$D(ARR)!($D(ARR)=0) S LINE="Not done while inpatient" Q LINE
  1.  S DATE=$O(ARR(""),-1),IEN=$O(ARR(DATE,""),-1),LINE=ARR(DATE,IEN)
  1.  K VAIN
  1.  Q $G(LINE)
  1.  ;
  1. ILSTDATE(DATE1,DATE2,YES) ;EP -- returns event date or visit date;PATCH 1002 fixed typo
  1.  I 'YES Q ""  ;no date asked for
  1.  ;
  1.  I $G(DATE2) Q "  ("_$$FMTE^XLFDT(DATE2)_")"  ;event date
  1.  I 'DATE1 Q " "
  1.  Q "  ("_$$GET1^DIQ(9000010,+DATE1,.01)_")"  ;visit date from visit ien
  1.  ;
  1.  ;Adapted from BTIULO7A - Needed to put in BSTS so TIU application would not be required 
  1.  ;
  1. QUAL(MEAS) ; Get qualifiers for a measurement
  1.  N QUALS,QUALN,QUALIF,TYPE,TNAME,O2
  1.  S (QUALIF,O2)=""
  1.  S TYPE=$P($G(^AUPNVMSR(MEAS,0)),U,1)
  1.  S TNAME=$P($G(^AUTTMSR(TYPE,0)),U,1)
  1.  S QUALS=0 F  S QUALS=$O(^AUPNVMSR(MEAS,5,QUALS)) Q:QUALS=""  D
  1.  .S QUALN=$P($G(^AUPNVMSR(MEAS,5,QUALS,0)),U,1)
  1.  .I +QUALN S QUALN=$P($G(^GMRD(120.52,QUALN,0)),U,1)
  1.  .I QUALIF="" S QUALIF=QUALN
  1.  .E  I QUALN'="" S QUALIF=QUALIF_","_QUALN
  1.  I TNAME="O2" D
  1.  .S O2=$P($G(^AUPNVMSR(MEAS,0)),U,10)
  1.  .S QUALIF=QUALIF_" "_O2
  1.  Q QUALIF
  1.  ;
  1.  ;Adapted from BTIUPCC6 - Needed to put in BSTS so TIU application would not be required 
  1.  ;
  1. PREG(DFN,VIEN,VMIEN) ;Determine if BMI is for pregnant patient
  1.  N DOB,X1,X1,TAGE,POV,CODE,TAX,RET
  1.  S RET=0
  1.  S VMIEN=$G(VMIEN),VIEN=$G(VIEN)
  1.  I $$GET1^DIQ(2,DFN,.02,"I")'="F" Q RET    ;Wrong sex
  1.  S TAGE=$$GET1^DIQ(2,DFN,.033)
  1.  I TAGE<10!(TAGE>50) Q RET             ;Wrong age
  1.  ;Find POVs on this visit and check if they are pregnancy POVs
  1.  I VIEN="" D
  1.  .S VIEN=$$GET1^DIQ(9000010.01,VMIEN,.03,"I")
  1.  I '+VIEN Q RET
  1.  S TAX=$O(^ATXAX("B","SURVEILLANCE H1N1 PREGNANCY DX",0))
  1.  S POV="" F  S POV=$O(^AUPNVPOV("AD",VIEN,POV)) Q:POV=""!(RET=1)  D
  1.  .S CODE=$$GET1^DIQ(9000010.07,POV,.01,"I")
  1.  .I CODE="" Q
  1.  .S RET=$$ICD^ATXCHK(CODE,TAX,9)
  1.  Q RET