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