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

BTIUPCC7.m

Go to the documentation of this file. 
  1. BTIUPCC7 ; IHS/MSC/MGH - IHS PCC PERSONAL HEALTH OBJECTS ;28-Jun-2017 14:15;DU
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**1008,1009,1013,1018**;NOV 04, 2004;Build 4
  1.  ;This routine creates objects for the personal health
  1.  ;data entered
  1.  ;Patch 1018 added ER admission objects
  1.  ;==============================================================
  1. CVD(DFN,TARGET) ;EP
  1.  N ARRAY,CNT,I,J
  1.  S CNT=1
  1.  D PAT^BQITRPHS(DFN,.ARRAY)
  1.  I $P(ARRAY(0),U,1)=1 S @TARGET@(CNT,0)=$P(ARRAY(0),U,2)
  1.  E  S @TARGET@(CNT,0)="Patient does not have an iCare Diagnostic Tag of CVD"
  1.  S I=0 F  S I=$O(ARRAY(I)) Q:I=""  D
  1.  .S CNT=CNT+1 S @TARGET@(CNT,0)=""
  1.  .S J=0 F  S J=$O(ARRAY(I,J)) Q:J=""  D
  1.  ..S CNT=CNT+1
  1.  ..S @TARGET@(CNT,0)=$G(ARRAY(I,J,0))
  1.  Q "~@"_$NA(@TARGET)
  1. LABRES(DFN,TIUTST,TIUCNT) ;EP; -- returns last # of current lab result for single
  1.  ; TIUTST = lab test name;  TIUCNT = # of test results to return
  1.  ;IHS/CIA/MGH Modified to only display the test name and results
  1.  NEW LAB,CAPTION,VDT,DATE,IEN,X,TIU,LINE,CNT,DATA,LGTH,DATE,Y,ARR
  1.  K ^TMP("BTIULOX",$J)
  1.  S LAB=$O(^LAB(60,"B",TIUTST,0)) I LAB="" Q ""
  1.  S CAPTION=$E(TIUTST,1,30)_":"
  1.  S (VDT,CNT)=0,ARR=""
  1.  F  S VDT=$O(^AUPNVLAB("AA",DFN,LAB,VDT)) Q:('VDT)!(CNT=TIUCNT)  D
  1.  . S IEN=0
  1.  . F  S IEN=$O(^AUPNVLAB("AA",DFN,LAB,VDT,IEN)) Q:'IEN!(CNT=TIUCNT)  D
  1.  .. K TIU D ENP^XBDIQ1(9000010.09,IEN,".03:.05;1109;1201","TIU(","I")
  1.  .. Q:TIU(.04)=""                       ;skip if not resulted
  1.  .. S CNT=CNT+1                         ;increment counter
  1.  .. S DATE=$S(TIU(1201,"I")]"":TIU(1201,"I"),1:$$GET1^DIQ(9000010,TIU(.03,"I"),.01,"I"))
  1.  .. S ARR(DATE,IEN)=$J(TIU(.04),8)_" "_TIU(.05),CNT=CNT+1
  1.  S CNT=0,DATE=""
  1.  F  S DATE=$O(ARR(DATE),-1) Q:DATE=""!(CNT>=TIUCNT)  D
  1.  . S IEN="" F  S IEN=$O(ARR(DATE,IEN),-1)  Q:'IEN!(CNT>=TIUCNT)  D
  1.  . . S LINE=$G(ARR(DATE,IEN)),CNT=CNT+1
  1.  . . S Y=$S(CNT=1:CAPTION,1:$$SP($L(CAPTION)))
  1.  . . S ^TMP("BTIULOX",$J,CNT,0)=Y_LINE
  1.  I '$D(^TMP("BTIULOX",$J)) S ^TMP("BTIULOX",$J,1,0)="No Results Found"
  1.  Q "~@^TMP(""BTIULOX"",$J)"
  1. SP(NUM) ; -- SUBRTN to pad spaces
  1.  Q $$PAD(" ",NUM)
  1. PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
  1.  Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
  1. PHISTORY(DFN,TARGET) ;Return personal history data
  1.  N DATA,BTIU,IEN,FNUM,CNT,RESULT,DATE,LINE,NUM,ONSET,ENTRY
  1.  S FNUM=9000013,CNT=0,ENTRY="",ONSET=""
  1.  S IEN=0 F  S IEN=$O(^AUPNPH("AC",DFN,IEN)) Q:'IEN  D
  1.  .S CNT=$G(CNT)+1,NUM=$G(NUM)+1
  1.  .K BTIU D ENP^XBDIQ1(9000013,IEN,".01;.02:.07;","BTIU(","I")
  1.  .S LINE=$J(NUM,2)_") "_$G(BTIU(.04))_" Noted: "_$G(BTIU(.03))
  1.  .I $G(BTIU(.05))'="" S LINE=LINE_" Onset: "_$G(BTIU(.05))
  1.  .S @TARGET@(CNT,0)=LINE
  1.  I CNT=0 S @TARGET@(1,0)="No personal history on file"
  1.  Q "~@"_$NA(@TARGET)
  1. GVISIT(DFN) ;Retrieve VIEN
  1.  ;
  1.  NEW X,VIEN
  1.  ;
  1.  ;Check for CIA
  1.  I $T(GETVAR^CIAVMEVT)="" Q 0
  1.  ;
  1.  ;Get VIEN from context
  1.  S VIEN=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
  1.  ;
  1.  ;Look for invalid visit
  1.  I VIEN="" Q 0
  1.  S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VIEN=+$$VSTR2VIS^BEHOENCX(DFN,VIEN) I VIEN<1 Q 0
  1.  ;
  1.  Q VIEN
  1. GETER(DFN,ADMF,VSTF) ;Return information from either ER VISIT or ER ADMISSION files
  1.  ;
  1.  N RET,AIEN,FNDER,VIEN
  1.  ;
  1.  I $G(DFN)="" Q ""
  1.  ;
  1.  ;Get the visit
  1.  S VIEN=$$GVISIT(DFN) Q:'VIEN "-1^Visit not selected/found"
  1.  ;
  1.  ;Look in ER VISIT file
  1.  S (FNDER,RET)=""
  1.  S AIEN=$O(^AMERVSIT("AD",VIEN,""))
  1.  I AIEN S FNDER=1,RET=$$GET1^DIQ(9009080,AIEN,VSTF,"E")
  1.  ;
  1.  ;If not found look in ER ADMISSION file (VIEN must match)
  1.  I FNDER="",(VIEN'=$$GET1^DIQ(9009081,DFN,1.1,"I"))!('$D(^AMERADM(DFN))) Q "-1^Could not locate ER visit"
  1.  I RET="" S RET=$$GET1^DIQ(9009081,DFN,ADMF,"E")
  1.  Q RET
  1. ERADMIT(DFN,CAP) ;ER ADMIT TIME and ER ADMIT TIME W/CAPTION - Return ER admission time
  1.  N RET,IEN
  1.  S CAP=$G(CAP)
  1.  S RET=$$GETER(DFN,1,.01) I $P(RET,U)=-1 Q $P(RET,U,2)
  1.  I CAP=1 S RET="Arrival Time: "_RET
  1.  Q RET
  1.  ;
  1. WHY(DFN,CAP) ;ER COMPLAINT and ER COMPLAINT W/CAPTION - Return the presenting complaint
  1.  N RET
  1.  S CAP=$G(CAP)
  1.  S RET=$$GETER(DFN,23,1) I $P(RET,U)=-1 Q $P(RET,U,2)
  1.  I CAP=1 S RET="Presenting Complaint: "_RET
  1.  Q RET
  1. NURSE(DFN,CAP) ;ER TRIAGE NURSE and ER TRIAGE NURSE W/CAPTION - Return the Triage Nurse 
  1.  N RET
  1.  S CAP=$G(CAP)
  1.  S RET=$$GETER(DFN,19,.07) I $P(RET,U)=-1 Q $P(RET,U,2)
  1.  I CAP=1 S RET="Triage Nurse: "_RET
  1.  Q RET
  1. ACUITY(DFN,CAP) ;ER INITIAL ACUITY and ER INITIAL ACUITY W/CAPTION - Return the Initial Acuity
  1.  N RET,IEN
  1.  S CAP=$G(CAP)
  1.  S RET=$$GETER(DFN,20,.24) I $P(RET,U)=-1 Q $P(RET,U,2)
  1.  I CAP=1 S RET="Initial Acuity: "_RET
  1.  Q RET
  1. NTIME(DFN,CAP) ;ER TRIAGE NURSE TIME and ER TRIAGE NURSE TIME W/CAPTION - Return the Triage Nurse Time
  1.  N RET,IEN
  1.  S CAP=$G(CAP)
  1.  S RET=$$GETER(DFN,21,12.2) I $P(RET,U)=-1 Q $P(RET,U,2)
  1.  I CAP=1 S RET="Triage Nurse Time: "_RET
  1.  Q RET
  1. ADMIT(DFN,CAP) ;ER ADMIT PROVIDER and ER ADMIT PROV W/CAPTION - Return the Admitting Provider
  1.  N RET,IEN
  1.  S CAP=$G(CAP)
  1.  S RET=$$GETER(DFN,18,.06) I $P(RET,U)=-1 Q $P(RET,U,2)
  1.  I CAP=1 S RET="Provider: "_RET
  1.  Q RET
  1. ATIME(DFN,CAP) ;ER ADMIT PROV TIME and ER ADMIT PROV TIME/CAPTION - Return the Admitting Provider Time
  1.  N RET,IEN
  1.  S CAP=$G(CAP)
  1.  S RET=$$GETER(DFN,22,12.1) I $P(RET,U)=-1 Q $P(RET,U,2)
  1.  I CAP=1 S RET="Provider Time: "_RET
  1.  Q RET