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