BGPMUUT3 ; IHS/MSC/MGH - Meaningful use utility calls ;02-Mar-2011 10:38;DU
;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
;
VSTPOV(DFN,VIEN,TAX) ;EP Check to see if the patient had an ICD on a particular visit
N TIEN,X,G,ICD,ICDT,EVDT
S G=0
I '$G(DFN) Q 0
I $G(TAX)="" Q 0
I $G(VIEN)="" Q 0
S TIEN="" S TIEN=$O(^ATXAX("B",TAX,TIEN)) I 'TIEN Q 0
I '$D(^AUPNVSIT(VIEN,0)) Q 0
I '$D(^AUPNVPOV("AD",VIEN)) Q 0
S X=0 F S X=$O(^AUPNVPOV("AD",VIEN,X)) Q:X'=+X!(G) D
.I $$ICD^ATXCHK($P(^AUPNVPOV(X,0),U),TIEN,9) S G=X
.Q
I 'G Q 0
I G D
.S ICD=$P($G(^AUPNVPOV(G,0)),U,1),ICDT=$P($G(^ICD9(ICD,0)),U,1)
.S EVDT=$P($G(^AUPNVPOV(G,12)),U,1)
.S G=1_U_ICDT_U_EVDT
Q $S(G:G,1:0)
VSTICD0(DFN,VIEN,TAX) ;EP Check to see if the patient had an ICD on a particular visit
N TIEN,X,G,ICD,ICDT,EVDT
S G=0
I '$G(DFN) Q 0
I $G(TAX)="" Q 0
I $G(VIEN)="" Q 0
S TIEN="" S TIEN=$O(^ATXAX("B",TAX,TIEN)) I 'TIEN Q 0
I '$D(^AUPNVSIT(VIEN,0)) Q 0
I '$D(^AUPNVPRC("AD",VIEN)) Q 0
S X=0 F S X=$O(^AUPNVPRC("AD",VIEN,X)) Q:X'=+X!(G) D
.I $$ICD^ATXCHK($P(^AUPNVPRC(X,0),U),TIEN,0) S G=X
.Q
I 'G Q 0
I G D
.S EVDT=$P($G(^AUPNVPRC(G,12)),U,1)
.S ICD=$P($G(^AUPNVPRC(G,0)),U,1),ICDT=$P($G(^ICD0(ICD,0)),U,1)
.S G=1_U_ICDT_U_EVDT_U_G
Q $S(G:G,1:0)
VSTPOVA(DFN,VIEN,TAX) ;EP Check to see if the patient had an ICD on a particular visit
; ALSO checks that the PRIMARY/SECONDARY flag is active
; AND that the MODIFIER field is NOT C,D,M,O,P, or S
N TIEN,X,G,ICD,ICDT,EVDT,PSFLG,INPT
S PSFLG=""
S G=0
I '$G(DFN) Q 0
I $G(TAX)="" Q 0
I $G(VIEN)="" Q 0
S TIEN="" S TIEN=$O(^ATXAX("B",TAX,TIEN)) I 'TIEN Q 0
I '$D(^AUPNVSIT(VIEN,0)) Q 0
I '$D(^AUPNVPOV("AD",VIEN)) Q 0
S X=0 F S X=$O(^AUPNVPOV("AD",VIEN,X)) Q:X'=+X!(G) D
.I $$ICD^ATXCHK($P(^AUPNVPOV(X,0),U),TIEN,9) S G=X
.Q
I 'G Q 0
I G D
.S ICD=$P($G(^AUPNVPOV(G,0)),U,1),ICDT=$P($G(^ICD9(ICD,0)),U,1)
.S EVDT=$P($G(^AUPNVPOV(G,12)),U,1)
.S INPT=$P($G(^AUPNVPOV(G,0)),U,0)
.S PSFLG=$$GET1^DIQ(9000010.07,G_",",.12,"I")
.S MODFLG=$$GET1^DIQ(9000010.07,G_",",.06,"I")
.S G=0
.I (PSFLG="P")&(MODFLG=""!("CDMOPS"'[MODFLG)) S G=1_U_ICDT_U_EVDT_U_INPT
Q $S(G:G,1:0)
VSTPOVB(DFN,VIEN,TAX) ;EP Check to see if the patient had an ICD on a particular visit
; ALSO checks that the MODIFIER field is NOT C,D,M,O,P, or S
N TIEN,X,G,ICD,ICDT,EVDT,INPT
S PSFLG="",INPT=""
S G=0
I '$G(DFN) Q 0
I $G(TAX)="" Q 0
I $G(VIEN)="" Q 0
S TIEN="" S TIEN=$O(^ATXAX("B",TAX,TIEN)) I 'TIEN Q 0
I '$D(^AUPNVSIT(VIEN,0)) Q 0
I '$D(^AUPNVPOV("AD",VIEN)) Q 0
S X=0 F S X=$O(^AUPNVPOV("AD",VIEN,X)) Q:X'=+X!(G) D
.I $$ICD^ATXCHK($P(^AUPNVPOV(X,0),U),TIEN,9) S G=X
.Q
I 'G Q 0
I G D
.S ICD=$P($G(^AUPNVPOV(G,0)),U,1),ICDT=$P($G(^ICD9(ICD,0)),U,1)
.S EVDT=$P($G(^AUPNVPOV(G,12)),U,1)
.S DONSET=$P($G(^AUPNVPOV(G,0)),U,17)
.;if onset date is available use that over entry date
.I +DONSET S EVDT=DONSET
.S INPT=$P($G(^AUPNVPV(G,0)),U,22)
.S MODFLG=$$GET1^DIQ(9000010.07,G_",",.06,"I")
.S G=0
.I MODFLG=""!("CDMOPS"'[MODFLG) S G=1_U_ICDT_U_EVDT_U_INPT
Q $S(G:G,1:0)
MEDTAX(DFN,NDC,TAX) ;EP Check to see if the NDC code is in a taxonomy
N TIEN,X,G,ICD,ICDT,ATXBEG,ATXFLG,ATXEND,ATXEND
S G=0,ATXFLG=0
I '$G(DFN) Q 0
I $G(TAX)="" Q 0
I $G(NDC)="" Q 0
S TIEN="" S TIEN=$O(^ATXAX("B",TAX,TIEN)) I 'TIEN Q 0
S ATXBEG=0
;F S ATXBEG=$O(^ATXAX(TIEN,21,"AA",ATXBEG)) Q:ATXBEG=""!(ATXFLG=1) D
;.S ATXEND=$O(^ATXAX(TIEN,21,"AA",ATXBEG,0)) Q:ATXEND=""
;.Q:NDC<ATXBEG
;.I NDC'>ATXEND S ATXFLG=1 ;found code in taxonomy
S ATXEND="" S ATXEND=$O(^ATXAX(TIEN,21,"B",NDC,ATXEND))
I +ATXEND S G=1_U_NDC
Q $S(G:G,1:0)
COMFORT(DFN,VIEN,TAX,ADMIT,CMF) ;EP Check to see if the patient had this code in the first 24hrs of admisssion
; CMF = check modifier flag
N TIEN,X,G,ICD,ICDT,ENT,FIRST
S G=0
I '$G(DFN) Q 0
I $G(TAX)="" Q 0
I $G(VIEN)="" Q 0
S TIEN="" S TIEN=$O(^ATXAX("B",TAX,TIEN)) I 'TIEN Q 0
I '$D(^AUPNVSIT(VIEN,0)) Q 0
I '$D(^AUPNVPOV("AD",VIEN)) Q 0
S X=0 F S X=$O(^AUPNVPOV("AD",VIEN,X)) Q:'+X!(G) D
.S ENT=$P($G(^AUPNVPOV(X,12)),U,1)
.I +ENT D
..S FIRST=$$FMADD^XLFDT(ADMIT,+1)
..I $P(ENT,".",1)=$P(ADMIT,".",1)!($P(ENT,".",1)=$P(FIRST,".",1)) D
...I $$ICD^ATXCHK($P(^AUPNVPOV(X,0),U),TIEN,9) S G=X
I 'G Q 0
I G&$G(CMF) D
.S ICD=$P($G(^AUPNVPOV(G,0)),U,1),ICDT=$P($G(^ICD9(+ICD,0)),U,1)
.S EVDT=$P($G(^AUPNVPOV(G,12)),U,1)
.S MODFLG=$$GET1^DIQ(9000010.07,G_",",.06,"I")
.S G=0
.I MODFLG=""!("CDMOPS"'[MODFLG) S G=1_U_ICDT_U_EVDT
I G&'$G(CMF) D
.S ICD=$P($G(^AUPNVPOV(G,0)),U,1),ICDT=$P($G(^ICD9(+ICD,0)),U,1)
.S G=1_U_ICDT
Q $S(G:G,1:0)
PLSTART(DFN,TAX,STAT,ADMIT) ;EP - is DX on problem list on day of admission or following day
;Input variables
;STAT - A for all problems, C for active problems, I for inactive
;DFN=IEN of the patient
;TAX=Name of the taxonomy
I $G(DFN)="" Q 0
I $G(TAX)="" Q 0
I $G(STAT)="" S STAT="A"
N TIEN,PLSTAT,EDT,FIRST
S TIEN=$O(^ATXAX("B",TAX,0))
I 'TIEN Q 0
N PROB,ICE,I,Y
S (PROB,ICD,I)=0
F S PROB=$O(^AUPNPROB("AC",DFN,PROB)) Q:PROB'=+PROB!(+I) D
.I $D(^AUPNPROB(PROB,0)) S ICD=$P($G(^AUPNPROB(PROB,0)),U),PLSTAT=$P($G(^AUPNPROB(PROB,0)),U,12)
.S EDT=$P($G(^AUPNPROB(PROB,0)),U,8)
.I +EDT D
..S FIRST=$$FMADD^XLFDT(ADMIT,+1)
..I $P(EDT,".",1)=$P(ADMIT,".",1)!($P(EDT,".",1)=$P(FIRST,".",1)) D
...I $$ICD^ATXCHK(ICD,TIEN,9) D
....I STAT="A" S Y=$$GET1^DIQ(80,ICD,.01) S I=1_U_Y
....I (STAT="C")&(PLSTAT="A") S Y=$$GET1^DIQ(80,ICD,.01) S I=1_U_Y
....I (STAT="I")&(PLSTAT="I") S Y=$$GET1^DIQ(80,ICD,.01) S I=1_U_Y
Q I
PALCPT(DFN,VIEN,TAX,ADMIT) ;EP - return ien of CPT entry if patient had this CPT in the first 24hrs after admission
N TIEN,G,CPTT,CPT,FIRST,ENT
I '$G(DFN) Q 0
I $G(TAX)="" Q 0
I $G(VIEN)="" Q 0
I $G(ADMIT)="" Q 0
S G=0
S TIEN="" S TIEN=$O(^ATXAX("B",TAX,TIEN)) Q:'TIEN 0
I '$D(^AUPNVSIT(VIEN,0)) Q 0
I '$D(^AUPNVCPT("AD",VIEN)) Q 0
S X=0 F S X=$O(^AUPNVCPT("AD",VIEN,X)) Q:'+X!(G) D
.S ENT=$P($G(^AUPNVCPT(X,12)),U,1)
.I +ENT D
..S FIRST=$$FMADD^XLFDT(ADMIT,+1)
..I $P(ENT,".",1)=$P(ADMIT,".",1)!($P(ENT,".",1)=$P(FIRST,".",1)) D
...I $$ICD^ATXCHK($P(^AUPNVCPT(X,0),U),TIEN,1) S G=X
I 'G Q 0
I G D
.S CPT=$P($G(^AUPNVCPT(G,0)),U,1),CPTT=$P($G(^ICPT(CPT,0)),U,1)
.S G=1_U_CPTT
Q $S(G:G,1:0)
PALICD0(DFN,VIEN,TAX,ADMIT) ;EP Check to see if the patient had an ICD0 in the first 24hrs after admission
N TIEN,X,G,ICD,ICDT,ENT,FIRST
S G=0
I '$G(DFN) Q 0
I $G(TAX)="" Q 0
I $G(VIEN)="" Q 0
S TIEN="" S TIEN=$O(^ATXAX("B",TAX,TIEN)) I 'TIEN Q 0
I '$D(^AUPNVSIT(VIEN,0)) Q 0
I '$D(^AUPNVPRC("AD",VIEN)) Q 0
S X=0 F S X=$O(^AUPNVPRC("AD",VIEN,X)) Q:X'=+X!(G) D
.S ENT=$P($G(^AUPNVCPT(X,12)),U,1)
.I +ENT D
..S FIRST=$$FMADD^XLFDT(ADMIT,+1)
..I $P(ENT,".",1)=$P(ADMIT,".",1)!($P(ENT,".",1)=$P(FIRST,".",1)) D
...I $$ICD^ATXCHK($P(^AUPNVPRC(X,0),U),TIEN,0) S G=X
I 'G Q 0
I G D
.S ICD=$P($G(^AUPNVPRC(G,0)),U,1),ICDT=$P($G(^ICD0(ICD,0)),U,1)
.S G=1_U_ICDT
Q $S(G:G,1:0)
DTECPT(DFN,VIEN,TAX,ADMIT,ENDDT) ;EP - return ien of CPT entry if patient had this CPT entered in the time frame
N TIEN,ED,BD,G,CPTT,CPT
I '$G(DFN) Q 0
I $G(TAX)="" Q 0
I $G(VIEN)="" Q 0
I $G(ADMIT)="" Q 0
S G=0
S TIEN="" S TIEN=$O(^ATXAX("B",TAX,TIEN)) Q:'TIEN 0
I '$D(^AUPNVSIT(VIEN,0)) Q 0
I '$D(^AUPNVCPT("AD",VIEN)) Q 0
S X=0 F S X=$O(^AUPNVCPT("AD",VIEN,X)) Q:'+X!(G) D
.S ENT=$P($G(^AUPNVCPT(X,12)),U,1)
.I +ENT D
..I (ENT>ADMIT)&(ENT<ENDDT) D
...I $$ICD^ATXCHK($P(^AUPNVCPT(X,0),U),TIEN,1) S G=X
I 'G Q 0
I G D
.S CPT=$P($G(^AUPNVCPT(G,0)),U,1),CPTT=$P($G(^ICPT(CPT,0)),U,1)
.S G=1_U_CPTT
Q $S(G:G,1:0)
DTEICD0(DFN,VIEN,TAX,ADMIT,ENDDT) ;EP Check to see if the patient had an ICD0 stored in the dates selected
N TIEN,X,G,ICD,ICDT,ENT,FIRST
S G=0
I '$G(DFN) Q 0
I $G(TAX)="" Q 0
I $G(VIEN)="" Q 0
S TIEN="" S TIEN=$O(^ATXAX("B",TAX,TIEN)) I 'TIEN Q 0
I '$D(^AUPNVSIT(VIEN,0)) Q 0
I '$D(^AUPNVPRC("AD",VIEN)) Q 0
S X=0 F S X=$O(^AUPNVPRC("AD",VIEN,X)) Q:X'=+X!(G) D
.S ENT=$P($G(^AUPNVCPT(X,12)),U,1)
.I +ENT D
..I (ENT>ADMIT)&(ENT<ENDDT) D
...I $$ICD^ATXCHK($P(^AUPNVPRC(X,0),U),TIEN,0) S G=X
I 'G Q 0
I G D
.S ICD=$P($G(^AUPNVPRC(G,0)),U,1),ICDT=$P($G(^ICD0(ICD,0)),U,1)
.S G=1_U_ICDT
Q $S(G:G,1:0)
BGPMUUT3 ; IHS/MSC/MGH - Meaningful use utility calls ;02-Mar-2011 10:38;DU
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
+2 ;
VSTPOV(DFN,VIEN,TAX) ;EP Check to see if the patient had an ICD on a particular visit
+1 NEW TIEN,X,G,ICD,ICDT,EVDT
+2 SET G=0
+3 IF '$GET(DFN)
QUIT 0
+4 IF $GET(TAX)=""
QUIT 0
+5 IF $GET(VIEN)=""
QUIT 0
+6 SET TIEN=""
SET TIEN=$ORDER(^ATXAX("B",TAX,TIEN))
IF 'TIEN
QUIT 0
+7 IF '$DATA(^AUPNVSIT(VIEN,0))
QUIT 0
+8 IF '$DATA(^AUPNVPOV("AD",VIEN))
QUIT 0
+9 SET X=0
FOR
SET X=$ORDER(^AUPNVPOV("AD",VIEN,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+10 IF $$ICD^ATXCHK($PIECE(^AUPNVPOV(X,0),U),TIEN,9)
SET G=X
+11 QUIT
End DoDot:1
+12 IF 'G
QUIT 0
+13 IF G
Begin DoDot:1
+14 SET ICD=$PIECE($GET(^AUPNVPOV(G,0)),U,1)
SET ICDT=$PIECE($GET(^ICD9(ICD,0)),U,1)
+15 SET EVDT=$PIECE($GET(^AUPNVPOV(G,12)),U,1)
+16 SET G=1_U_ICDT_U_EVDT
End DoDot:1
+17 QUIT $SELECT(G:G,1:0)
VSTICD0(DFN,VIEN,TAX) ;EP Check to see if the patient had an ICD on a particular visit
+1 NEW TIEN,X,G,ICD,ICDT,EVDT
+2 SET G=0
+3 IF '$GET(DFN)
QUIT 0
+4 IF $GET(TAX)=""
QUIT 0
+5 IF $GET(VIEN)=""
QUIT 0
+6 SET TIEN=""
SET TIEN=$ORDER(^ATXAX("B",TAX,TIEN))
IF 'TIEN
QUIT 0
+7 IF '$DATA(^AUPNVSIT(VIEN,0))
QUIT 0
+8 IF '$DATA(^AUPNVPRC("AD",VIEN))
QUIT 0
+9 SET X=0
FOR
SET X=$ORDER(^AUPNVPRC("AD",VIEN,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+10 IF $$ICD^ATXCHK($PIECE(^AUPNVPRC(X,0),U),TIEN,0)
SET G=X
+11 QUIT
End DoDot:1
+12 IF 'G
QUIT 0
+13 IF G
Begin DoDot:1
+14 SET EVDT=$PIECE($GET(^AUPNVPRC(G,12)),U,1)
+15 SET ICD=$PIECE($GET(^AUPNVPRC(G,0)),U,1)
SET ICDT=$PIECE($GET(^ICD0(ICD,0)),U,1)
+16 SET G=1_U_ICDT_U_EVDT_U_G
End DoDot:1
+17 QUIT $SELECT(G:G,1:0)
VSTPOVA(DFN,VIEN,TAX) ;EP Check to see if the patient had an ICD on a particular visit
+1 ; ALSO checks that the PRIMARY/SECONDARY flag is active
+2 ; AND that the MODIFIER field is NOT C,D,M,O,P, or S
+3 NEW TIEN,X,G,ICD,ICDT,EVDT,PSFLG,INPT
+4 SET PSFLG=""
+5 SET G=0
+6 IF '$GET(DFN)
QUIT 0
+7 IF $GET(TAX)=""
QUIT 0
+8 IF $GET(VIEN)=""
QUIT 0
+9 SET TIEN=""
SET TIEN=$ORDER(^ATXAX("B",TAX,TIEN))
IF 'TIEN
QUIT 0
+10 IF '$DATA(^AUPNVSIT(VIEN,0))
QUIT 0
+11 IF '$DATA(^AUPNVPOV("AD",VIEN))
QUIT 0
+12 SET X=0
FOR
SET X=$ORDER(^AUPNVPOV("AD",VIEN,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+13 IF $$ICD^ATXCHK($PIECE(^AUPNVPOV(X,0),U),TIEN,9)
SET G=X
+14 QUIT
End DoDot:1
+15 IF 'G
QUIT 0
+16 IF G
Begin DoDot:1
+17 SET ICD=$PIECE($GET(^AUPNVPOV(G,0)),U,1)
SET ICDT=$PIECE($GET(^ICD9(ICD,0)),U,1)
+18 SET EVDT=$PIECE($GET(^AUPNVPOV(G,12)),U,1)
+19 SET INPT=$PIECE($GET(^AUPNVPOV(G,0)),U,0)
+20 SET PSFLG=$$GET1^DIQ(9000010.07,G_",",.12,"I")
+21 SET MODFLG=$$GET1^DIQ(9000010.07,G_",",.06,"I")
+22 SET G=0
+23 IF (PSFLG="P")&(MODFLG=""!("CDMOPS"'[MODFLG))
SET G=1_U_ICDT_U_EVDT_U_INPT
End DoDot:1
+24 QUIT $SELECT(G:G,1:0)
VSTPOVB(DFN,VIEN,TAX) ;EP Check to see if the patient had an ICD on a particular visit
+1 ; ALSO checks that the MODIFIER field is NOT C,D,M,O,P, or S
+2 NEW TIEN,X,G,ICD,ICDT,EVDT,INPT
+3 SET PSFLG=""
SET INPT=""
+4 SET G=0
+5 IF '$GET(DFN)
QUIT 0
+6 IF $GET(TAX)=""
QUIT 0
+7 IF $GET(VIEN)=""
QUIT 0
+8 SET TIEN=""
SET TIEN=$ORDER(^ATXAX("B",TAX,TIEN))
IF 'TIEN
QUIT 0
+9 IF '$DATA(^AUPNVSIT(VIEN,0))
QUIT 0
+10 IF '$DATA(^AUPNVPOV("AD",VIEN))
QUIT 0
+11 SET X=0
FOR
SET X=$ORDER(^AUPNVPOV("AD",VIEN,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+12 IF $$ICD^ATXCHK($PIECE(^AUPNVPOV(X,0),U),TIEN,9)
SET G=X
+13 QUIT
End DoDot:1
+14 IF 'G
QUIT 0
+15 IF G
Begin DoDot:1
+16 SET ICD=$PIECE($GET(^AUPNVPOV(G,0)),U,1)
SET ICDT=$PIECE($GET(^ICD9(ICD,0)),U,1)
+17 SET EVDT=$PIECE($GET(^AUPNVPOV(G,12)),U,1)
+18 SET DONSET=$PIECE($GET(^AUPNVPOV(G,0)),U,17)
+19 ;if onset date is available use that over entry date
+20 IF +DONSET
SET EVDT=DONSET
+21 SET INPT=$PIECE($GET(^AUPNVPV(G,0)),U,22)
+22 SET MODFLG=$$GET1^DIQ(9000010.07,G_",",.06,"I")
+23 SET G=0
+24 IF MODFLG=""!("CDMOPS"'[MODFLG)
SET G=1_U_ICDT_U_EVDT_U_INPT
End DoDot:1
+25 QUIT $SELECT(G:G,1:0)
MEDTAX(DFN,NDC,TAX) ;EP Check to see if the NDC code is in a taxonomy
+1 NEW TIEN,X,G,ICD,ICDT,ATXBEG,ATXFLG,ATXEND,ATXEND
+2 SET G=0
SET ATXFLG=0
+3 IF '$GET(DFN)
QUIT 0
+4 IF $GET(TAX)=""
QUIT 0
+5 IF $GET(NDC)=""
QUIT 0
+6 SET TIEN=""
SET TIEN=$ORDER(^ATXAX("B",TAX,TIEN))
IF 'TIEN
QUIT 0
+7 SET ATXBEG=0
+8 ;F S ATXBEG=$O(^ATXAX(TIEN,21,"AA",ATXBEG)) Q:ATXBEG=""!(ATXFLG=1) D
+9 ;.S ATXEND=$O(^ATXAX(TIEN,21,"AA",ATXBEG,0)) Q:ATXEND=""
+10 ;.Q:NDC<ATXBEG
+11 ;.I NDC'>ATXEND S ATXFLG=1 ;found code in taxonomy
+12 SET ATXEND=""
SET ATXEND=$ORDER(^ATXAX(TIEN,21,"B",NDC,ATXEND))
+13 IF +ATXEND
SET G=1_U_NDC
+14 QUIT $SELECT(G:G,1:0)
COMFORT(DFN,VIEN,TAX,ADMIT,CMF) ;EP Check to see if the patient had this code in the first 24hrs of admisssion
+1 ; CMF = check modifier flag
+2 NEW TIEN,X,G,ICD,ICDT,ENT,FIRST
+3 SET G=0
+4 IF '$GET(DFN)
QUIT 0
+5 IF $GET(TAX)=""
QUIT 0
+6 IF $GET(VIEN)=""
QUIT 0
+7 SET TIEN=""
SET TIEN=$ORDER(^ATXAX("B",TAX,TIEN))
IF 'TIEN
QUIT 0
+8 IF '$DATA(^AUPNVSIT(VIEN,0))
QUIT 0
+9 IF '$DATA(^AUPNVPOV("AD",VIEN))
QUIT 0
+10 SET X=0
FOR
SET X=$ORDER(^AUPNVPOV("AD",VIEN,X))
IF '+X!(G)
QUIT
Begin DoDot:1
+11 SET ENT=$PIECE($GET(^AUPNVPOV(X,12)),U,1)
+12 IF +ENT
Begin DoDot:2
+13 SET FIRST=$$FMADD^XLFDT(ADMIT,+1)
+14 IF $PIECE(ENT,".",1)=$PIECE(ADMIT,".",1)!($PIECE(ENT,".",1)=$PIECE(FIRST,".",1))
Begin DoDot:3
+15 IF $$ICD^ATXCHK($PIECE(^AUPNVPOV(X,0),U),TIEN,9)
SET G=X
End DoDot:3
End DoDot:2
End DoDot:1
+16 IF 'G
QUIT 0
+17 IF G&$GET(CMF)
Begin DoDot:1
+18 SET ICD=$PIECE($GET(^AUPNVPOV(G,0)),U,1)
SET ICDT=$PIECE($GET(^ICD9(+ICD,0)),U,1)
+19 SET EVDT=$PIECE($GET(^AUPNVPOV(G,12)),U,1)
+20 SET MODFLG=$$GET1^DIQ(9000010.07,G_",",.06,"I")
+21 SET G=0
+22 IF MODFLG=""!("CDMOPS"'[MODFLG)
SET G=1_U_ICDT_U_EVDT
End DoDot:1
+23 IF G&'$GET(CMF)
Begin DoDot:1
+24 SET ICD=$PIECE($GET(^AUPNVPOV(G,0)),U,1)
SET ICDT=$PIECE($GET(^ICD9(+ICD,0)),U,1)
+25 SET G=1_U_ICDT
End DoDot:1
+26 QUIT $SELECT(G:G,1:0)
PLSTART(DFN,TAX,STAT,ADMIT) ;EP - is DX on problem list on day of admission or following day
+1 ;Input variables
+2 ;STAT - A for all problems, C for active problems, I for inactive
+3 ;DFN=IEN of the patient
+4 ;TAX=Name of the taxonomy
+5 IF $GET(DFN)=""
QUIT 0
+6 IF $GET(TAX)=""
QUIT 0
+7 IF $GET(STAT)=""
SET STAT="A"
+8 NEW TIEN,PLSTAT,EDT,FIRST
+9 SET TIEN=$ORDER(^ATXAX("B",TAX,0))
+10 IF 'TIEN
QUIT 0
+11 NEW PROB,ICE,I,Y
+12 SET (PROB,ICD,I)=0
+13 FOR
SET PROB=$ORDER(^AUPNPROB("AC",DFN,PROB))
IF PROB'=+PROB!(+I)
QUIT
Begin DoDot:1
+14 IF $DATA(^AUPNPROB(PROB,0))
SET ICD=$PIECE($GET(^AUPNPROB(PROB,0)),U)
SET PLSTAT=$PIECE($GET(^AUPNPROB(PROB,0)),U,12)
+15 SET EDT=$PIECE($GET(^AUPNPROB(PROB,0)),U,8)
+16 IF +EDT
Begin DoDot:2
+17 SET FIRST=$$FMADD^XLFDT(ADMIT,+1)
+18 IF $PIECE(EDT,".",1)=$PIECE(ADMIT,".",1)!($PIECE(EDT,".",1)=$PIECE(FIRST,".",1))
Begin DoDot:3
+19 IF $$ICD^ATXCHK(ICD,TIEN,9)
Begin DoDot:4
+20 IF STAT="A"
SET Y=$$GET1^DIQ(80,ICD,.01)
SET I=1_U_Y
+21 IF (STAT="C")&(PLSTAT="A")
SET Y=$$GET1^DIQ(80,ICD,.01)
SET I=1_U_Y
+22 IF (STAT="I")&(PLSTAT="I")
SET Y=$$GET1^DIQ(80,ICD,.01)
SET I=1_U_Y
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 QUIT I
PALCPT(DFN,VIEN,TAX,ADMIT) ;EP - return ien of CPT entry if patient had this CPT in the first 24hrs after admission
+1 NEW TIEN,G,CPTT,CPT,FIRST,ENT
+2 IF '$GET(DFN)
QUIT 0
+3 IF $GET(TAX)=""
QUIT 0
+4 IF $GET(VIEN)=""
QUIT 0
+5 IF $GET(ADMIT)=""
QUIT 0
+6 SET G=0
+7 SET TIEN=""
SET TIEN=$ORDER(^ATXAX("B",TAX,TIEN))
IF 'TIEN
QUIT 0
+8 IF '$DATA(^AUPNVSIT(VIEN,0))
QUIT 0
+9 IF '$DATA(^AUPNVCPT("AD",VIEN))
QUIT 0
+10 SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",VIEN,X))
IF '+X!(G)
QUIT
Begin DoDot:1
+11 SET ENT=$PIECE($GET(^AUPNVCPT(X,12)),U,1)
+12 IF +ENT
Begin DoDot:2
+13 SET FIRST=$$FMADD^XLFDT(ADMIT,+1)
+14 IF $PIECE(ENT,".",1)=$PIECE(ADMIT,".",1)!($PIECE(ENT,".",1)=$PIECE(FIRST,".",1))
Begin DoDot:3
+15 IF $$ICD^ATXCHK($PIECE(^AUPNVCPT(X,0),U),TIEN,1)
SET G=X
End DoDot:3
End DoDot:2
End DoDot:1
+16 IF 'G
QUIT 0
+17 IF G
Begin DoDot:1
+18 SET CPT=$PIECE($GET(^AUPNVCPT(G,0)),U,1)
SET CPTT=$PIECE($GET(^ICPT(CPT,0)),U,1)
+19 SET G=1_U_CPTT
End DoDot:1
+20 QUIT $SELECT(G:G,1:0)
PALICD0(DFN,VIEN,TAX,ADMIT) ;EP Check to see if the patient had an ICD0 in the first 24hrs after admission
+1 NEW TIEN,X,G,ICD,ICDT,ENT,FIRST
+2 SET G=0
+3 IF '$GET(DFN)
QUIT 0
+4 IF $GET(TAX)=""
QUIT 0
+5 IF $GET(VIEN)=""
QUIT 0
+6 SET TIEN=""
SET TIEN=$ORDER(^ATXAX("B",TAX,TIEN))
IF 'TIEN
QUIT 0
+7 IF '$DATA(^AUPNVSIT(VIEN,0))
QUIT 0
+8 IF '$DATA(^AUPNVPRC("AD",VIEN))
QUIT 0
+9 SET X=0
FOR
SET X=$ORDER(^AUPNVPRC("AD",VIEN,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+10 SET ENT=$PIECE($GET(^AUPNVCPT(X,12)),U,1)
+11 IF +ENT
Begin DoDot:2
+12 SET FIRST=$$FMADD^XLFDT(ADMIT,+1)
+13 IF $PIECE(ENT,".",1)=$PIECE(ADMIT,".",1)!($PIECE(ENT,".",1)=$PIECE(FIRST,".",1))
Begin DoDot:3
+14 IF $$ICD^ATXCHK($PIECE(^AUPNVPRC(X,0),U),TIEN,0)
SET G=X
End DoDot:3
End DoDot:2
End DoDot:1
+15 IF 'G
QUIT 0
+16 IF G
Begin DoDot:1
+17 SET ICD=$PIECE($GET(^AUPNVPRC(G,0)),U,1)
SET ICDT=$PIECE($GET(^ICD0(ICD,0)),U,1)
+18 SET G=1_U_ICDT
End DoDot:1
+19 QUIT $SELECT(G:G,1:0)
DTECPT(DFN,VIEN,TAX,ADMIT,ENDDT) ;EP - return ien of CPT entry if patient had this CPT entered in the time frame
+1 NEW TIEN,ED,BD,G,CPTT,CPT
+2 IF '$GET(DFN)
QUIT 0
+3 IF $GET(TAX)=""
QUIT 0
+4 IF $GET(VIEN)=""
QUIT 0
+5 IF $GET(ADMIT)=""
QUIT 0
+6 SET G=0
+7 SET TIEN=""
SET TIEN=$ORDER(^ATXAX("B",TAX,TIEN))
IF 'TIEN
QUIT 0
+8 IF '$DATA(^AUPNVSIT(VIEN,0))
QUIT 0
+9 IF '$DATA(^AUPNVCPT("AD",VIEN))
QUIT 0
+10 SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",VIEN,X))
IF '+X!(G)
QUIT
Begin DoDot:1
+11 SET ENT=$PIECE($GET(^AUPNVCPT(X,12)),U,1)
+12 IF +ENT
Begin DoDot:2
+13 IF (ENT>ADMIT)&(ENT<ENDDT)
Begin DoDot:3
+14 IF $$ICD^ATXCHK($PIECE(^AUPNVCPT(X,0),U),TIEN,1)
SET G=X
End DoDot:3
End DoDot:2
End DoDot:1
+15 IF 'G
QUIT 0
+16 IF G
Begin DoDot:1
+17 SET CPT=$PIECE($GET(^AUPNVCPT(G,0)),U,1)
SET CPTT=$PIECE($GET(^ICPT(CPT,0)),U,1)
+18 SET G=1_U_CPTT
End DoDot:1
+19 QUIT $SELECT(G:G,1:0)
DTEICD0(DFN,VIEN,TAX,ADMIT,ENDDT) ;EP Check to see if the patient had an ICD0 stored in the dates selected
+1 NEW TIEN,X,G,ICD,ICDT,ENT,FIRST
+2 SET G=0
+3 IF '$GET(DFN)
QUIT 0
+4 IF $GET(TAX)=""
QUIT 0
+5 IF $GET(VIEN)=""
QUIT 0
+6 SET TIEN=""
SET TIEN=$ORDER(^ATXAX("B",TAX,TIEN))
IF 'TIEN
QUIT 0
+7 IF '$DATA(^AUPNVSIT(VIEN,0))
QUIT 0
+8 IF '$DATA(^AUPNVPRC("AD",VIEN))
QUIT 0
+9 SET X=0
FOR
SET X=$ORDER(^AUPNVPRC("AD",VIEN,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+10 SET ENT=$PIECE($GET(^AUPNVCPT(X,12)),U,1)
+11 IF +ENT
Begin DoDot:2
+12 IF (ENT>ADMIT)&(ENT<ENDDT)
Begin DoDot:3
+13 IF $$ICD^ATXCHK($PIECE(^AUPNVPRC(X,0),U),TIEN,0)
SET G=X
End DoDot:3
End DoDot:2
End DoDot:1
+14 IF 'G
QUIT 0
+15 IF G
Begin DoDot:1
+16 SET ICD=$PIECE($GET(^AUPNVPRC(G,0)),U,1)
SET ICDT=$PIECE($GET(^ICD0(ICD,0)),U,1)
+17 SET G=1_U_ICDT
End DoDot:1
+18 QUIT $SELECT(G:G,1:0)
