BTIULO3 ; IHS/ITSC/LJF - VISIT OBJECTS FOR EHR ;01-Jun-2010 09:18;MGH
;;1.0;TEXT INTEGRATION UTILITIES;**1004,1006**;NOV 04, 2004
;Added calls for EHR 1.1 visit creation
;Patch 1006 - updated error return if visit not found
;
VIMM(TARGET) ; returns immunizations given for current vuecentric visit context
I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
NEW VST,I,CNT,RESULT,X
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 Q
D GETIMM(.RESULT,VST)
;
K @TARGET
S I=0 F S I=$O(RESULT(I)) Q:'I D
.S CNT=CNT+1
.S @TARGET@(CNT,0)=RESULT(I)
I 'CNT S @TARGET@(1,0)="No Immunizations Found"
Q "~@"_$NA(@TARGET)
;
GETIMM(RETURN,VIEN) ;return every immunization for current visit
; VISIT=Visit IEN
;
NEW IEN,CNT,SERIES
K RETURN
;
S IEN=0 F S IEN=$O(^AUPNVIMM("AD",VIEN,IEN)) Q:'IEN D
. S CNT=$G(CNT)+1
. S SERIES=$$GET1^DIQ(9000010.11,IEN,.04)
. S RETURN(CNT)=$$GET1^DIQ(9000010.11,IEN,.01)_$S(SERIES]"":" ("_SERIES_")",1:"")
Q
VLAB(TARGET) ; returns resulted labs for current vuecentric visit context
I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
NEW VST,I,X,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 Q
D GETLAB(.RESULT,VST)
K @TARGET
S I=0 F S I=$O(RESULT(I)) Q:'I D
.S CNT=CNT+1
.S @TARGET@(CNT,0)=RESULT(I)
I 'CNT S @TARGET@(1,0)="No Lab Results Found"
Q "~@"_$NA(@TARGET)
;
GETLAB(RETURN,VIEN) ;return every resulted lab for current visit
; VISIT=Visit IEN
;
NEW IEN,CNT,RESULT
K RETURN
;
S IEN=0 F S IEN=$O(^AUPNVLAB("AD",VIEN,IEN)) Q:'IEN D
. S CNT=$G(CNT)+1
. S RESULT=$$GET1^DIQ(9000010.09,IEN,.04) Q:RESULT="" ;not resulted yet
. S RETURN(CNT)=$$GET1^DIQ(9000010.09,IEN,.01)_" ("_RESULT_")"
Q
VSKIN(TARGET) ; returns skin tests for current vuecentric visit context
I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
NEW VST,I,X,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 Q
D GETSKIN(.RESULT,VST)
K @TARGET
S I=0 F S I=$O(RESULT(I)) Q:'I D
.S CNT=CNT+1
.S @TARGET@(CNT,0)=RESULT(I)
I 'CNT S @TARGET@(1,0)="No Skin Tests Found"
Q "~@"_$NA(@TARGET)
;
GETSKIN(RETURN,VIEN) ;return every skin test for current visit
; VISIT=Visit IEN
;
NEW IEN,CNT,BTIU,LINE
K RETURN
;
S IEN=0 F S IEN=$O(^AUPNVSK("AD",VIEN,IEN)) Q:'IEN D
. S CNT=$G(CNT)+1 D
.. K BTIU D ENP^XBDIQ1(9000010.12,IEN,".03:.06","BTIU(")
.. I BTIU(.04)="" S LINE="Placed on "_BTIU(.03) Q
.. S LINE=$$PAD($J(BTIU(.04),12)_" "_BTIU(.05),25)
.. S LINE=LINE_"Date Read: "_BTIU(.06)
. S RETURN(CNT)=$$PAD($$GET1^DIQ(9000010.12,IEN,.01)_":",12)_LINE
. Q
VPRC(TARGET,MULTI) ; returns procedures for current vuecentric visit context
; MULTI=0 return one line of procedure names; MULTI=1 return 1 line per procedure
I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variabled" Q "~@"_$NA(@TARGET)
NEW VST,I,CNT,RESULT,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 Q
D GETPRC(.RESULT,VST,MULTI)
;
K @TARGET S CNT=0
S I=0 F S I=$O(RESULT(I)) Q:'I D
.S CNT=CNT+1
.S @TARGET@(CNT,0)=RESULT(I)
I 'CNT S @TARGET@(1,0)="No Procedures Found"
Q "~@"_$NA(@TARGET)
;
GETPRC(RETURN,VIEN,MULTI) ;return every procedure for current visit
; VISIT=Visit IEN
;
NEW IEN,CNT,BTIU,LINE
K RETURN
;
S IEN=0 F S IEN=$O(^AUPNVPRC("AD",VIEN,IEN)) Q:'IEN D
. I 'MULTI S RETURN(1)=$G(RETURN(1))_$$GET1^DIQ(9000010.08,IEN,.04)_"; " Q
. S CNT=$G(CNT)+1
. K BTIU D ENP^XBDIQ1(9000010.08,IEN,".06;.11;1204","BTIU(")
. S LINE=" on "_BTIU(.06)_" by "_$S(BTIU(.11)]"":BTIU(.11),1:BTIU(1204))
. S RETURN(CNT)=$$GET1^DIQ(9000010.08,IEN,.04)_LINE
;
I 'MULTI,$D(RETURN(1)) S RETURN(1)=$E(RETURN(1),1,$L(RETURN(1))-2) ;take off last "; "
Q
;
PAD(DATA,LENGTH) ; pad length of data
Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
;
SP(NUM) ; pad spaces
Q $$PAD(" ",NUM)
BTIULO3 ; IHS/ITSC/LJF - VISIT OBJECTS FOR EHR ;01-Jun-2010 09:18;MGH
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1004,1006**;NOV 04, 2004
+2 ;Added calls for EHR 1.1 visit creation
+3 ;Patch 1006 - updated error return if visit not found
+4 ;
VIMM(TARGET) ; returns immunizations given for current vuecentric visit context
+1 IF $TEXT(GETVAR^CIAVMEVT)=""
SET @TARGET@(1,0)="Invalid context variables"
QUIT "~@"_$NAME(@TARGET)
+2 NEW VST,I,CNT,RESULT,X
+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 Q
+8 DO GETIMM(.RESULT,VST)
+9 ;
+10 KILL @TARGET
+11 SET I=0
FOR
SET I=$ORDER(RESULT(I))
IF 'I
QUIT
Begin DoDot:1
+12 SET CNT=CNT+1
+13 SET @TARGET@(CNT,0)=RESULT(I)
End DoDot:1
+14 IF 'CNT
SET @TARGET@(1,0)="No Immunizations Found"
+15 QUIT "~@"_$NAME(@TARGET)
+16 ;
GETIMM(RETURN,VIEN) ;return every immunization for current visit
+1 ; VISIT=Visit IEN
+2 ;
+3 NEW IEN,CNT,SERIES
+4 KILL RETURN
+5 ;
+6 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVIMM("AD",VIEN,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+7 SET CNT=$GET(CNT)+1
+8 SET SERIES=$$GET1^DIQ(9000010.11,IEN,.04)
+9 SET RETURN(CNT)=$$GET1^DIQ(9000010.11,IEN,.01)_$SELECT(SERIES]"":" ("_SERIES_")",1:"")
End DoDot:1
+10 QUIT
VLAB(TARGET) ; returns resulted labs for current vuecentric visit context
+1 IF $TEXT(GETVAR^CIAVMEVT)=""
SET @TARGET@(1,0)="Invalid context variables"
QUIT "~@"_$NAME(@TARGET)
+2 NEW VST,I,X,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 Q
+8 DO GETLAB(.RESULT,VST)
+9 KILL @TARGET
+10 SET I=0
FOR
SET I=$ORDER(RESULT(I))
IF 'I
QUIT
Begin DoDot:1
+11 SET CNT=CNT+1
+12 SET @TARGET@(CNT,0)=RESULT(I)
End DoDot:1
+13 IF 'CNT
SET @TARGET@(1,0)="No Lab Results Found"
+14 QUIT "~@"_$NAME(@TARGET)
+15 ;
GETLAB(RETURN,VIEN) ;return every resulted lab for current visit
+1 ; VISIT=Visit IEN
+2 ;
+3 NEW IEN,CNT,RESULT
+4 KILL RETURN
+5 ;
+6 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVLAB("AD",VIEN,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+7 SET CNT=$GET(CNT)+1
+8 ;not resulted yet
SET RESULT=$$GET1^DIQ(9000010.09,IEN,.04)
IF RESULT=""
QUIT
+9 SET RETURN(CNT)=$$GET1^DIQ(9000010.09,IEN,.01)_" ("_RESULT_")"
End DoDot:1
+10 QUIT
VSKIN(TARGET) ; returns skin tests for current vuecentric visit context
+1 IF $TEXT(GETVAR^CIAVMEVT)=""
SET @TARGET@(1,0)="Invalid context variables"
QUIT "~@"_$NAME(@TARGET)
+2 NEW VST,I,X,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 Q
+8 DO GETSKIN(.RESULT,VST)
+9 KILL @TARGET
+10 SET I=0
FOR
SET I=$ORDER(RESULT(I))
IF 'I
QUIT
Begin DoDot:1
+11 SET CNT=CNT+1
+12 SET @TARGET@(CNT,0)=RESULT(I)
End DoDot:1
+13 IF 'CNT
SET @TARGET@(1,0)="No Skin Tests Found"
+14 QUIT "~@"_$NAME(@TARGET)
+15 ;
GETSKIN(RETURN,VIEN) ;return every skin test for current visit
+1 ; VISIT=Visit IEN
+2 ;
+3 NEW IEN,CNT,BTIU,LINE
+4 KILL RETURN
+5 ;
+6 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVSK("AD",VIEN,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+7 SET CNT=$GET(CNT)+1
Begin DoDot:2
+8 KILL BTIU
DO ENP^XBDIQ1(9000010.12,IEN,".03:.06","BTIU(")
+9 IF BTIU(.04)=""
SET LINE="Placed on "_BTIU(.03)
QUIT
+10 SET LINE=$$PAD($JUSTIFY(BTIU(.04),12)_" "_BTIU(.05),25)
+11 SET LINE=LINE_"Date Read: "_BTIU(.06)
End DoDot:2
+12 SET RETURN(CNT)=$$PAD($$GET1^DIQ(9000010.12,IEN,.01)_":",12)_LINE
+13 QUIT
End DoDot:1
VPRC(TARGET,MULTI) ; returns procedures for current vuecentric visit context
+1 ; MULTI=0 return one line of procedure names; MULTI=1 return 1 line per procedure
+2 IF $TEXT(GETVAR^CIAVMEVT)=""
SET @TARGET@(1,0)="Invalid context variabled"
QUIT "~@"_$NAME(@TARGET)
+3 NEW VST,I,CNT,RESULT,X
+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 Q
+8 DO GETPRC(.RESULT,VST,MULTI)
+9 ;
+10 KILL @TARGET
SET CNT=0
+11 SET I=0
FOR
SET I=$ORDER(RESULT(I))
IF 'I
QUIT
Begin DoDot:1
+12 SET CNT=CNT+1
+13 SET @TARGET@(CNT,0)=RESULT(I)
End DoDot:1
+14 IF 'CNT
SET @TARGET@(1,0)="No Procedures Found"
+15 QUIT "~@"_$NAME(@TARGET)
+16 ;
GETPRC(RETURN,VIEN,MULTI) ;return every procedure for current visit
+1 ; VISIT=Visit IEN
+2 ;
+3 NEW IEN,CNT,BTIU,LINE
+4 KILL RETURN
+5 ;
+6 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVPRC("AD",VIEN,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+7 IF 'MULTI
SET RETURN(1)=$GET(RETURN(1))_$$GET1^DIQ(9000010.08,IEN,.04)_"; "
QUIT
+8 SET CNT=$GET(CNT)+1
+9 KILL BTIU
DO ENP^XBDIQ1(9000010.08,IEN,".06;.11;1204","BTIU(")
+10 SET LINE=" on "_BTIU(.06)_" by "_$SELECT(BTIU(.11)]"":BTIU(.11),1:BTIU(1204))
+11 SET RETURN(CNT)=$$GET1^DIQ(9000010.08,IEN,.04)_LINE
End DoDot:1
+12 ;
+13 ;take off last "; "
IF 'MULTI
IF $DATA(RETURN(1))
SET RETURN(1)=$EXTRACT(RETURN(1),1,$LENGTH(RETURN(1))-2)
+14 QUIT
+15 ;
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)
