BTIULO5 ; IHS/ITSC/LJF - STILL MORE OBJECTS FOR EHR ;27-Apr-2016 12:26;DU
;;1.0;TEXT INTEGRATION UTILITIES;**1001,1002,1004,1005,1006,1009,1012,1013,1016**;NOV 04, 2004;Build 10
;IHS/ITSC/LJF 12/10/2004 PATCH 1001 V Orders object was not displaying a modified order
; 04/08/2005 PATCH 1002 Indented display of medication sig
; PATCH 1004 Changed to EHR 1.1 visit selection
; PATCH 1005 change V ED to include comments if multi-line option used
; PATCH 1006 changes to create error message if no visit found
; Patch 1012 for SNOMEd
; Patch 1013 for ICD-10
;IHS/MSC/MGH Patch 1016 added normal/abnormal qualifier
VORD(TARGET) ; returns orders 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
I $G(TARGET)="" Q " "
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)
I VST<1 Q " "
D GETORD(.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 Orders."
Q "~@"_$NA(@TARGET)
;
GETORD(RETURN,VSIT) ;
K RETURN
NEW DAT,DFN,ORLIST,ORD,HDR,HLF,LOC,X,Y,C,NEWORD,OLD,MED
S C=0
S X=$G(^AUPNVSIT(VSIT,0)),DAT=X\1 Q:'DAT
S DFN=$P(X,U,5),LOC=$P(X,U,22)_";SC("
K ^TMP("ORR",$J)
;
I '$L($T(EN^ORQ1)) Q
D EN^ORQ1(DFN_";DPT(",1,2,"",DAT,DAT,1)
Q:'$D(ORLIST)
;
F X=0:0 S X=$O(^TMP("ORR",$J,ORLIST,X)) Q:'X K ORD M ORD=^(X) D
. S C=C+1,OLD=0
. S MED=""
. S Y=$P($G(^OR(100,+ORD,0)),U,10)
. I $L(Y),Y'=LOC Q
. I $P(ORD,U,7)="canc" Q
. F Y=0:0 S Y=$O(ORD("TX",Y)) Q:'Y D
.. I $E(ORD("TX",Y),1)="<" Q
.. ;Change order fix for patch 1012
.. I $E(ORD("TX",Y),1,6)="Change" S ORD("TX",Y)=$E(ORD("TX",Y),8,999)
.. ;I $E(ORD("TX",Y),1,3)="to " Q
.. ;I $E(ORD("TX",Y),1,3)="to " S ORD("TX",Y)=$E(ORD("TX",Y),4,999) ;IHS/ITSC/LJF 12/10/2004 PATCH 1001
.. I $E(ORD("TX",Y),1,3)="to " D
...K RETURN(C)
...S NEWORD=$E(ORD("TX",Y),4,999)
...S RETURN(C)=" "_NEWORD
.. E S RETURN(C)=$G(RETURN(C))_" "_$P(ORD("TX",Y)," Quantity:")
I C=0 S RETURN(1)=""
K ^TMP("ORR",$J)
Q
;
VPOV(TARGET,MULTI) ; returns diagnoses for current vuecentric visit context
; MULTI=0 return one line of diagnosis names; MULTI=1 return 1 line per diagnosis
;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="" 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)
D GETPOV(.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 Diagnoses Found"
Q "~@"_$NA(@TARGET)
;
GETPOV(RETURN,VIEN,MULTI) ;return every diagnosis for current visit
; VISIT=Visit IEN
;
NEW ARRAY,IEN,AIEN,FNUM,STRING,CNT,BTIU,LINE,ASTHMA,PCNT,CODE,PAT,CON,NARR,IEN2,Q,SNO
K RETURN
;
S IEN=0 F S IEN=$O(^AUPNVPOV("AD",VIEN,IEN)) Q:'IEN D
. S ASTHMA=0
. S NARR=$$GET1^DIQ(9000010.07,IEN,.04)
. I $P(NARR,"|",1)["*" S NARR=$P(NARR,"|",2)
. I $P(NARR,"|",2)=" " S NARR=$P(NARR,"|",1)
. I NARR'="" S ARRAY(NARR,IEN)=""
S NARR="",IEN=0
F S NARR=$O(ARRAY(NARR)) Q:NARR="" D
.S IEN=0 S IEN=$O(ARRAY(NARR,IEN)) Q:IEN="" D ;Only get the first one
.. I 'MULTI S RETURN(1)=$G(RETURN(1))_NARR_"; " Q
.. S CNT=$G(CNT)+1,PCNT=$G(PCNT)+1
.. K BTIU D ENP^XBDIQ1(9000010.07,IEN,".01:.29;1102","BTIU(","IE")
.. S LINE=""
.. I (BTIU(.12)="PRIMARY") S LINE=" [P] " ;mark if primary dx
.. S CODE=$G(BTIU(.01))
.. S SNO=$G(BTIU(1102))
.. S ASTHMA=$$CHECK^BGOASLK(CODE,SNO)
.. I +ASTHMA D
... S PAT=BTIU(.02,"I")
... S CON=$$ACONTROL(PAT)
... I CON'="" S LINE=LINE_" Control: "_CON
.. F I=.06,.05,.09,.13,.11,.29 D ;check for other fields
... I (I=.09),BTIU(.09)]"" S LINE=LINE_"; "_$$ECODE(IEN) Q
... I BTIU(I)]"" S LINE=LINE_"; "_BTIU(I)
..S NARR=BTIU(.04)
..I $P(NARR,"|",1)["*" S NARR=$P(NARR,"|",2)
..I $P(NARR,"|",2)=" " S NARR=$P(NARR,"|",1)
..S RETURN(CNT)=$J(PCNT,2)_") "_NARR_LINE
.. ;Return qualifiers
..F X=13,17,18,14 D
...S STRING=""
...S IEN2=0 F S IEN2=$O(^AUPNVPOV(IEN,X,IEN2)) Q:'+IEN2 D
....S Q=""
....S FNUM=$S(X=13:9000010.0713,X=17:9000010.0717,X=18:9000010.0718,X=14:9000010.0714)
....S AIEN=IEN2_","_IEN_","
....S Q=$$GET1^DIQ(FNUM,AIEN,.01)
....S Q=$P($$CONC^BSTSAPI(Q_"^^^1"),U,4)
....S STRING=$S(STRING="":Q,1:STRING_" "_Q)
... I STRING'="" D
....S CNT=CNT+1
....S RETURN(CNT)=" "_STRING
Q
;
ECODE(IEN) ; return narrative for e-code
NEW X,Y,VDT,VIEN
;Patch 1013 changed for ICD-10
S Y=""
S VIEN=$$GET1^DIQ(9000010.07,IEN,.03,"I")
S VDT=$P($$GET1^DIQ(9000010,VIEN,.01,"I"),".",1)
S X=$$GET1^DIQ(9000010.07,IEN,.09,"I") I 'X Q ""
I $$AICD S Y=$P($$ICDDX^ICDEX(IEN,VDT,"","I"),U,4)
E S Y=$$GET1^DIQ(80,X,3)
Q Y
ACONTROL(DFN) ;Find last entry of patient's asthma control
N LEVEL,ADT,IEN,ENTER
S LEVEL=""
I DUZ("AG")'="I" Q LEVEL
S ADT="" S ADT=$O(^AUPNVAST("AAC",DFN,ADT))
I ADT="" Q LEVEL
S IEN="" S IEN=$O(^AUPNVAST("AAC",DFN,ADT,IEN),-1) ;Reverse $O if there is more than one on a given date - p6
I IEN="" Q LEVEL
S LEVEL=$G(^AUPNVAST("AAC",DFN,ADT,IEN))
S LEVEL=$S(LEVEL="W":"WELL CONTROLLED",LEVEL="N":"NOT WELL CONTROLLED",LEVEL="V":"VERY POORLY CONTROLLED",1:"")
S ENTER=$P($G(^AUPNVAST(IEN,12)),U,1),ENTER=$$FMTE^XLFDT($P(ENTER,".",1))
Q LEVEL_"("_ENTER_")"
VPTED(TARGET,MULTI) ; returns patient education topics for current vuecentric visit context
; MULTI=0 return one 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)
D GETPTED(.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 Patient Education Found"
Q "~@"_$NA(@TARGET)
;
GETPTED(RETURN,VIEN,MULTI) ;return every edcuation topic for current visit
; VISIT=Visit IEN
;
NEW IEN,CNT,BTIU,LINE,NUM,TOPIC
K RETURN
;
S IEN=0 F S IEN=$O(^AUPNVPED("AD",VIEN,IEN)) Q:'IEN D
. I 'MULTI S RETURN(1)=$G(RETURN(1))_$$GET1^DIQ(9000010.16,IEN,.01)_"; " Q
. 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
. S CNT=$G(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)
;
VMED(TARGET,SIG) ;EP; returns medications for current vuecentric visit context
; If SIG is set to 1, include medication sig
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="" 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)
I $G(SIG) D GETSIG(.RESULT,VST) I 1
E D GETMED(.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 Medications Found for Visit"
Q "~@"_$NA(@TARGET)
;
GETMED(RETURN,VIEN) ;EP returns all medications given for a visit
NEW TIUX,TIUY,COUNT
K RETURN
S TIUX=0,TIUY="" F S TIUX=$O(^AUPNVMED("AD",VIEN,TIUX)) Q:'TIUX D
. S TIUY=TIUY_$$GET1^DIQ(9000010.14,TIUX,.01)_"; "
S:TIUY]"" TIUY=$$WRAP^TIULS(TIUY,73)
F COUNT=1:1 Q:$P(TIUY,"|",COUNT)="" S RETURN(COUNT)=$P(TIUY,"|",COUNT)
Q
;
GETSIG(RETURN,VIEN) ;EP returns all medications given for a visit plus sig
NEW TIUX,TIUY,TIUCNT
K RETURN
S (TIUCNT,TIUX)=0,TIUY=""
F S TIUX=$O(^AUPNVMED("AD",VIEN,TIUX)) Q:'TIUX D
. NEW BTIU D ENP^XBDIQ1(9000010.14,TIUX,".01;.05:.07","BTIU(")
. ;
. ;IHS/ITSC/LJF PATCH 1002 indent sig and place extra line between meds
. ;S TIUY=BTIU(.01)_" #"_BTIU(.06)_" ("_BTIU(.07)_" days)" D VMSET
. S TIUY=BTIU(.01)_" #"_BTIU(.06)_" ("_BTIU(.07)_" days)" D VMSET(0)
. ;S TIUY=$$SIG(TIUX,BTIU(.05)) D VMSET
. S TIUY=$$SIG(TIUX,BTIU(.05)) D VMSET(4)
. S TIUCNT=TIUCNT+1,RETURN(TIUCNT)="" ;new line
. ;end of PATCH 1002 mods
Q
;
VMSET(SPACES) ; -- set string into wrapped line;IHS/ITSC/LJF 4/22/2005 PATCH 1002 - added parameter
NEW COUNT
S:TIUY]"" TIUY=$$WRAP^TIULS(TIUY,73)
F COUNT=1:1 Q:$P(TIUY,"|",COUNT)="" D
. S TIUCNT=TIUCNT+1
. ;S RETURN(TIUCNT)=$P(TIUY,"|",COUNT)
. S RETURN(TIUCNT)=$$SP(SPACES)_$P(TIUY,"|",COUNT) ;IHS/ITSC/LJF 4/22/2005 PATCH 1002
Q
;
SIG(VMED,SSIG) ;CONSTRUCT THE FULL TEXT FROM THE ENCODED SIG
; VMED=ien in v med file; SSIG=short sig
NEW SIG,PIECE,Y,X
S SIG="" F PIECE=1:1:$L(SSIG," ") S X=$P(SSIG," ",PIECE) I X]"" D
. S Y=$O(^PS(51,"B",X,0)) I Y>0 S X=$P(^PS(51,Y,0),U,2) I $D(^(9)) S Y=$P(SSIG," ",PIECE-1),Y=$E(Y,$L(Y)) S:Y>1 X=$P(^(9),U,1)
. S SIG=SIG_X_" "
Q SIG
;
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)
AICD() ;EP
Q $S($$VERSION^XPDUTL("AICD")="4.0":1,1:0)
BTIULO5 ; IHS/ITSC/LJF - STILL MORE OBJECTS FOR EHR ;27-Apr-2016 12:26;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1001,1002,1004,1005,1006,1009,1012,1013,1016**;NOV 04, 2004;Build 10
+2 ;IHS/ITSC/LJF 12/10/2004 PATCH 1001 V Orders object was not displaying a modified order
+3 ; 04/08/2005 PATCH 1002 Indented display of medication sig
+4 ; PATCH 1004 Changed to EHR 1.1 visit selection
+5 ; PATCH 1005 change V ED to include comments if multi-line option used
+6 ; PATCH 1006 changes to create error message if no visit found
+7 ; Patch 1012 for SNOMEd
+8 ; Patch 1013 for ICD-10
+9 ;IHS/MSC/MGH Patch 1016 added normal/abnormal qualifier
VORD(TARGET) ; returns orders 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
+3 IF $GET(TARGET)=""
QUIT " "
+4 SET CNT=0
+5 SET VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
+6 IF VST=""
SET @TARGET@(1,0)="Invalid visit"
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)="Invalid visit"
QUIT "~@"_$NAME(@TARGET)
+8 IF VST<1
QUIT " "
+9 DO GETORD(.RESULT,VST)
+10 ;
+11 KILL @TARGET
+12 SET I=0
FOR
SET I=$ORDER(RESULT(I))
IF 'I
QUIT
Begin DoDot:1
+13 SET CNT=CNT+1
+14 SET @TARGET@(CNT,0)=RESULT(I)
End DoDot:1
+15 IF 'CNT
SET @TARGET@(1,0)="No Orders."
+16 QUIT "~@"_$NAME(@TARGET)
+17 ;
GETORD(RETURN,VSIT) ;
+1 KILL RETURN
+2 NEW DAT,DFN,ORLIST,ORD,HDR,HLF,LOC,X,Y,C,NEWORD,OLD,MED
+3 SET C=0
+4 SET X=$GET(^AUPNVSIT(VSIT,0))
SET DAT=X\1
IF 'DAT
QUIT
+5 SET DFN=$PIECE(X,U,5)
SET LOC=$PIECE(X,U,22)_";SC("
+6 KILL ^TMP("ORR",$JOB)
+7 ;
+8 IF '$LENGTH($TEXT(EN^ORQ1))
QUIT
+9 DO EN^ORQ1(DFN_";DPT(",1,2,"",DAT,DAT,1)
+10 IF '$DATA(ORLIST)
QUIT
+11 ;
+12 FOR X=0:0
SET X=$ORDER(^TMP("ORR",$JOB,ORLIST,X))
IF 'X
QUIT
KILL ORD
MERGE ORD=^(X)
Begin DoDot:1
+13 SET C=C+1
SET OLD=0
+14 SET MED=""
+15 SET Y=$PIECE($GET(^OR(100,+ORD,0)),U,10)
+16 IF $LENGTH(Y)
IF Y'=LOC
QUIT
+17 IF $PIECE(ORD,U,7)="canc"
QUIT
+18 FOR Y=0:0
SET Y=$ORDER(ORD("TX",Y))
IF 'Y
QUIT
Begin DoDot:2
+19 IF $EXTRACT(ORD("TX",Y),1)="<"
QUIT
+20 ;Change order fix for patch 1012
+21 IF $EXTRACT(ORD("TX",Y),1,6)="Change"
SET ORD("TX",Y)=$EXTRACT(ORD("TX",Y),8,999)
+22 ;I $E(ORD("TX",Y),1,3)="to " Q
+23 ;I $E(ORD("TX",Y),1,3)="to " S ORD("TX",Y)=$E(ORD("TX",Y),4,999) ;IHS/ITSC/LJF 12/10/2004 PATCH 1001
+24 IF $EXTRACT(ORD("TX",Y),1,3)="to "
Begin DoDot:3
+25 KILL RETURN(C)
+26 SET NEWORD=$EXTRACT(ORD("TX",Y),4,999)
+27 SET RETURN(C)=" "_NEWORD
End DoDot:3
+28 IF '$TEST
SET RETURN(C)=$GET(RETURN(C))_" "_$PIECE(ORD("TX",Y)," Quantity:")
End DoDot:2
End DoDot:1
+29 IF C=0
SET RETURN(1)=""
+30 KILL ^TMP("ORR",$JOB)
+31 QUIT
+32 ;
VPOV(TARGET,MULTI) ; returns diagnoses for current vuecentric visit context
+1 ; MULTI=0 return one line of diagnosis names; MULTI=1 return 1 line per diagnosis
+2 ;I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
+3 NEW VST,I,X,CNT,RESULT
+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 DO GETPOV(.RESULT,VST,MULTI)
+8 ;
+9 KILL @TARGET
SET CNT=0
+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 Diagnoses Found"
+14 QUIT "~@"_$NAME(@TARGET)
+15 ;
GETPOV(RETURN,VIEN,MULTI) ;return every diagnosis for current visit
+1 ; VISIT=Visit IEN
+2 ;
+3 NEW ARRAY,IEN,AIEN,FNUM,STRING,CNT,BTIU,LINE,ASTHMA,PCNT,CODE,PAT,CON,NARR,IEN2,Q,SNO
+4 KILL RETURN
+5 ;
+6 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVPOV("AD",VIEN,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+7 SET ASTHMA=0
+8 SET NARR=$$GET1^DIQ(9000010.07,IEN,.04)
+9 IF $PIECE(NARR,"|",1)["*"
SET NARR=$PIECE(NARR,"|",2)
+10 IF $PIECE(NARR,"|",2)=" "
SET NARR=$PIECE(NARR,"|",1)
+11 IF NARR'=""
SET ARRAY(NARR,IEN)=""
End DoDot:1
+12 SET NARR=""
SET IEN=0
+13 FOR
SET NARR=$ORDER(ARRAY(NARR))
IF NARR=""
QUIT
Begin DoDot:1
+14 ;Only get the first one
SET IEN=0
SET IEN=$ORDER(ARRAY(NARR,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+15 IF 'MULTI
SET RETURN(1)=$GET(RETURN(1))_NARR_"; "
QUIT
+16 SET CNT=$GET(CNT)+1
SET PCNT=$GET(PCNT)+1
+17 KILL BTIU
DO ENP^XBDIQ1(9000010.07,IEN,".01:.29;1102","BTIU(","IE")
+18 SET LINE=""
+19 ;mark if primary dx
IF (BTIU(.12)="PRIMARY")
SET LINE=" [P] "
+20 SET CODE=$GET(BTIU(.01))
+21 SET SNO=$GET(BTIU(1102))
+22 SET ASTHMA=$$CHECK^BGOASLK(CODE,SNO)
+23 IF +ASTHMA
Begin DoDot:3
+24 SET PAT=BTIU(.02,"I")
+25 SET CON=$$ACONTROL(PAT)
+26 IF CON'=""
SET LINE=LINE_" Control: "_CON
End DoDot:3
+27 ;check for other fields
FOR I=.06,.05,.09,.13,.11,.29
Begin DoDot:3
+28 IF (I=.09)
IF BTIU(.09)]""
SET LINE=LINE_"; "_$$ECODE(IEN)
QUIT
+29 IF BTIU(I)]""
SET LINE=LINE_"; "_BTIU(I)
End DoDot:3
+30 SET NARR=BTIU(.04)
+31 IF $PIECE(NARR,"|",1)["*"
SET NARR=$PIECE(NARR,"|",2)
+32 IF $PIECE(NARR,"|",2)=" "
SET NARR=$PIECE(NARR,"|",1)
+33 SET RETURN(CNT)=$JUSTIFY(PCNT,2)_") "_NARR_LINE
+34 ;Return qualifiers
+35 FOR X=13,17,18,14
Begin DoDot:3
+36 SET STRING=""
+37 SET IEN2=0
FOR
SET IEN2=$ORDER(^AUPNVPOV(IEN,X,IEN2))
IF '+IEN2
QUIT
Begin DoDot:4
+38 SET Q=""
+39 SET FNUM=$SELECT(X=13:9000010.0713,X=17:9000010.0717,X=18:9000010.0718,X=14:9000010.0714)
+40 SET AIEN=IEN2_","_IEN_","
+41 SET Q=$$GET1^DIQ(FNUM,AIEN,.01)
+42 SET Q=$PIECE($$CONC^BSTSAPI(Q_"^^^1"),U,4)
+43 SET STRING=$SELECT(STRING="":Q,1:STRING_" "_Q)
End DoDot:4
+44 IF STRING'=""
Begin DoDot:4
+45 SET CNT=CNT+1
+46 SET RETURN(CNT)=" "_STRING
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+47 QUIT
+48 ;
ECODE(IEN) ; return narrative for e-code
+1 NEW X,Y,VDT,VIEN
+2 ;Patch 1013 changed for ICD-10
+3 SET Y=""
+4 SET VIEN=$$GET1^DIQ(9000010.07,IEN,.03,"I")
+5 SET VDT=$PIECE($$GET1^DIQ(9000010,VIEN,.01,"I"),".",1)
+6 SET X=$$GET1^DIQ(9000010.07,IEN,.09,"I")
IF 'X
QUIT ""
+7 IF $$AICD
SET Y=$PIECE($$ICDDX^ICDEX(IEN,VDT,"","I"),U,4)
+8 IF '$TEST
SET Y=$$GET1^DIQ(80,X,3)
+9 QUIT Y
ACONTROL(DFN) ;Find last entry of patient's asthma control
+1 NEW LEVEL,ADT,IEN,ENTER
+2 SET LEVEL=""
+3 IF DUZ("AG")'="I"
QUIT LEVEL
+4 SET ADT=""
SET ADT=$ORDER(^AUPNVAST("AAC",DFN,ADT))
+5 IF ADT=""
QUIT LEVEL
+6 ;Reverse $O if there is more than one on a given date - p6
SET IEN=""
SET IEN=$ORDER(^AUPNVAST("AAC",DFN,ADT,IEN),-1)
+7 IF IEN=""
QUIT LEVEL
+8 SET LEVEL=$GET(^AUPNVAST("AAC",DFN,ADT,IEN))
+9 SET LEVEL=$SELECT(LEVEL="W":"WELL CONTROLLED",LEVEL="N":"NOT WELL CONTROLLED",LEVEL="V":"VERY POORLY CONTROLLED",1:"")
+10 SET ENTER=$PIECE($GET(^AUPNVAST(IEN,12)),U,1)
SET ENTER=$$FMTE^XLFDT($PIECE(ENTER,".",1))
+11 QUIT LEVEL_"("_ENTER_")"
VPTED(TARGET,MULTI) ; returns patient education topics for current vuecentric visit context
+1 ; MULTI=0 return one 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 DO GETPTED(.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 Patient Education Found"
+15 QUIT "~@"_$NAME(@TARGET)
+16 ;
GETPTED(RETURN,VIEN,MULTI) ;return every edcuation topic for current visit
+1 ; VISIT=Visit IEN
+2 ;
+3 NEW IEN,CNT,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 IF 'MULTI
SET RETURN(1)=$GET(RETURN(1))_$$GET1^DIQ(9000010.16,IEN,.01)_"; "
QUIT
+8 SET CNT=$GET(CNT)+1
SET NUM=$GET(NUM)+1
+9 KILL BTIU
DO ENP^XBDIQ1(9000010.16,IEN,".01;.05:.08;.11","BTIU(","I")
+10 ;S LINE=" "_$$EDABBRV(BTIU(.01,"I"))_": "_BTIU(.08)_" min.; "
+11 SET TOPIC=$$GET1^DIQ(9000010.16,IEN,.01)
+12 SET LINE=" "_TOPIC_": "_BTIU(.08)_" min.; "
+13 SET LINE=LINE_BTIU(.07)_"; Understanding-"_BTIU(.06)
+14 SET RETURN(CNT)=$JUSTIFY(NUM,2)_LINE
+15 SET CNT=$GET(CNT)+1
+16 SET RETURN(CNT)=" Comment: "_$EXTRACT(BTIU(.11),1,60)
End DoDot:1
+17 QUIT
+18 ;
EDABBRV(X) ; -- returns education topic abbreviation
+1 QUIT $$GET1^DIQ(9999999.09,X,1)
+2 ;
VMED(TARGET,SIG) ;EP; returns medications for current vuecentric visit context
+1 ; If SIG is set to 1, include medication sig
+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 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 IF $GET(SIG)
DO GETSIG(.RESULT,VST)
IF 1
+8 IF '$TEST
DO GETMED(.RESULT,VST)
+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 Medications Found for Visit"
+15 QUIT "~@"_$NAME(@TARGET)
+16 ;
GETMED(RETURN,VIEN) ;EP returns all medications given for a visit
+1 NEW TIUX,TIUY,COUNT
+2 KILL RETURN
+3 SET TIUX=0
SET TIUY=""
FOR
SET TIUX=$ORDER(^AUPNVMED("AD",VIEN,TIUX))
IF 'TIUX
QUIT
Begin DoDot:1
+4 SET TIUY=TIUY_$$GET1^DIQ(9000010.14,TIUX,.01)_"; "
End DoDot:1
+5 IF TIUY]""
SET TIUY=$$WRAP^TIULS(TIUY,73)
+6 FOR COUNT=1:1
IF $PIECE(TIUY,"|",COUNT)=""
QUIT
SET RETURN(COUNT)=$PIECE(TIUY,"|",COUNT)
+7 QUIT
+8 ;
GETSIG(RETURN,VIEN) ;EP returns all medications given for a visit plus sig
+1 NEW TIUX,TIUY,TIUCNT
+2 KILL RETURN
+3 SET (TIUCNT,TIUX)=0
SET TIUY=""
+4 FOR
SET TIUX=$ORDER(^AUPNVMED("AD",VIEN,TIUX))
IF 'TIUX
QUIT
Begin DoDot:1
+5 NEW BTIU
DO ENP^XBDIQ1(9000010.14,TIUX,".01;.05:.07","BTIU(")
+6 ;
+7 ;IHS/ITSC/LJF PATCH 1002 indent sig and place extra line between meds
+8 ;S TIUY=BTIU(.01)_" #"_BTIU(.06)_" ("_BTIU(.07)_" days)" D VMSET
+9 SET TIUY=BTIU(.01)_" #"_BTIU(.06)_" ("_BTIU(.07)_" days)"
DO VMSET(0)
+10 ;S TIUY=$$SIG(TIUX,BTIU(.05)) D VMSET
+11 SET TIUY=$$SIG(TIUX,BTIU(.05))
DO VMSET(4)
+12 ;new line
SET TIUCNT=TIUCNT+1
SET RETURN(TIUCNT)=""
+13 ;end of PATCH 1002 mods
End DoDot:1
+14 QUIT
+15 ;
VMSET(SPACES) ; -- set string into wrapped line;IHS/ITSC/LJF 4/22/2005 PATCH 1002 - added parameter
+1 NEW COUNT
+2 IF TIUY]""
SET TIUY=$$WRAP^TIULS(TIUY,73)
+3 FOR COUNT=1:1
IF $PIECE(TIUY,"|",COUNT)=""
QUIT
Begin DoDot:1
+4 SET TIUCNT=TIUCNT+1
+5 ;S RETURN(TIUCNT)=$P(TIUY,"|",COUNT)
+6 ;IHS/ITSC/LJF 4/22/2005 PATCH 1002
SET RETURN(TIUCNT)=$$SP(SPACES)_$PIECE(TIUY,"|",COUNT)
End DoDot:1
+7 QUIT
+8 ;
SIG(VMED,SSIG) ;CONSTRUCT THE FULL TEXT FROM THE ENCODED SIG
+1 ; VMED=ien in v med file; SSIG=short sig
+2 NEW SIG,PIECE,Y,X
+3 SET SIG=""
FOR PIECE=1:1:$LENGTH(SSIG," ")
SET X=$PIECE(SSIG," ",PIECE)
IF X]""
Begin DoDot:1
+4 SET Y=$ORDER(^PS(51,"B",X,0))
IF Y>0
SET X=$PIECE(^PS(51,Y,0),U,2)
IF $DATA(^(9))
SET Y=$PIECE(SSIG," ",PIECE-1)
SET Y=$EXTRACT(Y,$LENGTH(Y))
IF Y>1
SET X=$PIECE(^(9),U,1)
+5 SET SIG=SIG_X_" "
End DoDot:1
+6 QUIT SIG
+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)
AICD() ;EP
+1 QUIT $SELECT($$VERSION^XPDUTL("AICD")="4.0":1,1:0)
