BTIULO14 ; IHS/MSC/MGH - STILL MORE OBJECTS FOR EHR ;11-May-2016 12:52;DU
;;1.0;TEXT INTEGRATION UTILITIES;**1009,1011,1012,1017**;NOV 04, 2004;Build 7
VPTED(TARGET) ; returns patient education topics for current vuecentric visit context
; MULTI=0 return on=e line of education topic names; MULTI=1 return 1 line per topic
I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
NEW VST,I,X,CNT,RESULT
S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
;I VST="" Q " "
I VST="" S @TARGET@(1,0)="No visit selected" Q "~@"_$NA(@TARGET)
S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 S @TARGET@(1,0)="A visit was not created." Q "~@"_$NA(@TARGET)
S CNT=0
D GETPTED(.RESULT,VST)
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 Patient Education Found"
Q "~@"_$NA(@TARGET)
GETPTED(RETURN,VIEN) ;return every education topic for current visit
; VISIT=Visit IEN
;
NEW IEN,BTIU,LINE,NUM,TOPIC
K RETURN
;
S IEN=0 F S IEN=$O(^AUPNVPED("AD",VIEN,IEN)) Q:'IEN D
. S CNT=$G(CNT)+1,NUM=$G(NUM)+1
. K BTIU D ENP^XBDIQ1(9000010.16,IEN,".01;.05:.08;.11","BTIU(","I")
. ;S LINE=" "_$$EDABBRV(BTIU(.01,"I"))_": "_BTIU(.08)_" min.; "
. S TOPIC=$$GET1^DIQ(9000010.16,IEN,.01)
. S LINE=" "_TOPIC_": "_BTIU(.08)_" min.; "
. S LINE=LINE_BTIU(.07)_"; Understanding-"_BTIU(.06)
. S RETURN(CNT)=$J(NUM,2)_LINE
. D SUBTOPIC(IEN)
. I $G(BTIU(.11))'="" D
.. S CNT=CNT+1
.. S RETURN(CNT)=" Comment: "_$E(BTIU(.11),1,60)
Q
;
EDABBRV(X) ; -- returns education topic abbreviation
Q $$GET1^DIQ(9999999.09,X,1)
;
SUBTOPIC(IEN) ;Get the subtopics for this patient ed
N SUB,TOPIC,LEVEL,LINE
S SUB=0 F S SUB=$O(^AUPNVPED(IEN,1,SUB)) Q:SUB="" D
.S TOPIC=$P($G(^AUPNVPED(IEN,1,SUB,0)),U,1)
.S CNT=CNT+1
.S RETURN(CNT)=" "_TOPIC
Q
;
PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
;
SP(NUM) ; -- SUBRTN to pad spaces
Q $$PAD(" ",NUM)
;Get privacy practices information
PRPRAC(DFN,TARGET) ;EP
N IEN,CNT,RSP,WHEN,BY,REA
K @TARGET
S IEN="",CNT=0
S IEN=$O(^AUPNNPP("B",DFN,IEN))
I +IEN D
.S RSP=$$GET1^DIQ(9000038,IEN,.02)
.S WHEN=$$GET1^DIQ(9000038,IEN,.03)
.S CNT=CNT+1
.S @TARGET@(CNT,0)="Was Notice of Privacy Practices (NPP) received by Pt? "_$S(RSP="YES":"YES",1:"NO")
.S CNT=CNT+1
.S @TARGET@(CNT,0)="Date: "_WHEN
.S RSP=$$GET1^DIQ(9000038,IEN,.04)
.S CNT=CNT+1
.S @TARGET@(CNT,0)="Was the Acknowledgement of Receipt of NPP signed? "_$S(RSP="YES":"YES",1:"NO")
.S REA=$$GET1^DIQ(9000038,IEN,.05)
.S WHEN=$$GET1^DIQ(9000038,IEN,.06)
.S BY=$$GET1^DIQ(9000038,IEN,.07)
.S CNT=CNT+1
.I REA'="" S @TARGET@(CNT,0)="Reason not signed "_REA
.S CNT=CNT+1
.S @TARGET@(CNT,0)="Entered: "_WHEN_" by "_BY
E S @TARGET@(1,0)="No privacy practice for this pt"
Q "~@"_$NA(@TARGET)
VABNLAB(TARGET) ; returns abnormal 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 Abnormal Lab Results Found"
Q "~@"_$NA(@TARGET)
;
GETLAB(RETURN,VIEN) ;check every resulted lab for current visit only return abnormals
; VISIT=Visit IEN
;
NEW IEN,CNT,RESULT,ABN
K RETURN
;
S IEN=0 F S IEN=$O(^AUPNVLAB("AD",VIEN,IEN)) Q:'IEN D
. S ABN=$$GET1^DIQ(9000010.09,IEN,.05)
. Q:ABN=""
. S CNT=$G(CNT)+1
. S RESULT=$$GET1^DIQ(9000010.09,IEN,.04) Q:RESULT="" ;not resulted yetT
. S RETURN(CNT)=$$GET1^DIQ(9000010.09,IEN,.01)_" ("_RESULT_ABN_")"
Q
BTIULO14 ; IHS/MSC/MGH - STILL MORE OBJECTS FOR EHR ;11-May-2016 12:52;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1009,1011,1012,1017**;NOV 04, 2004;Build 7
VPTED(TARGET) ; returns patient education topics for current vuecentric visit context
+1 ; MULTI=0 return on=e line of education topic names; MULTI=1 return 1 line per topic
+2 IF $TEXT(GETVAR^CIAVMEVT)=""
SET @TARGET@(1,0)="Invalid context variables"
QUIT "~@"_$NAME(@TARGET)
+3 NEW VST,I,X,CNT,RESULT
+4 SET VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
+5 ;I VST="" Q " "
+6 IF VST=""
SET @TARGET@(1,0)="No visit selected"
QUIT "~@"_$NAME(@TARGET)
+7 SET X="BEHOENCX"
XECUTE ^%ZOSF("TEST")
IF $TEST
SET VST=+$$VSTR2VIS^BEHOENCX(DFN,VST)
IF VST<1
SET @TARGET@(1,0)="A visit was not created."
QUIT "~@"_$NAME(@TARGET)
+8 SET CNT=0
+9 DO GETPTED(.RESULT,VST)
+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 Patient Education Found"
+15 QUIT "~@"_$NAME(@TARGET)
GETPTED(RETURN,VIEN) ;return every education topic for current visit
+1 ; VISIT=Visit IEN
+2 ;
+3 NEW IEN,BTIU,LINE,NUM,TOPIC
+4 KILL RETURN
+5 ;
+6 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVPED("AD",VIEN,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+7 SET CNT=$GET(CNT)+1
SET NUM=$GET(NUM)+1
+8 KILL BTIU
DO ENP^XBDIQ1(9000010.16,IEN,".01;.05:.08;.11","BTIU(","I")
+9 ;S LINE=" "_$$EDABBRV(BTIU(.01,"I"))_": "_BTIU(.08)_" min.; "
+10 SET TOPIC=$$GET1^DIQ(9000010.16,IEN,.01)
+11 SET LINE=" "_TOPIC_": "_BTIU(.08)_" min.; "
+12 SET LINE=LINE_BTIU(.07)_"; Understanding-"_BTIU(.06)
+13 SET RETURN(CNT)=$JUSTIFY(NUM,2)_LINE
+14 DO SUBTOPIC(IEN)
+15 IF $GET(BTIU(.11))'=""
Begin DoDot:2
+16 SET CNT=CNT+1
+17 SET RETURN(CNT)=" Comment: "_$EXTRACT(BTIU(.11),1,60)
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
EDABBRV(X) ; -- returns education topic abbreviation
+1 QUIT $$GET1^DIQ(9999999.09,X,1)
+2 ;
SUBTOPIC(IEN) ;Get the subtopics for this patient ed
+1 NEW SUB,TOPIC,LEVEL,LINE
+2 SET SUB=0
FOR
SET SUB=$ORDER(^AUPNVPED(IEN,1,SUB))
IF SUB=""
QUIT
Begin DoDot:1
+3 SET TOPIC=$PIECE($GET(^AUPNVPED(IEN,1,SUB,0)),U,1)
+4 SET CNT=CNT+1
+5 SET RETURN(CNT)=" "_TOPIC
End DoDot:1
+6 QUIT
+7 ;
PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
+1 QUIT $EXTRACT(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
+2 ;
SP(NUM) ; -- SUBRTN to pad spaces
+1 QUIT $$PAD(" ",NUM)
+2 ;Get privacy practices information
PRPRAC(DFN,TARGET) ;EP
+1 NEW IEN,CNT,RSP,WHEN,BY,REA
+2 KILL @TARGET
+3 SET IEN=""
SET CNT=0
+4 SET IEN=$ORDER(^AUPNNPP("B",DFN,IEN))
+5 IF +IEN
Begin DoDot:1
+6 SET RSP=$$GET1^DIQ(9000038,IEN,.02)
+7 SET WHEN=$$GET1^DIQ(9000038,IEN,.03)
+8 SET CNT=CNT+1
+9 SET @TARGET@(CNT,0)="Was Notice of Privacy Practices (NPP) received by Pt? "_$SELECT(RSP="YES":"YES",1:"NO")
+10 SET CNT=CNT+1
+11 SET @TARGET@(CNT,0)="Date: "_WHEN
+12 SET RSP=$$GET1^DIQ(9000038,IEN,.04)
+13 SET CNT=CNT+1
+14 SET @TARGET@(CNT,0)="Was the Acknowledgement of Receipt of NPP signed? "_$SELECT(RSP="YES":"YES",1:"NO")
+15 SET REA=$$GET1^DIQ(9000038,IEN,.05)
+16 SET WHEN=$$GET1^DIQ(9000038,IEN,.06)
+17 SET BY=$$GET1^DIQ(9000038,IEN,.07)
+18 SET CNT=CNT+1
+19 IF REA'=""
SET @TARGET@(CNT,0)="Reason not signed "_REA
+20 SET CNT=CNT+1
+21 SET @TARGET@(CNT,0)="Entered: "_WHEN_" by "_BY
End DoDot:1
+22 IF '$TEST
SET @TARGET@(1,0)="No privacy practice for this pt"
+23 QUIT "~@"_$NAME(@TARGET)
VABNLAB(TARGET) ; returns abnormal 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 Abnormal Lab Results Found"
+14 QUIT "~@"_$NAME(@TARGET)
+15 ;
GETLAB(RETURN,VIEN) ;check every resulted lab for current visit only return abnormals
+1 ; VISIT=Visit IEN
+2 ;
+3 NEW IEN,CNT,RESULT,ABN
+4 KILL RETURN
+5 ;
+6 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVLAB("AD",VIEN,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+7 SET ABN=$$GET1^DIQ(9000010.09,IEN,.05)
+8 IF ABN=""
QUIT
+9 SET CNT=$GET(CNT)+1
+10 ;not resulted yetT
SET RESULT=$$GET1^DIQ(9000010.09,IEN,.04)
IF RESULT=""
QUIT
+11 SET RETURN(CNT)=$$GET1^DIQ(9000010.09,IEN,.01)_" ("_RESULT_ABN_")"
End DoDot:1
+12 QUIT
