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

BTIULO3.m

Go to the documentation of this file. 
  1. 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
  1.  ;Added calls for EHR 1.1 visit creation
  1.  ;Patch 1006 - updated error return if visit not found
  1.  ;
  1. VIMM(TARGET) ; returns immunizations given for current vuecentric visit context
  1.  I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
  1.  NEW VST,I,CNT,RESULT,X
  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.  ;S X="CIAVCXEN" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^CIAVCXEN(DFN,VST) I VST<1 Q
  1.  D GETIMM(.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 Immunizations Found"
  1.  Q "~@"_$NA(@TARGET)
  1.  ;
  1. GETIMM(RETURN,VIEN) ;return every immunization for current visit
  1.  ; VISIT=Visit IEN
  1.  ;
  1.  NEW IEN,CNT,SERIES
  1.  K RETURN
  1.  ;
  1.  S IEN=0 F  S IEN=$O(^AUPNVIMM("AD",VIEN,IEN)) Q:'IEN  D
  1.  . S CNT=$G(CNT)+1
  1.  . S SERIES=$$GET1^DIQ(9000010.11,IEN,.04)
  1.  . S RETURN(CNT)=$$GET1^DIQ(9000010.11,IEN,.01)_$S(SERIES]"":" ("_SERIES_")",1:"")
  1.  Q
  1. VLAB(TARGET) ; returns resulted labs for current vuecentric visit context
  1.  I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
  1.  NEW VST,I,X,CNT,RESULT
  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.  ;S X="CIAVCXEN" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^CIAVCXEN(DFN,VST) I VST<1 Q
  1.  D GETLAB(.RESULT,VST)
  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 Lab Results Found"
  1.  Q "~@"_$NA(@TARGET)
  1.  ;
  1. GETLAB(RETURN,VIEN) ;return every resulted lab for current visit
  1.  ; VISIT=Visit IEN
  1.  ;
  1.  NEW IEN,CNT,RESULT
  1.  K RETURN
  1.  ;
  1.  S IEN=0 F  S IEN=$O(^AUPNVLAB("AD",VIEN,IEN)) Q:'IEN  D
  1.  . S CNT=$G(CNT)+1
  1.  . S RESULT=$$GET1^DIQ(9000010.09,IEN,.04) Q:RESULT=""     ;not resulted yet
  1.  . S RETURN(CNT)=$$GET1^DIQ(9000010.09,IEN,.01)_" ("_RESULT_")"
  1.  Q
  1. VSKIN(TARGET) ; returns skin tests for current vuecentric visit context
  1.  I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
  1.  NEW VST,I,X,CNT,RESULT
  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.  ;S X="CIAVCXEN" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^CIAVCXEN(DFN,VST) I VST<1 Q
  1.  D GETSKIN(.RESULT,VST)
  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 Skin Tests Found"
  1.  Q "~@"_$NA(@TARGET)
  1.  ;
  1. GETSKIN(RETURN,VIEN) ;return every skin test for current visit
  1.  ; VISIT=Visit IEN
  1.  ;
  1.  NEW IEN,CNT,BTIU,LINE
  1.  K RETURN
  1.  ;
  1.  S IEN=0 F  S IEN=$O(^AUPNVSK("AD",VIEN,IEN)) Q:'IEN  D
  1.  . S CNT=$G(CNT)+1 D
  1.  .. K BTIU D ENP^XBDIQ1(9000010.12,IEN,".03:.06","BTIU(")
  1.  .. I BTIU(.04)="" S LINE="Placed on "_BTIU(.03) Q
  1.  .. S LINE=$$PAD($J(BTIU(.04),12)_"  "_BTIU(.05),25)
  1.  .. S LINE=LINE_"Date Read: "_BTIU(.06)
  1.  . S RETURN(CNT)=$$PAD($$GET1^DIQ(9000010.12,IEN,.01)_":",12)_LINE
  1.  . Q
  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
  1.  I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variabled" Q "~@"_$NA(@TARGET)
  1.  NEW VST,I,CNT,RESULT,X
  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.  ;S X="CIAVCXEN" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^CIAVCXEN(DFN,VST) I VST<1 Q
  1.  D GETPRC(.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 Procedures Found"
  1.  Q "~@"_$NA(@TARGET)
  1.  ;
  1. GETPRC(RETURN,VIEN,MULTI) ;return every procedure for current visit
  1.  ; VISIT=Visit IEN
  1.  ;
  1.  NEW IEN,CNT,BTIU,LINE
  1.  K RETURN
  1.  ;
  1.  S IEN=0 F  S IEN=$O(^AUPNVPRC("AD",VIEN,IEN)) Q:'IEN  D
  1.  . I 'MULTI S RETURN(1)=$G(RETURN(1))_$$GET1^DIQ(9000010.08,IEN,.04)_"; " Q
  1.  . S CNT=$G(CNT)+1
  1.  . K BTIU D ENP^XBDIQ1(9000010.08,IEN,".06;.11;1204","BTIU(")
  1.  . S LINE=" on "_BTIU(.06)_" by "_$S(BTIU(.11)]"":BTIU(.11),1:BTIU(1204))
  1.  . S RETURN(CNT)=$$GET1^DIQ(9000010.08,IEN,.04)_LINE
  1.  ;
  1.  I 'MULTI,$D(RETURN(1)) S RETURN(1)=$E(RETURN(1),1,$L(RETURN(1))-2)   ;take off last "; "
  1.  Q
  1.  ;
  1. PAD(DATA,LENGTH) ; pad length of data
  1.  Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
  1.  ;
  1. SP(NUM) ; pad spaces
  1.  Q $$PAD(" ",NUM)