BTIULO4 ; IHS/ITSC/LJF - MORE VISIT OBJECTS FOR EHR ;30-Nov-2015 07:22;du
;;1.0;TEXT INTEGRATION UTILITIES;**1002,1004,1005,1006,1010,1012,1013,1015**;NOV 04, 2004;Build 3
;IHS/ITSC/LJF 02/25/2005 PATCH 1002 added code for VITALS FOR VISIT CONTEXT object
;Added EHR 1.1 calls for visit selection
;Patch 6 added text for visit not selected
;Patch 1010 added vitals qualifiers
;
VCC(TARGET) ; returns chief complaint for current vuecentric visit context
I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
NEW X,VST,CNT,RESULT
S CNT=0
S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
I VST="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
;S X="CIAVCXEN" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^CIAVCXEN(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid routine" Q "~@"_$NA(@TARGET)
D GETCC(.RESULT,VST)
;
K @TARGET
S (I,CNT)=0 F S I=$O(RESULT(I)) Q:'I D
. S CNT=CNT+1
. S @TARGET@(CNT,0)=$S(CNT=1:"Chief Complaint: ",1:$$SP(5))_RESULT(CNT)
I 'CNT S @TARGET@(1,0)="No Chief Complaint."
Q "~@"_$NA(@TARGET)
;
GETCC(RETURN,VST) ;Returns Chief Complaint array for visit
; VST=Visit IEN
;
NEW VIEN,IEN,I,N,CNT
K RETURN
I $G(VST)="" S RETURN(1)="-1^Missing Input Data" Q
S VIEN=$P(VST,"|",1) I 'VIEN S RETURN(1)="-1^No Visit IEN" Q
I '$D(^AUPNVSIT(VIEN,0)) S RETURN(1)="-1^Visit does not exist" Q
;
S CNT=0
S IEN=0 F S IEN=$O(^AUPNVNT("AD",VIEN,IEN)) Q:'IEN D
. I $$GET1^DIQ(9000010.34,IEN,.01)'="CHIEF COMPLAINT" Q
. S N=0 F S N=$O(^AUPNVNT(IEN,11,N)) Q:'N D
..I $G(^AUPNVNT(IEN,11,N,0))'="" S CNT=CNT+1,RETURN(CNT)=$G(^AUPNVNT(IEN,11,N,0))
I '$D(RETURN(1)) S X=$$GET1^DIQ(9000010,VST,1401) I X]"" S RETURN(1)="Visit CC: "_X
I $D(RETURN(1)) S CNT=CNT+1 S X=$$GET1^DIQ(9000010,VST,1401) I X]"" S RETURN(CNT)="Visit CC: "_X
Q
;
;
VCPT(TARGET) ; returns CPT codes for current vuecentric visit context
I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
NEW X,I,VST,CNT,RESULT,LINE
S CNT=0
S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
I VST="" S @TARGET@(1,0)="Invalid VISIT" Q "~@"_$NA(@TARGET)
S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
;S X="CIAVCXEN" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^CIAVCXEN(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid routine" Q "~@"_$NA(@TARGET)
D GETCPT(.RESULT,VST)
;
K @TARGET
S (I,CNT)=0,LINE="" F S I=$O(RESULT(I)) Q:'I D
. S CNT=CNT+1
. S LINE=LINE_$S(CNT=1:"CPT codes: ",1:"; ")_RESULT(CNT)
I CNT S @TARGET@(1,0)=LINE
I 'CNT S @TARGET@(1,0)="No CPT codes found"
Q "~@"_$NA(@TARGET)
;
GETCPT(RETURN,VST) ;Returns all CPT codes for visit (short name & code)
; VST=Visit IEN
;
NEW VIEN,IEN,I,N,CNT,QTY,MODIFR
K RETURN
I $G(VST)="" S RETURN(1)="-1^Missing Input Data" Q
S VIEN=$P(VST,"|",1) I 'VIEN S RETURN(1)="-1^No Visit IEN" Q
I '$D(^AUPNVSIT(VIEN,0)) S RETURN(1)="-1^Visit does not exist" Q
;
S (IEN,CNT)=0 F S IEN=$O(^AUPNVCPT("AD",VIEN,IEN)) Q:'IEN D
. K BTIU D ENP^XBDIQ1(9000010.18,IEN,".01:.16","BTIU(")
. S CNT=CNT+1
. S MODIFR=$$CPTMOD(.BTIU) ;get modifiers if any
. S QTY="" I BTIU(.16)>1 S QTY=" Qty="_BTIU(.16)
. S RETURN(CNT)=BTIU(.019)_MODIFR_QTY_" ("_BTIU(.01)_")"
Q
;
CPTMOD(ARRAY) ; return CPT modifiers for entry IEN
NEW X
S X="" I ARRAY(.08)]"" S X=ARRAY(.08) ;modifier 1
I ARRAY(.09)]"" S X=$S(X="":ARRAY(.09),1:X_"; "_ARRAY(.09)) ;modifier 2
Q $S(X="":"",1:" ["_X_"]")
;
;
;IHS/ITSC/LJF 02/25/2005 PATCH 1002 adding subroutine for detailed display
VMSRD(TARGET) ;EP; returns msr for current vuecentric visit context in a single string
I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
NEW VST,X
S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
I VST="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
;S X="CIAVCXEN" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^CIAVCXEN(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid routine" Q "~@"_$NA(@TARGET)
;D GETMSR(.VST,VST_"|"_1)
D GETMSRD(.RESULT,VST)
;
K @TARGET S CNT=0
N I,J,K
S I="" F S I=$O(RESULT(I)) Q:I="" D
.S J="" F S J=$O(RESULT(I,J)) Q:J="" D
..S CNT=CNT+1
..S @TARGET@(CNT,0)=$G(RESULT(I,J))
I 'CNT S @TARGET@(1,0)="No Measurements Found"
Q "~@"_$NA(@TARGET)
;
GETMSRD(RETURN,VISIT) ; loop through visit measurements and get results
NEW MIEN,CNT,QUALIF,Y
K RETURN
S MIEN=0 F S MIEN=$O(^AUPNVMSR("AD",VISIT,MIEN)) Q:'MIEN D
. K TIU D ENP^XBDIQ1(9000010.01,MIEN,".01;.04;2;1201","TIU(","I")
. Q:TIU(2,"I")=1 ;SKIP ENTERED IN ERROR VITALS
. S QUALIF=$$QUAL^BTIULO7A(MIEN)
. S CNT=$G(CNT)+1
. I TIU(.01)="WT" S TIU(.04)=$J(TIU(.04),5,2)_" ("_$J((TIU(.04)*.454),5,2)_" kg)"
. I ((TIU(.01)="HT")!(TIU(.01)="HC")!(TIU(.01)="WC")!(TIU(.01)="AG")) S TIU(.04)=$J(TIU(.04),5,2)_" ("_$J((TIU(.04)*2.54),5,2)_" cm)"
. I TIU(.01)="TMP" S TIU(.04)=TIU(.04)_" ("_($J((10*((TIU(.04)-32)/1.8)),5,2)/10)_" C)"
. I TIU(.01)="BMI" D
. .S Y=$J(TIU(.04),5,2)
. .I $$PREG^BTIUPCC6(DFN,VST)=1 S Y=Y_"*"
. .S TIU(.04)=Y
. I QUALIF="" S RETURN(TIU(1201),TIU(.01))=$$NAME(TIU(.01,"I"))_": "_TIU(.04)_$$LSTDATE^BTIUPCC1(VISIT,TIU(1201,"I"),1)
. I QUALIF'="" S RETURN(TIU(1201),TIU(.01))=$$NAME(TIU(.01,"I"))_": "_TIU(.04)_$$LSTDATE^BTIUPCC1(VISIT,TIU(1201,"I"),1)_" Qualifiers: "_QUALIF
Q
NAME(X) ; return full name for measurement
Q $$GET1^DIQ(9999999.07,X,.02)
;IHS/ITSC/LJF 02/25/2005 ned of new code for PATCH 1002
;
;
VMSR() ;EP; returns msr for current vuecentric visit context in a single string
I $T(GETVAR^CIAVMEVT)="" Q "Invalid context variables"
NEW X,VST
S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
I VST="" Q "Invalid visit"
S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 Q "Invalid visit"
;S X="CIAVCXEN" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^CIAVCXEN(DFN,VST) I VST<1 Q
D GETMSR(.VST,VST_"|"_1)
Q $G(VST)
;
GETMSR(BTRRET,BTRIN) ; Returns common measurements for visit context
; input = Vien|format(0-multi-line array,1-tiu string)
; Return value is TYPE^VALUE^D/T^VMIEN^VIEN
NEW DAT,TYP,C,X,X2,TYPNM,VMIEN,VIEN,FORMAT,MSRSTR,QUALIF
S C=0
K BTRRET
S VIEN=$P(BTRIN,"|",1) I 'VIEN S BTRRET(1)="-1^No Visit"
S FORMAT=$P(BTRIN,"|",2) I FORMAT="" S FORMAT=0
S VMIEN=0 F S VMIEN=$O(^AUPNVMSR("AD",VIEN,VMIEN)) Q:'VMIEN D
. S X=$G(^AUPNVMSR(VMIEN,0)),DAT=+$G(^(12)) Q:X=""
. S X2=$G(^AUPNVMSR(VMIEN,2))
. Q:$P(X2,U,1)=1 ;SKIP ENTERED IN ERROR VITALS
. S TYP=$P(X,U)
. S TYPNM=$P($G(^AUTTMSR(TYP,0)),U) Q:TYPNM=""
. S:'DAT DAT=+$G(^AUPNVSIT(VIEN,0))
. S QUALIF=$$QUAL^BTIULO7A(VMIEN)
. S C=C+1
. I FORMAT=1 D Q
.. S MSRSTR=TYPNM_":"_$P(X,U,4)
.. I TYPNM="WT" S MSRSTR=TYPNM_":"_$J($P(MSRSTR,":",2),5,2)_" ("_$J(($P(X,U,4)*.454),5,2)_" kg)"
.. I ((TYPNM="HT")!(TYPNM="WC")!(TYPNM="HC")!(TYPNM="AG")) S MSRSTR=TYPNM_":"_$J($P(MSRSTR,":",2),5,2)_" ("_$J(($P(X,U,4)*2.54),5,2)_" cm)"
.. I TYPNM="BMI" D
...I $$PREG^BTIUPCC6(DFN,VIEN)=1 S MSRSTR=TYPNM_":"_$J($P(MSRSTR,":",2),5,2)_"*"
...E S MSRSTR=TYPNM_":"_$J($P(MSRSTR,":",2),5,2)
.. I TYPNM="TMP" S MSRSTR=TYPNM_":"_$J($P(MSRSTR,":",2),5,2)_" ("_(((10*(($P(X,U,4)-32)/1.8))\1)/10)_" C)"
.. I QUALIF="" S BTRRET=$S($G(BTRRET)="":"",1:BTRRET_", ")_MSRSTR
.. I QUALIF'="" S BTRRET=$S($G(BTRRET)="":"",1:BTRRET_", ")_MSRSTR_"["_QUALIF_"]"
. S BTRRET(C)=TYPNM_U_$P(X,U,4)_U_$$CDT(DAT)_U_VMIEN_U_$P(X,U,3)
I C=0 S BTRRET(1)="-2^No Data"
Q
;
CDT(X) ;EP - Y= date/time ##/##/####@##:## from X (fm date) for display in claim editor
N Y,ABMTIME
I '+X S Y="" Q Y
S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_($E(X,1,3)+1700) ;Y2000
I '$P(X,".",2) Q Y
S ABMTIME=$P(X,".",2)
S ABMTIME=ABMTIME_"00"
S Y=Y_"@"_$E(ABMTIME,1,2)_":"_$E(ABMTIME,3,4)
Q Y
;
;
PAD(DATA,LENGTH) ; pad length of data
Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
;
SP(NUM) ; pad spaces
Q $$PAD(" ",NUM)
;
BTIULO4 ; IHS/ITSC/LJF - MORE VISIT OBJECTS FOR EHR ;30-Nov-2015 07:22;du
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1002,1004,1005,1006,1010,1012,1013,1015**;NOV 04, 2004;Build 3
+2 ;IHS/ITSC/LJF 02/25/2005 PATCH 1002 added code for VITALS FOR VISIT CONTEXT object
+3 ;Added EHR 1.1 calls for visit selection
+4 ;Patch 6 added text for visit not selected
+5 ;Patch 1010 added vitals qualifiers
+6 ;
VCC(TARGET) ; returns chief complaint for current vuecentric visit context
+1 IF $TEXT(GETVAR^CIAVMEVT)=""
SET @TARGET@(1,0)="Invalid context variables"
QUIT "~@"_$NAME(@TARGET)
+2 NEW X,VST,CNT,RESULT
+3 SET CNT=0
+4 SET VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
+5 IF VST=""
SET @TARGET@(1,0)="Invalid visit"
QUIT "~@"_$NAME(@TARGET)
+6 SET X="BEHOENCX"
XECUTE ^%ZOSF("TEST")
IF $TEST
SET VST=+$$VSTR2VIS^BEHOENCX(DFN,VST)
IF VST<1
SET @TARGET@(1,0)="Invalid visit"
QUIT "~@"_$NAME(@TARGET)
+7 ;S X="CIAVCXEN" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^CIAVCXEN(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid routine" Q "~@"_$NA(@TARGET)
+8 DO GETCC(.RESULT,VST)
+9 ;
+10 KILL @TARGET
+11 SET (I,CNT)=0
FOR
SET I=$ORDER(RESULT(I))
IF 'I
QUIT
Begin DoDot:1
+12 SET CNT=CNT+1
+13 SET @TARGET@(CNT,0)=$SELECT(CNT=1:"Chief Complaint: ",1:$$SP(5))_RESULT(CNT)
End DoDot:1
+14 IF 'CNT
SET @TARGET@(1,0)="No Chief Complaint."
+15 QUIT "~@"_$NAME(@TARGET)
+16 ;
GETCC(RETURN,VST) ;Returns Chief Complaint array for visit
+1 ; VST=Visit IEN
+2 ;
+3 NEW VIEN,IEN,I,N,CNT
+4 KILL RETURN
+5 IF $GET(VST)=""
SET RETURN(1)="-1^Missing Input Data"
QUIT
+6 SET VIEN=$PIECE(VST,"|",1)
IF 'VIEN
SET RETURN(1)="-1^No Visit IEN"
QUIT
+7 IF '$DATA(^AUPNVSIT(VIEN,0))
SET RETURN(1)="-1^Visit does not exist"
QUIT
+8 ;
+9 SET CNT=0
+10 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVNT("AD",VIEN,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+11 IF $$GET1^DIQ(9000010.34,IEN,.01)'="CHIEF COMPLAINT"
QUIT
+12 SET N=0
FOR
SET N=$ORDER(^AUPNVNT(IEN,11,N))
IF 'N
QUIT
Begin DoDot:2
+13 IF $GET(^AUPNVNT(IEN,11,N,0))'=""
SET CNT=CNT+1
SET RETURN(CNT)=$GET(^AUPNVNT(IEN,11,N,0))
End DoDot:2
End DoDot:1
+14 IF '$DATA(RETURN(1))
SET X=$$GET1^DIQ(9000010,VST,1401)
IF X]""
SET RETURN(1)="Visit CC: "_X
+15 IF $DATA(RETURN(1))
SET CNT=CNT+1
SET X=$$GET1^DIQ(9000010,VST,1401)
IF X]""
SET RETURN(CNT)="Visit CC: "_X
+16 QUIT
+17 ;
+18 ;
VCPT(TARGET) ; returns CPT codes for current vuecentric visit context
+1 IF $TEXT(GETVAR^CIAVMEVT)=""
SET @TARGET@(1,0)="Invalid context variables"
QUIT "~@"_$NAME(@TARGET)
+2 NEW X,I,VST,CNT,RESULT,LINE
+3 SET CNT=0
+4 SET VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
+5 IF VST=""
SET @TARGET@(1,0)="Invalid VISIT"
QUIT "~@"_$NAME(@TARGET)
+6 SET X="BEHOENCX"
XECUTE ^%ZOSF("TEST")
IF $TEST
SET VST=+$$VSTR2VIS^BEHOENCX(DFN,VST)
IF VST<1
SET @TARGET@(1,0)="Invalid visit"
QUIT "~@"_$NAME(@TARGET)
+7 ;S X="CIAVCXEN" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^CIAVCXEN(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid routine" Q "~@"_$NA(@TARGET)
+8 DO GETCPT(.RESULT,VST)
+9 ;
+10 KILL @TARGET
+11 SET (I,CNT)=0
SET LINE=""
FOR
SET I=$ORDER(RESULT(I))
IF 'I
QUIT
Begin DoDot:1
+12 SET CNT=CNT+1
+13 SET LINE=LINE_$SELECT(CNT=1:"CPT codes: ",1:"; ")_RESULT(CNT)
End DoDot:1
+14 IF CNT
SET @TARGET@(1,0)=LINE
+15 IF 'CNT
SET @TARGET@(1,0)="No CPT codes found"
+16 QUIT "~@"_$NAME(@TARGET)
+17 ;
GETCPT(RETURN,VST) ;Returns all CPT codes for visit (short name & code)
+1 ; VST=Visit IEN
+2 ;
+3 NEW VIEN,IEN,I,N,CNT,QTY,MODIFR
+4 KILL RETURN
+5 IF $GET(VST)=""
SET RETURN(1)="-1^Missing Input Data"
QUIT
+6 SET VIEN=$PIECE(VST,"|",1)
IF 'VIEN
SET RETURN(1)="-1^No Visit IEN"
QUIT
+7 IF '$DATA(^AUPNVSIT(VIEN,0))
SET RETURN(1)="-1^Visit does not exist"
QUIT
+8 ;
+9 SET (IEN,CNT)=0
FOR
SET IEN=$ORDER(^AUPNVCPT("AD",VIEN,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+10 KILL BTIU
DO ENP^XBDIQ1(9000010.18,IEN,".01:.16","BTIU(")
+11 SET CNT=CNT+1
+12 ;get modifiers if any
SET MODIFR=$$CPTMOD(.BTIU)
+13 SET QTY=""
IF BTIU(.16)>1
SET QTY=" Qty="_BTIU(.16)
+14 SET RETURN(CNT)=BTIU(.019)_MODIFR_QTY_" ("_BTIU(.01)_")"
End DoDot:1
+15 QUIT
+16 ;
CPTMOD(ARRAY) ; return CPT modifiers for entry IEN
+1 NEW X
+2 ;modifier 1
SET X=""
IF ARRAY(.08)]""
SET X=ARRAY(.08)
+3 ;modifier 2
IF ARRAY(.09)]""
SET X=$SELECT(X="":ARRAY(.09),1:X_"; "_ARRAY(.09))
+4 QUIT $SELECT(X="":"",1:" ["_X_"]")
+5 ;
+6 ;
+7 ;IHS/ITSC/LJF 02/25/2005 PATCH 1002 adding subroutine for detailed display
VMSRD(TARGET) ;EP; returns msr for current vuecentric visit context in a single string
+1 IF $TEXT(GETVAR^CIAVMEVT)=""
SET @TARGET@(1,0)="Invalid context variables"
QUIT "~@"_$NAME(@TARGET)
+2 NEW VST,X
+3 SET VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
+4 IF VST=""
SET @TARGET@(1,0)="Invalid visit"
QUIT "~@"_$NAME(@TARGET)
+5 SET X="BEHOENCX"
XECUTE ^%ZOSF("TEST")
IF $TEST
SET VST=+$$VSTR2VIS^BEHOENCX(DFN,VST)
IF VST<1
SET @TARGET@(1,0)="Invalid visit"
QUIT "~@"_$NAME(@TARGET)
+6 ;S X="CIAVCXEN" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^CIAVCXEN(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid routine" Q "~@"_$NA(@TARGET)
+7 ;D GETMSR(.VST,VST_"|"_1)
+8 DO GETMSRD(.RESULT,VST)
+9 ;
+10 KILL @TARGET
SET CNT=0
+11 NEW I,J,K
+12 SET I=""
FOR
SET I=$ORDER(RESULT(I))
IF I=""
QUIT
Begin DoDot:1
+13 SET J=""
FOR
SET J=$ORDER(RESULT(I,J))
IF J=""
QUIT
Begin DoDot:2
+14 SET CNT=CNT+1
+15 SET @TARGET@(CNT,0)=$GET(RESULT(I,J))
End DoDot:2
End DoDot:1
+16 IF 'CNT
SET @TARGET@(1,0)="No Measurements Found"
+17 QUIT "~@"_$NAME(@TARGET)
+18 ;
GETMSRD(RETURN,VISIT) ; loop through visit measurements and get results
+1 NEW MIEN,CNT,QUALIF,Y
+2 KILL RETURN
+3 SET MIEN=0
FOR
SET MIEN=$ORDER(^AUPNVMSR("AD",VISIT,MIEN))
IF 'MIEN
QUIT
Begin DoDot:1
+4 KILL TIU
DO ENP^XBDIQ1(9000010.01,MIEN,".01;.04;2;1201","TIU(","I")
+5 ;SKIP ENTERED IN ERROR VITALS
IF TIU(2,"I")=1
QUIT
+6 SET QUALIF=$$QUAL^BTIULO7A(MIEN)
+7 SET CNT=$GET(CNT)+1
+8 IF TIU(.01)="WT"
SET TIU(.04)=$JUSTIFY(TIU(.04),5,2)_" ("_$JUSTIFY((TIU(.04)*.454),5,2)_" kg)"
+9 IF ((TIU(.01)="HT")!(TIU(.01)="HC")!(TIU(.01)="WC")!(TIU(.01)="AG"))
SET TIU(.04)=$JUSTIFY(TIU(.04),5,2)_" ("_$JUSTIFY((TIU(.04)*2.54),5,2)_" cm)"
+10 IF TIU(.01)="TMP"
SET TIU(.04)=TIU(.04)_" ("_($JUSTIFY((10*((TIU(.04)-32)/1.8)),5,2)/10)_" C)"
+11 IF TIU(.01)="BMI"
Begin DoDot:2
+12 SET Y=$JUSTIFY(TIU(.04),5,2)
+13 IF $$PREG^BTIUPCC6(DFN,VST)=1
SET Y=Y_"*"
+14 SET TIU(.04)=Y
End DoDot:2
+15 IF QUALIF=""
SET RETURN(TIU(1201),TIU(.01))=$$NAME(TIU(.01,"I"))_": "_TIU(.04)_$$LSTDATE^BTIUPCC1(VISIT,TIU(1201,"I"),1)
+16 IF QUALIF'=""
SET RETURN(TIU(1201),TIU(.01))=$$NAME(TIU(.01,"I"))_": "_TIU(.04)_$$LSTDATE^BTIUPCC1(VISIT,TIU(1201,"I"),1)_" Qualifiers: "_QUALIF
End DoDot:1
+17 QUIT
NAME(X) ; return full name for measurement
+1 QUIT $$GET1^DIQ(9999999.07,X,.02)
+2 ;IHS/ITSC/LJF 02/25/2005 ned of new code for PATCH 1002
+3 ;
+4 ;
VMSR() ;EP; returns msr for current vuecentric visit context in a single string
+1 IF $TEXT(GETVAR^CIAVMEVT)=""
QUIT "Invalid context variables"
+2 NEW X,VST
+3 SET VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
+4 IF VST=""
QUIT "Invalid visit"
+5 SET X="BEHOENCX"
XECUTE ^%ZOSF("TEST")
IF $TEST
SET VST=+$$VSTR2VIS^BEHOENCX(DFN,VST)
IF VST<1
QUIT "Invalid visit"
+6 ;S X="CIAVCXEN" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^CIAVCXEN(DFN,VST) I VST<1 Q
+7 DO GETMSR(.VST,VST_"|"_1)
+8 QUIT $GET(VST)
+9 ;
GETMSR(BTRRET,BTRIN) ; Returns common measurements for visit context
+1 ; input = Vien|format(0-multi-line array,1-tiu string)
+2 ; Return value is TYPE^VALUE^D/T^VMIEN^VIEN
+3 NEW DAT,TYP,C,X,X2,TYPNM,VMIEN,VIEN,FORMAT,MSRSTR,QUALIF
+4 SET C=0
+5 KILL BTRRET
+6 SET VIEN=$PIECE(BTRIN,"|",1)
IF 'VIEN
SET BTRRET(1)="-1^No Visit"
+7 SET FORMAT=$PIECE(BTRIN,"|",2)
IF FORMAT=""
SET FORMAT=0
+8 SET VMIEN=0
FOR
SET VMIEN=$ORDER(^AUPNVMSR("AD",VIEN,VMIEN))
IF 'VMIEN
QUIT
Begin DoDot:1
+9 SET X=$GET(^AUPNVMSR(VMIEN,0))
SET DAT=+$GET(^(12))
IF X=""
QUIT
+10 SET X2=$GET(^AUPNVMSR(VMIEN,2))
+11 ;SKIP ENTERED IN ERROR VITALS
IF $PIECE(X2,U,1)=1
QUIT
+12 SET TYP=$PIECE(X,U)
+13 SET TYPNM=$PIECE($GET(^AUTTMSR(TYP,0)),U)
IF TYPNM=""
QUIT
+14 IF 'DAT
SET DAT=+$GET(^AUPNVSIT(VIEN,0))
+15 SET QUALIF=$$QUAL^BTIULO7A(VMIEN)
+16 SET C=C+1
+17 IF FORMAT=1
Begin DoDot:2
+18 SET MSRSTR=TYPNM_":"_$PIECE(X,U,4)
+19 IF TYPNM="WT"
SET MSRSTR=TYPNM_":"_$JUSTIFY($PIECE(MSRSTR,":",2),5,2)_" ("_$JUSTIFY(($PIECE(X,U,4)*.454),5,2)_" kg)"
+20 IF ((TYPNM="HT")!(TYPNM="WC")!(TYPNM="HC")!(TYPNM="AG"))
SET MSRSTR=TYPNM_":"_$JUSTIFY($PIECE(MSRSTR,":",2),5,2)_" ("_$JUSTIFY(($PIECE(X,U,4)*2.54),5,2)_" cm)"
+21 IF TYPNM="BMI"
Begin DoDot:3
+22 IF $$PREG^BTIUPCC6(DFN,VIEN)=1
SET MSRSTR=TYPNM_":"_$JUSTIFY($PIECE(MSRSTR,":",2),5,2)_"*"
+23 IF '$TEST
SET MSRSTR=TYPNM_":"_$JUSTIFY($PIECE(MSRSTR,":",2),5,2)
End DoDot:3
+24 IF TYPNM="TMP"
SET MSRSTR=TYPNM_":"_$JUSTIFY($PIECE(MSRSTR,":",2),5,2)_" ("_(((10*(($PIECE(X,U,4)-32)/1.8))\1)/10)_" C)"
+25 IF QUALIF=""
SET BTRRET=$SELECT($GET(BTRRET)="":"",1:BTRRET_", ")_MSRSTR
+26 IF QUALIF'=""
SET BTRRET=$SELECT($GET(BTRRET)="":"",1:BTRRET_", ")_MSRSTR_"["_QUALIF_"]"
End DoDot:2
QUIT
+27 SET BTRRET(C)=TYPNM_U_$PIECE(X,U,4)_U_$$CDT(DAT)_U_VMIEN_U_$PIECE(X,U,3)
End DoDot:1
+28 IF C=0
SET BTRRET(1)="-2^No Data"
+29 QUIT
+30 ;
CDT(X) ;EP - Y= date/time ##/##/####@##:## from X (fm date) for display in claim editor
+1 NEW Y,ABMTIME
+2 IF '+X
SET Y=""
QUIT Y
+3 ;Y2000
SET Y=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_($EXTRACT(X,1,3)+1700)
+4 IF '$PIECE(X,".",2)
QUIT Y
+5 SET ABMTIME=$PIECE(X,".",2)
+6 SET ABMTIME=ABMTIME_"00"
+7 SET Y=Y_"@"_$EXTRACT(ABMTIME,1,2)_":"_$EXTRACT(ABMTIME,3,4)
+8 QUIT Y
+9 ;
+10 ;
PAD(DATA,LENGTH) ; pad length of data
+1 QUIT $EXTRACT(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
+2 ;
SP(NUM) ; pad spaces
+1 QUIT $$PAD(" ",NUM)
+2 ;
