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

BTIULO6.m

Go to the documentation of this file. 
  1. BTIULO6 ; IHS/ITSC/LJF - INPT DATA OBJECT CALLS ;
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004
  1.  ;
  1.  ; PAT=IEN of patient
  1.  ; ADM=admission ien, also called corresponding admission (CA)
  1.  ;
  1. ADMN(PAT,VST) ;EP; returns admission IEN for H visit sent
  1.  I $$GET1^DIQ(9000010,VST,.07,"I")'="H" Q 0
  1.  Q $O(^DGPM("AVISIT",VST,0))
  1.  ;
  1. INPT1(PAT,DATE) ;EP; returns admit date (external format) if inpt on DATE sent
  1.  NEW ADM,DSCH
  1.  S ADM=$O(^DGPM("ATID1",PAT,9999999-DATE)) I 'ADM Q ""
  1.  S DSCH=$O(^DGPM("APTT3",PAT,9999999-ADM))
  1.  I DSCH]""&(DSCH<DATE) Q ""
  1.  S ADM=9999999.99999999-ADM
  1.  Q $$NUMDATE^BTIUU(ADM,1)
  1.  ;
  1. ADMTXN(VST,PAT) ;EP; -- returns treating specialty node ien for H visit
  1.  NEW DATE,ADM
  1.  S ADM=$$ADMN(PAT,VST) I 'ADM Q 0
  1.  S DATE=+$G(^DGPM(ADM,0)) I 'DATE Q 0
  1.  Q +$O(^DGPM("APTT6",PAT,DATE,0))
  1.  ;
  1. ADMPRV(VST,PAT,TYPE,MODE) ;EP; -- returns provider for admission based on type
  1.  ; TYPE="ADM" for admitting, "ATT" for attending, "REF" for referring
  1.  ; MODE="" for external format or ="I" for internal format
  1.  NEW IEN,FIELD
  1.  I ('VST)!('PAT)!(TYPE="") Q ""
  1.  S ADM=$$ADMN(PAT,VST) I 'ADM Q ""
  1.  S IEN=$$ADMTXN(ADM,PAT) I 'IEN Q ""
  1.  S FIELD=$S(TYPE="ADM":9999999.02,TYPE="REF":9999999.03,1:.19)
  1.  Q $$GET1^DIQ(405,IEN,FIELD,$G(MODE))
  1.  ;
  1. ADMPRVS(VST,PAT,TYPE,MODE) ;EP; -- returns provider's service based on type
  1.  ; TYPE="ADM" for admitting, "ATT" for attending
  1.  ; MODE="" for external format or ="I" for internal format
  1.  Q $$GET1^DIQ(200,+$$ADMPRV(VST,PAT,TYPE,"I"),29,$G(MODE))
  1.  ;
  1. ADMSRV(VST,PAT) ;EP; -- returns admitting service name
  1.  NEW IEN
  1.  I ('VST)!('PAT) Q ""
  1.  S ADM=$$ADMN(PAT,VST) I 'ADM Q ""
  1.  S IEN=$$ADMTXN(ADM,PAT) I 'IEN Q ""
  1.  Q $$GET1^DIQ(405,IEN,.09)
  1.  ;
  1. CURWRD(PAT) ;EP; returns abbreviation of patient's current ward
  1.  I $G(^DPT(PAT,.1))="" Q ""
  1.  NEW X S X=^DPT(PAT,.1),X=$O(^DIC(42,"B",X,0)) I 'X Q ""
  1.  Q $$GET1^DIQ(9009016.5,X,.02)
  1.  ;
  1. CURWRDRM(PAT) ;EP; returns patient's current ward/room-bed
  1.  NEW ANS
  1.  S ANS=$$GET1^DIQ(2,PAT,.101) I ANS="" Q ""
  1.  Q $$CURWRD(PAT)_"("_ANS_")"
  1.  ;
  1. CURPRV(PAT,TYPE) ;EP; returns current attending provider for patient
  1.  ; TYPE="ATT" for attending, "ADM" for admitting and "REF" for referring provider
  1.  I TYPE="ATT" Q $$GET1^DIQ(2,PAT,.1041)
  1.  NEW CA S CA=$G(^DPT(PAT,.105)) I 'CA Q "??"
  1.  Q $$GET1^DIQ(405,CA,$S(TYPE="ADM":9999999.02,1:9999999.03))
  1.  ;
  1. CURSRV(PAT,LENGTH) ;EP; returns current treating specialty for patient
  1.  ; LENGTH=amount of room to fit name, optional
  1.  NEW Y S Y=$$GET1^DIQ(2,PAT,.103)
  1.  I '$G(LENGTH) S LENGTH=20
  1.  Q $E(Y,1,LENGTH)
  1.  ;
  1. CURDX(PAT) ;EP; returns admitting dx for current inpatient
  1.  NEW CA
  1.  S CA=$G(^DPT(PAT,.105)) I 'CA Q "??"
  1.  Q $$GET1^DIQ(405,CA,.1)
  1.  ;
  1. CURLOS(PAT,MODE) ;EP; returns length of stay for current inpatient
  1.  ; MODE=1 means return observation in hours
  1.  NEW CA,SRV
  1.  S CA=$G(^DPT(PAT,.105)) I 'CA Q "??"
  1.  S SRV=$$GET1^DIQ(2,PAT,.103)
  1.  I $G(MODE),SRV["OBSERVATION" Q $$LOSHRS(CA,$$NOW^XLFDT,PAT)_" hrs"
  1.  Q $$GET1^DIQ(405,CA,201)_" days"
  1.  ;
  1. LASTTXN(VST,PAT) ;EP; returns last treating specialty ien for admission
  1.  ; also returns last service as second U piece
  1.  NEW DSC,DATE,SRV,IEN
  1.  I ('VST)!('PAT) Q 0
  1.  S ADM=$$ADMN(PAT,VST) I 'ADM Q 0
  1.  S DSC=$$GET1^DIQ(405,ADM,.17,"I")           ;find discharge if there
  1.  ; start at discharge date or beginning if still inpt
  1.  S DATE=$S(DSC="":0,1:9999999.9999999-$G(^DGPM(DSC,0)))
  1.  ; find date of last treating specialty change
  1.  S DATE=$O(^DGPM("ATS",PAT,ADM,DATE)) I 'DATE Q 0
  1.  ; find treating specialty ien
  1.  S SRV=$O(^DGPM("ATS",PAT,ADM,DATE,0)) I 'SRV Q 0
  1.  ; find treating specialty change ien
  1.  S IEN=$O(^DGPM("ATS",PAT,ADM,DATE,SRV,0)) I 'IEN Q 0
  1.  Q IEN_U_SRV
  1.  ;
  1. LASTSRVN(VST,PAT) ;EP; returns last service name
  1.  I ('VST)!('PAT) Q ""
  1.  NEW X
  1.  S X=$P($$LASTTXN(VST,PAT),U,2) I 'X Q ""
  1.  Q $$GET1^DIQ(45.7,X,.01)
  1.  ;
  1. LASTSRVC(VST,PAT) ;EP; returns last service abbreviation and its code
  1.  I ('VST)!('PAT) Q ""
  1.  NEW X
  1.  S X=$P($$LASTTXN(VST,PAT),U,2) I 'X Q ""
  1.  Q $$GET1^DIQ(45.7,X,99)_" "_$$GET1^DIQ(45.7,X,9999999.01)
  1.  ;
  1. LASTPRV(VST,PAT,MODE) ;EP; returns last attending provider based on type
  1.  ; MODE="" for external format or ="I" for internal format
  1.  NEW LAST
  1.  S LAST=$$LASTTXN(VST,PAT) I 'LAST Q "??"
  1.  Q $$GET1^DIQ(405,+LAST,.19,$G(MODE))
  1.  ;
  1. LASTPRVC(VST,PAT) ;EP; returns IHS ADC code for last attending provider by type
  1.  Q $$GET1^DIQ(200,+$$LASTPRV(VST,PAT,"I"),9999999.09)
  1.  ;
  1. LASTPRVS(VST,PAT,MODE) ;EP; returns last attending provider's service
  1.  ; MODE="" for external format or ="I" for internal format
  1.  Q $$GET1^DIQ(200,+$$LASTPRV(VST,PAT,"I"),29,$G(MODE))
  1.  ;
  1. PRIORTXN(DATE,CA,PAT) ;EP; returns treating specialty ien prior to date sent
  1.  ; assumes date includes time
  1.  NEW LAST,FOUND
  1.  I ('DATE)!('PAT) Q 0
  1.  ;
  1.  ; if date=admit date, use admit service ien
  1.  I DATE=+$G(^DGPM(CA,0)) Q +$O(^DGPM("APTT6",PAT,DATE,0))
  1.  ;
  1.  ; find last service change (not provider change only)
  1.  S LAST=DATE,FOUND=0
  1.  F  S LAST=$O(^DGPM("APTT6",PAT,LAST),-1) Q:'LAST  Q:FOUND  D
  1.  . S N=$O(^DGPM("APTT6",PAT,LAST,0)) Q:'N
  1.  . I $P($G(^DGPM(N,0)),U,9)]"" S FOUND=LAST   ;has service
  1.  ;
  1.  I 'FOUND Q $$ADMTXN(CA,PAT)             ;return admit service
  1.  Q +$O(^DGPM("APTT6",PAT,FOUND,0))
  1.  ;
  1. PRIORMVT(DATE,CA,PAT) ;EP; returns last physical movement before DATE
  1.  NEW LAST
  1.  I ('DATE)!('CA)!('PAT) Q 0
  1.  S LAST=$O(^DGPM("APCA",PAT,CA,DATE),-1) I 'LAST Q CA
  1.  Q +$O(^DGPM("APCA",PAT,CA,LAST,0))
  1.  ;
  1. LOSHRS(VST,DATE,PAT) ;EP; returns length of stay in hours
  1.  NEW ADM
  1.  S ADM=$$ADMN(PAT,VST) I 'ADM Q ""
  1.  Q $J($$FMDIFF^XLFDT(DATE,+$G(^DGPM(ADM,0)),2)/3600,0,0)
  1.  ;
  1. LASTADM(PAT) ; Returns ien for patient's most recent admission
  1.  NEW Y
  1.  S Y=$O(^DGPM("ATID1",PAT,0)) I 'Y Q 0
  1.  Q +$O(^DGPM("ATID1",PAT,Y,0))
  1.  ;