Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BTIULO5

BTIULO5.m

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