BCQMUTL ; IHS/OIT/FBD - MAPPER UTILITIES ;05/07/2018 07:49;FS
;;1.0;IHS CODE MAPPING;;MAY 07, 2018;Build 21
;
TXICU(V) ;EP - IS THIS ADMISSION A TRANSFER TO AN ICU?
I $G(V)="" Q 0
;did this admission tx to a ward that is an ICU
NEW X,Y,Z,D
S D=$O(^DGPM("AVISIT",V,0))
I D="" Q 0 ;no admission data to look at
;check each icu ward and whether the patient transferred into it
S Y=0,X=0
F S X=$O(^DIC(42.1,X)) Q:X'=+X!(Y) D
.S W=$O(^BDGWD("B",X,0))
.I W="" Q
.I $$GET1^DIQ(9009016.5,W,101,"I")'=1 Q ;NOT AN ICU
.I $$FINDWARD($P(^AUPNVSIT(V,0),U,5),D,X,2) S Y=1
Q Y
FINDWARD(DF,ADM,WARD,TT) ;-- find out if the ward is what they are looking for based on data
N WDA,WIEN,TRAN,WD,RES
S RES=0
S WDA=0 F S WDA=$O(^DGPM("APCA",DF,ADM,WDA)) Q:'WDA!($G(RES)) D
. S WIEN=0 F S WIEN=$O(^DGPM("APCA",DF,ADM,WDA,WIEN)) Q:'WIEN!($G(RES)) D
.. S TRAN=$P($G(^DGPM(WIEN,0)),U,2)
.. Q:TRAN'=TT
.. S WD=$$GET1^DIQ(405,WIEN,.06,"I")
.. I WD[WARD S RES=WD Q
Q $G(RES)
;
ICU(V) ;EP - IS THE WARD AN ICU
I $G(V)="" Q 0
NEW D,W
S D=$O(^DGPM("AVISIT",V,0))
I D="" Q 0
S W=$$GET1^DIQ(405,D,.06,"I")
I W="" Q 0
S W=$O(^BDGWD("B",W,0))
I W="" Q 0
S W=$$GET1^DIQ(9009016.5,W,101,"I")
Q W
FACTYPE(V) ;EP - RETURN FACILITY TYPE
Q $$GET1^DIQ(4,V,13)
HOSP(V) ;EP - IS THIS A HOSPITAL FACILITY TYPE?
I $G(V)="" Q 0
I '$D(^AUPNVSIT(V,0)) Q 0
NEW A
S A=$P(^AUPNVSIT(V,0),U,6)
I 'A Q 0
I '$D(^DIC(4,A,0)) Q 0
S A=$$FACTYPE(A)
I A="HOSPITAL" Q 1
Q 0
NURSEVAL(CLIN,PROV,TIU) ;EP - IS THIS A NURSE VISIT?
I 'TIU Q 0 ;no tiu note
I CLIN=45 Q 1
I CLIN=79 Q 1
I CLIN="B4" Q 1
I PROV="01" Q 1
I PROV="05" Q 1
I PROV=13 Q 1
I PROV=14 Q 1
I PROV=32 Q 1
Q 0
;
NHBRL(V) ;EP- IS THERE BOTH RIGHT AND LEFT NEWBORN HEARING?
I '$G(V) Q ""
NEW X,Y,Z,BCQMR,BCQML
S (BCQMR,BCQML)=0
S X=0 F S X=$O(^AUPNVXAM("AD",V,X)) Q:X'=+X D
.I $$GET1^DIQ(9999999.15,$$GET1^DIQ(9000010.13,X,.01,"I"),.02)="39" S BCQMR=1
.I $$GET1^DIQ(9999999.15,$$GET1^DIQ(9000010.13,X,.01,"I"),.02)="38" S BCQML=1
I BCQMR+BCQML=2 Q 1
Q 0
ESTIM(V) ;EP - IS THIS AN ESTIMATE?
;does a ";" piece of V contain qualifier "estimated"
NEW X,Y,Z
S Z=0
F X=1:1 S Y=$P(V,";",X) Q:Y="" I $$UP^XLFSTR(Y)="ESTIMATED" S Z=1
Q Z
H72(V) ;EP - WAS THIS H visit adm date w/in 72 hours of a discharge date
I $G(V)="" Q ""
I '$D(^AUPNVSIT(V,0)) Q ""
I $P(^AUPNVSIT(V,0),U,7)'="H" Q ""
NEW X,Y,Z,A,P,D,G
S P=$P(^AUPNVSIT(V,0),U,5)
S G=0
S A=$$VDTM^APCLV(V) ;get visit/admit date& time
S D=0 F S D=$O(^AUPNVSIT("AAH",P,D)) Q:D="" S X=0 F S X=$O(^AUPNVSIT("AAH",P,D,X)) Q:X=""!(G) D
.Q:X=V ;same visit
.S E=$$DDTM^APCLV(X) ;get disharge date/time
.S Y=$$FMDIFF^XLFDT(A,E,2)
.Q:Y>259200
.Q:Y<0
.S G=1
.Q
Q G
AGEV(V) ;EP - age of patient on this visit
I $G(V)="" Q ""
I '$D(^AUPNVSIT(V,0)) Q "" ;no visit
NEW P,A
S P=$P(^AUPNVSIT(V,0),U,5)
I 'P Q ""
Q $$AGE^AUPNPAT(P,$$VD^APCLV(V))
EKGFINDL() ;PEP - return EKG finding loinc
Q "8601-7"
BCQMUTL ; IHS/OIT/FBD - MAPPER UTILITIES ;05/07/2018 07:49;FS
+1 ;;1.0;IHS CODE MAPPING;;MAY 07, 2018;Build 21
+2 ;
TXICU(V) ;EP - IS THIS ADMISSION A TRANSFER TO AN ICU?
+1 IF $GET(V)=""
QUIT 0
+2 ;did this admission tx to a ward that is an ICU
+3 NEW X,Y,Z,D
+4 SET D=$ORDER(^DGPM("AVISIT",V,0))
+5 ;no admission data to look at
IF D=""
QUIT 0
+6 ;check each icu ward and whether the patient transferred into it
+7 SET Y=0
SET X=0
+8 FOR
SET X=$ORDER(^DIC(42.1,X))
IF X'=+X!(Y)
QUIT
Begin DoDot:1
+9 SET W=$ORDER(^BDGWD("B",X,0))
+10 IF W=""
QUIT
+11 ;NOT AN ICU
IF $$GET1^DIQ(9009016.5,W,101,"I")'=1
QUIT
+12 IF $$FINDWARD($PIECE(^AUPNVSIT(V,0),U,5),D,X,2)
SET Y=1
End DoDot:1
+13 QUIT Y
FINDWARD(DF,ADM,WARD,TT) ;-- find out if the ward is what they are looking for based on data
+1 NEW WDA,WIEN,TRAN,WD,RES
+2 SET RES=0
+3 SET WDA=0
FOR
SET WDA=$ORDER(^DGPM("APCA",DF,ADM,WDA))
IF 'WDA!($GET(RES))
QUIT
Begin DoDot:1
+4 SET WIEN=0
FOR
SET WIEN=$ORDER(^DGPM("APCA",DF,ADM,WDA,WIEN))
IF 'WIEN!($GET(RES))
QUIT
Begin DoDot:2
+5 SET TRAN=$PIECE($GET(^DGPM(WIEN,0)),U,2)
+6 IF TRAN'=TT
QUIT
+7 SET WD=$$GET1^DIQ(405,WIEN,.06,"I")
+8 IF WD[WARD
SET RES=WD
QUIT
End DoDot:2
End DoDot:1
+9 QUIT $GET(RES)
+10 ;
ICU(V) ;EP - IS THE WARD AN ICU
+1 IF $GET(V)=""
QUIT 0
+2 NEW D,W
+3 SET D=$ORDER(^DGPM("AVISIT",V,0))
+4 IF D=""
QUIT 0
+5 SET W=$$GET1^DIQ(405,D,.06,"I")
+6 IF W=""
QUIT 0
+7 SET W=$ORDER(^BDGWD("B",W,0))
+8 IF W=""
QUIT 0
+9 SET W=$$GET1^DIQ(9009016.5,W,101,"I")
+10 QUIT W
FACTYPE(V) ;EP - RETURN FACILITY TYPE
+1 QUIT $$GET1^DIQ(4,V,13)
HOSP(V) ;EP - IS THIS A HOSPITAL FACILITY TYPE?
+1 IF $GET(V)=""
QUIT 0
+2 IF '$DATA(^AUPNVSIT(V,0))
QUIT 0
+3 NEW A
+4 SET A=$PIECE(^AUPNVSIT(V,0),U,6)
+5 IF 'A
QUIT 0
+6 IF '$DATA(^DIC(4,A,0))
QUIT 0
+7 SET A=$$FACTYPE(A)
+8 IF A="HOSPITAL"
QUIT 1
+9 QUIT 0
NURSEVAL(CLIN,PROV,TIU) ;EP - IS THIS A NURSE VISIT?
+1 ;no tiu note
IF 'TIU
QUIT 0
+2 IF CLIN=45
QUIT 1
+3 IF CLIN=79
QUIT 1
+4 IF CLIN="B4"
QUIT 1
+5 IF PROV="01"
QUIT 1
+6 IF PROV="05"
QUIT 1
+7 IF PROV=13
QUIT 1
+8 IF PROV=14
QUIT 1
+9 IF PROV=32
QUIT 1
+10 QUIT 0
+11 ;
NHBRL(V) ;EP- IS THERE BOTH RIGHT AND LEFT NEWBORN HEARING?
+1 IF '$GET(V)
QUIT ""
+2 NEW X,Y,Z,BCQMR,BCQML
+3 SET (BCQMR,BCQML)=0
+4 SET X=0
FOR
SET X=$ORDER(^AUPNVXAM("AD",V,X))
IF X'=+X
QUIT
Begin DoDot:1
+5 IF $$GET1^DIQ(9999999.15,$$GET1^DIQ(9000010.13,X,.01,"I"),.02)="39"
SET BCQMR=1
+6 IF $$GET1^DIQ(9999999.15,$$GET1^DIQ(9000010.13,X,.01,"I"),.02)="38"
SET BCQML=1
End DoDot:1
+7 IF BCQMR+BCQML=2
QUIT 1
+8 QUIT 0
ESTIM(V) ;EP - IS THIS AN ESTIMATE?
+1 ;does a ";" piece of V contain qualifier "estimated"
+2 NEW X,Y,Z
+3 SET Z=0
+4 FOR X=1:1
SET Y=$PIECE(V,";",X)
IF Y=""
QUIT
IF $$UP^XLFSTR(Y)="ESTIMATED"
SET Z=1
+5 QUIT Z
H72(V) ;EP - WAS THIS H visit adm date w/in 72 hours of a discharge date
+1 IF $GET(V)=""
QUIT ""
+2 IF '$DATA(^AUPNVSIT(V,0))
QUIT ""
+3 IF $PIECE(^AUPNVSIT(V,0),U,7)'="H"
QUIT ""
+4 NEW X,Y,Z,A,P,D,G
+5 SET P=$PIECE(^AUPNVSIT(V,0),U,5)
+6 SET G=0
+7 ;get visit/admit date& time
SET A=$$VDTM^APCLV(V)
+8 SET D=0
FOR
SET D=$ORDER(^AUPNVSIT("AAH",P,D))
IF D=""
QUIT
SET X=0
FOR
SET X=$ORDER(^AUPNVSIT("AAH",P,D,X))
IF X=""!(G)
QUIT
Begin DoDot:1
+9 ;same visit
IF X=V
QUIT
+10 ;get disharge date/time
SET E=$$DDTM^APCLV(X)
+11 SET Y=$$FMDIFF^XLFDT(A,E,2)
+12 IF Y>259200
QUIT
+13 IF Y<0
QUIT
+14 SET G=1
+15 QUIT
End DoDot:1
+16 QUIT G
AGEV(V) ;EP - age of patient on this visit
+1 IF $GET(V)=""
QUIT ""
+2 ;no visit
IF '$DATA(^AUPNVSIT(V,0))
QUIT ""
+3 NEW P,A
+4 SET P=$PIECE(^AUPNVSIT(V,0),U,5)
+5 IF 'P
QUIT ""
+6 QUIT $$AGE^AUPNPAT(P,$$VD^APCLV(V))
EKGFINDL() ;PEP - return EKG finding loinc
+1 QUIT "8601-7"
