BGPMUUT1 ; IHS/MSC/MGH - Meaningful use utility calls ;01-Mar-2011 15:35;MGH
;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
;
;
WH(P,BDATE,EDATE,T,F) ;EP
I '$G(P) Q ""
I $G(EDATE)="" Q ""
I $G(BDATE)="" S BDATE=$$FMADD^XLFDT(EDATE,-365)
I $G(T)="" Q ""
I '$G(F) S F=1
;go through procedures in a date range for this patient, check proc type
NEW D,X,Y,G,V,O
S (G,V)=0,I="" F S V=$O(^BWPCD("C",P,V)) Q:V="" D
.Q:'$D(^BWPCD(V,0))
.I $P(^BWPCD(V,0),U,4)'=T Q
.S D=$P(^BWPCD(V,0),U,12)
.Q:D<BDATE
.Q:D>EDATE
.S I=$O(G(0)) I I>D Q
.S G=V,G(D)=""
.Q
I 'G Q ""
I F=1 Q $S(G:1,1:"")
I F=2 Q G
I F=3 S D=$P(^BWPCD(G,0),U,12) Q D
I F=4 S D=$P(^BWPCD(G,0),U,12) Q $$FMTE^XLFDT(D)
Q ""
PLCODE(P,A) ;EP
I $G(P)="" Q ""
I $G(A)="" Q ""
N T
;S T=$O(^ICD9("AB",A,0))
S T=+$$CODEN^ICDCODE(A,80)
I T'>0 Q ""
N X,Y,I S (X,Y,I)=0 F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(I) I $D(^AUPNPROB(X,0)) S Y=$P(^AUPNPROB(X,0),U) I Y=T S I=1
Q I
PLTAX(DFN,TAX,STAT,CDATE) ;EP - is DX on problem list 1 or 0
;Input variables
;STAT - A for all problems, C for active problems, I for inactive
;DFN=IEN of the patient
;TAX=Name of the taxonomy
;CDATE=Date to check against
I $G(CDATE)="" S CDATE=0
I $G(DFN)="" Q 0
I $G(TAX)="" Q 0
I $G(STAT)="" S STAT="A"
N TIEN,PLSTAT S TIEN=$O(^ATXAX("B",TAX,0))
I 'TIEN Q 0
N PROB,ICD,I,SDTE,EDTE,PDTE,EDT
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)
.S SDTE=$P($G(^AUPNPROB(PROB,0)),U,13)
.I SDTE'="" S EDT=SDTE
.Q:+CDATE&(EDT>CDATE)
.I $$ICD^ATXCHK(ICD,TIEN,9) D
..S SDTE=$P($G(^AUPNPROB(PROB,0)),U,13)
..S EDTE=$P($G(^AUPNPROB(PROB,0)),U,8)
..I +SDTE S PDTE=SDTE
..E S PDTE=EDTE
..I STAT="A" S Y=$$GET1^DIQ(80,ICD,.01) S I=1_U_Y_U_PDTE_U_PROB
..I (STAT="C")&(PLSTAT="A") S Y=$$GET1^DIQ(80,ICD,.01) S I=1_U_Y_U_PDTE_U_PROB
..I (STAT="I")&(PLSTAT="I") S Y=$$GET1^DIQ(80,ICD,.01) S I=1_U_Y_U_PDTE_U_PROB
Q I
CPT(DFN,BDATE,EDATE,TAX) ;EP - return ien of CPT entry if patient had this CPT
N TIEN,ED,BD,G,CPTT,CPTDATE,VDATE,VST
I '$G(DFN) Q 0
I $G(TAX)="" Q 0
I $G(EDATE)="" Q 0
S TIEN="" S TIEN=$O(^ATXAX("B",TAX,TIEN)) Q:'TIEN 0
I $G(BDATE)="" S BDATE=$$FMADD^XLFDT(EDATE,-365)
;go through visits in a date range for this patient, check cpt
NEW D,BD,ED,X,Y,D,G,V
S ED=(9999999-EDATE),BD=9999999-BDATE,G=0
F S ED=$O(^AUPNVSIT("AA",DFN,ED)) Q:ED=""!($P(ED,".")>BD)!(G) D
.S V=0 F S V=$O(^AUPNVSIT("AA",DFN,ED,V)) Q:V'=+V!(G) D
..Q:'$D(^AUPNVSIT(V,0))
..Q:'$D(^AUPNVCPT("AD",V))
..S X=0 F S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X!(G) D
...I $$ICD^ATXCHK($P(^AUPNVCPT(X,0),U),TIEN,1) S G=X
...Q
..Q
.Q
I 'G Q 0
I G D
.S VDATE=""
.S CPT=$P($G(^AUPNVCPT(G,0)),U,1),CPTT=$P($G(^ICPT(CPT,0)),U,1)
.S CPTDATE=$P($G(^AUPNVCPT(G,12)),U,1)
.S VST=$P($G(^AUPNVCPT(G,0)),U,3),VDATE=$P($G(^AUPNVSIT(VST,0)),U,1)
.S G=1_U_CPTT_U_CPTDATE_U_VDATE_U_VST
Q $S(G:G,1:0)
VSTCPT(DFN,VIEN,TAX) ;EP Check to see if the patient had a CPT on a particular visit
N TIEN,X,G,CPTT,CPT,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)) Q:'TIEN
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'=+X!(G) D
.I $$ICD^ATXCHK($P(^AUPNVCPT(X,0),U),TIEN,1) S G=X
.Q
I 'G Q 0
I G D
.S EVDT=$P($G(^AUPNVCPT(G,12)),U,1)
.S CPT=$P($G(^AUPNVCPT(G,0)),U,1),CPTT=$P($G(^ICPT(CPT,0)),U,1)
.S G=1_U_CPTT_U_EVDT_U_G
Q $S(G:G,1:0)
RAD(P,BDATE,EDATE,T,F) ;EP - return ien of CPT entry if patient had this CPT
I '$G(P) Q ""
I $G(EDATE)="" Q ""
I $G(BDATE)="" S BDATE=$$FMADD^XLFDT(EDATE,-365)
I $G(T)="" Q ""
I '$G(F) S F=1
;go through visits in a date range for this patient, check cpts
NEW D,BD,ED,X,Y,D,G,V,C,TIEN
S TIEN="" S TIEN=$O(^ATXAX("B",T,TIEN)) Q:'TIEN
S ED=(9999999-EDATE),BD=9999999-BDATE,G=0
F S ED=$O(^AUPNVSIT("AA",P,ED)) Q:ED=""!($P(ED,".")>BD)!(G) D
.S V=0 F S V=$O(^AUPNVSIT("AA",P,ED,V)) Q:V'=+V!(G) D
..Q:'$D(^AUPNVSIT(V,0))
..Q:'$D(^AUPNVRAD("AD",V))
..S X=0 F S X=$O(^AUPNVRAD("AD",V,X)) Q:X'=+X!(G) D
...S EVDATE=$P($G(^AUPNVRAD(X,12)),U)
...Q:EVDATE<BDATE!(EVDATE>EDATE)
...S C=$P(^AUPNVRAD(X,0),U) Q:C="" S C=$P($G(^RAMIS(71,C,0)),U,9) Q:C=""
...I $$ICD^ATXCHK(C,TIEN,1) S G=X
...Q
..Q
.Q
I 'G Q ""
I F=1 Q $S(G:1,1:"")
I F=2 Q G
I F=3 S V=$P(^AUPNVRAD(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")
I F=4 S V=$P(^AUPNVRAD(G,0),U,3) I V Q $$FMTE^XLFDT($P($P($G(^AUPNVSIT(V,0)),U),"."))
I F=5 S V=$P(^AUPNVRAD(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")_"^"_$P(^RAMIS(71,$P(^AUPNVRAD(G,0),U),0),U,9)
I F=6 S V=$P(^AUPNVRAD(G,0),U,3) I V Q 1_"^"_$P($P($G(^AUPNVSIT(V,0)),U),".")_"^"_$P(^RAMIS(71,$P(^AUPNVRAD(G,0),U),0),U)_"^"_G
I F=7 S V=$P(^AUPNVRAD(G,0),U,3) I V Q $P($P($G(^AUPNVRAD(G,12)),U),".")_"^"_$P(^RAMIS(71,$P(^AUPNVRAD(G,0),U),0),U,9)
Q ""
CPTI(DFN,BDATE,EDATE,CPTI,SCEX,SCLN,SMOD) ;EP - did patient have this cpt (ien) in date range
I '$G(P) Q ""
I $G(CPTI)="" Q ""
I $G(BDATE)="" Q ""
I $G(EDATE)="" Q ""
S SCEX=$G(SCEX)
S SCLN=$G(SCLN)
S SMOD=$G(SMOD)
I '$D(^ICPT(CPTI)) Q "" ;not a valid cpt ien
I '$D(^AUPNVCPT("AA",P)) Q "" ;no cpts for this patient
NEW D,BD,ED,X,Y,D,G,V,I,M,M1,Z,J,K,Q
S ED=9999999-EDATE-1,BD=9999999-BDATE,G=""
F S ED=$O(^AUPNVCPT("AA",P,CPTI,ED)) Q:ED=""!($P(ED,".")>BD)!(G) D
.S I=0 F S I=$O(^AUPNVCPT("AA",P,CPTI,ED,I)) Q:I'=+I!(G) D
..S V=$P($G(^AUPNVCPT(I,0)),U,3)
..I SCEX]"",SCEX[$P(^AUPNVSIT(V,0),U,7) Q
..I SCLN]"",$$CLINIC^APCLV(V,"C")=SCLN Q
..S M=$$VAL^XBDIQ1(9000010.18,I,.08)
..S M1=$$VAL^XBDIQ1(9000010.18,I,.09)
..S Q=0
..I SMOD]"" F J=1:1 S K=$P(SMOD,";",J) Q:K="" I K=M S Q=1
..Q:Q
..I SMOD]"" F J=1:1 S K=$P(SMOD,";",J) Q:K="" I K=M1 S Q=1
..Q:Q
..S G="1"_"^"_(9999999-ED)
Q G
;
LASTITEM(P,BD,ED,BGPT,BGPV) ;PEP - return last item APCLV OF TYPE APCLT DURING BD TO ED IN FORM APCLF
I $G(BD)="" S BD=$$DOB^AUPNPAT(P)
I $G(ED)="" S ED=DT
I $G(BGPT)="" Q ""
I $G(BGPV)="" Q ""
NEW BGPR,%,E,Y K R S %=P_"^LAST "_BGPT_" "_BGPV_";DURING "_BD_"-"_ED,E=$$START1^APCLDF(%,"BGPR(")
I '$D(BGPR(1)) Q ""
Q 1_U_$P(BGPR(1),U,1)_U_$P(BGPR(1),U,3)_U_$P(BGPR(1),U,2)
;
PRV(VISIT,PROV) ;EP - Is this provider a provider for this visit
;CHANGED ON 10/26 TO ONLY RETURN TRUE IF PRIMARY PROVIDER - PER Aneel Advani
N I,PRVIEN,PRVDATA
S I=""
S PRVIEN="" F S PRVIEN=$O(^AUPNVPRV("AD",VISIT,PRVIEN)) Q:'+PRVIEN!(I) D
.S PRVDATA=$G(^AUPNVPRV(PRVIEN,0))
.I $P(PRVDATA,U,1)=PROV&($P(PRVDATA,U,4)="P") S I=1
Q $S(I=1:1,1:"")
PRVOLD(VISIT,PROV) ;Is this provider a provider for this visit - NO PRIMARY/SECONDARY CHECK
N I,PRVIEN
S I=""
S PRVIEN="" F S PRVIEN=$O(^AUPNVPRV("AD",VISIT,PRVIEN)) Q:'+PRVIEN!(I) D
.I $P($G(^AUPNVPRV(PRVIEN,0)),U,1)=PROV S I=1
Q $S(I=1:1,1:"")
BGPMUUT1 ; IHS/MSC/MGH - Meaningful use utility calls ;01-Mar-2011 15:35;MGH
+1 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
+2 ;
+3 ;
WH(P,BDATE,EDATE,T,F) ;EP
+1 IF '$GET(P)
QUIT ""
+2 IF $GET(EDATE)=""
QUIT ""
+3 IF $GET(BDATE)=""
SET BDATE=$$FMADD^XLFDT(EDATE,-365)
+4 IF $GET(T)=""
QUIT ""
+5 IF '$GET(F)
SET F=1
+6 ;go through procedures in a date range for this patient, check proc type
+7 NEW D,X,Y,G,V,O
+8 SET (G,V)=0
SET I=""
FOR
SET V=$ORDER(^BWPCD("C",P,V))
IF V=""
QUIT
Begin DoDot:1
+9 IF '$DATA(^BWPCD(V,0))
QUIT
+10 IF $PIECE(^BWPCD(V,0),U,4)'=T
QUIT
+11 SET D=$PIECE(^BWPCD(V,0),U,12)
+12 IF D<BDATE
QUIT
+13 IF D>EDATE
QUIT
+14 SET I=$ORDER(G(0))
IF I>D
QUIT
+15 SET G=V
SET G(D)=""
+16 QUIT
End DoDot:1
+17 IF 'G
QUIT ""
+18 IF F=1
QUIT $SELECT(G:1,1:"")
+19 IF F=2
QUIT G
+20 IF F=3
SET D=$PIECE(^BWPCD(G,0),U,12)
QUIT D
+21 IF F=4
SET D=$PIECE(^BWPCD(G,0),U,12)
QUIT $$FMTE^XLFDT(D)
+22 QUIT ""
PLCODE(P,A) ;EP
+1 IF $GET(P)=""
QUIT ""
+2 IF $GET(A)=""
QUIT ""
+3 NEW T
+4 ;S T=$O(^ICD9("AB",A,0))
+5 SET T=+$$CODEN^ICDCODE(A,80)
+6 IF T'>0
QUIT ""
+7 NEW X,Y,I
SET (X,Y,I)=0
FOR
SET X=$ORDER(^AUPNPROB("AC",P,X))
IF X'=+X!(I)
QUIT
IF $DATA(^AUPNPROB(X,0))
SET Y=$PIECE(^AUPNPROB(X,0),U)
IF Y=T
SET I=1
+8 QUIT I
PLTAX(DFN,TAX,STAT,CDATE) ;EP - is DX on problem list 1 or 0
+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 ;CDATE=Date to check against
+6 IF $GET(CDATE)=""
SET CDATE=0
+7 IF $GET(DFN)=""
QUIT 0
+8 IF $GET(TAX)=""
QUIT 0
+9 IF $GET(STAT)=""
SET STAT="A"
+10 NEW TIEN,PLSTAT
SET TIEN=$ORDER(^ATXAX("B",TAX,0))
+11 IF 'TIEN
QUIT 0
+12 NEW PROB,ICD,I,SDTE,EDTE,PDTE,EDT
+13 SET (PROB,ICD,I)=0
+14 FOR
SET PROB=$ORDER(^AUPNPROB("AC",DFN,PROB))
IF PROB'=+PROB!(+I)
QUIT
Begin DoDot:1
+15 IF $DATA(^AUPNPROB(PROB,0))
SET ICD=$PIECE($GET(^AUPNPROB(PROB,0)),U)
SET PLSTAT=$PIECE($GET(^AUPNPROB(PROB,0)),U,12)
+16 SET EDT=$PIECE($GET(^AUPNPROB(PROB,0)),U,8)
+17 SET SDTE=$PIECE($GET(^AUPNPROB(PROB,0)),U,13)
+18 IF SDTE'=""
SET EDT=SDTE
+19 IF +CDATE&(EDT>CDATE)
QUIT
+20 IF $$ICD^ATXCHK(ICD,TIEN,9)
Begin DoDot:2
+21 SET SDTE=$PIECE($GET(^AUPNPROB(PROB,0)),U,13)
+22 SET EDTE=$PIECE($GET(^AUPNPROB(PROB,0)),U,8)
+23 IF +SDTE
SET PDTE=SDTE
+24 IF '$TEST
SET PDTE=EDTE
+25 IF STAT="A"
SET Y=$$GET1^DIQ(80,ICD,.01)
SET I=1_U_Y_U_PDTE_U_PROB
+26 IF (STAT="C")&(PLSTAT="A")
SET Y=$$GET1^DIQ(80,ICD,.01)
SET I=1_U_Y_U_PDTE_U_PROB
+27 IF (STAT="I")&(PLSTAT="I")
SET Y=$$GET1^DIQ(80,ICD,.01)
SET I=1_U_Y_U_PDTE_U_PROB
End DoDot:2
End DoDot:1
+28 QUIT I
CPT(DFN,BDATE,EDATE,TAX) ;EP - return ien of CPT entry if patient had this CPT
+1 NEW TIEN,ED,BD,G,CPTT,CPTDATE,VDATE,VST
+2 IF '$GET(DFN)
QUIT 0
+3 IF $GET(TAX)=""
QUIT 0
+4 IF $GET(EDATE)=""
QUIT 0
+5 SET TIEN=""
SET TIEN=$ORDER(^ATXAX("B",TAX,TIEN))
IF 'TIEN
QUIT 0
+6 IF $GET(BDATE)=""
SET BDATE=$$FMADD^XLFDT(EDATE,-365)
+7 ;go through visits in a date range for this patient, check cpt
+8 NEW D,BD,ED,X,Y,D,G,V
+9 SET ED=(9999999-EDATE)
SET BD=9999999-BDATE
SET G=0
+10 FOR
SET ED=$ORDER(^AUPNVSIT("AA",DFN,ED))
IF ED=""!($PIECE(ED,".")>BD)!(G)
QUIT
Begin DoDot:1
+11 SET V=0
FOR
SET V=$ORDER(^AUPNVSIT("AA",DFN,ED,V))
IF V'=+V!(G)
QUIT
Begin DoDot:2
+12 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+13 IF '$DATA(^AUPNVCPT("AD",V))
QUIT
+14 SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",V,X))
IF X'=+X!(G)
QUIT
Begin DoDot:3
+15 IF $$ICD^ATXCHK($PIECE(^AUPNVCPT(X,0),U),TIEN,1)
SET G=X
+16 QUIT
End DoDot:3
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 IF 'G
QUIT 0
+20 IF G
Begin DoDot:1
+21 SET VDATE=""
+22 SET CPT=$PIECE($GET(^AUPNVCPT(G,0)),U,1)
SET CPTT=$PIECE($GET(^ICPT(CPT,0)),U,1)
+23 SET CPTDATE=$PIECE($GET(^AUPNVCPT(G,12)),U,1)
+24 SET VST=$PIECE($GET(^AUPNVCPT(G,0)),U,3)
SET VDATE=$PIECE($GET(^AUPNVSIT(VST,0)),U,1)
+25 SET G=1_U_CPTT_U_CPTDATE_U_VDATE_U_VST
End DoDot:1
+26 QUIT $SELECT(G:G,1:0)
VSTCPT(DFN,VIEN,TAX) ;EP Check to see if the patient had a CPT on a particular visit
+1 NEW TIEN,X,G,CPTT,CPT,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
+7 IF '$DATA(^AUPNVSIT(VIEN,0))
QUIT 0
+8 IF '$DATA(^AUPNVCPT("AD",VIEN))
QUIT 0
+9 SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",VIEN,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+10 IF $$ICD^ATXCHK($PIECE(^AUPNVCPT(X,0),U),TIEN,1)
SET G=X
+11 QUIT
End DoDot:1
+12 IF 'G
QUIT 0
+13 IF G
Begin DoDot:1
+14 SET EVDT=$PIECE($GET(^AUPNVCPT(G,12)),U,1)
+15 SET CPT=$PIECE($GET(^AUPNVCPT(G,0)),U,1)
SET CPTT=$PIECE($GET(^ICPT(CPT,0)),U,1)
+16 SET G=1_U_CPTT_U_EVDT_U_G
End DoDot:1
+17 QUIT $SELECT(G:G,1:0)
RAD(P,BDATE,EDATE,T,F) ;EP - return ien of CPT entry if patient had this CPT
+1 IF '$GET(P)
QUIT ""
+2 IF $GET(EDATE)=""
QUIT ""
+3 IF $GET(BDATE)=""
SET BDATE=$$FMADD^XLFDT(EDATE,-365)
+4 IF $GET(T)=""
QUIT ""
+5 IF '$GET(F)
SET F=1
+6 ;go through visits in a date range for this patient, check cpts
+7 NEW D,BD,ED,X,Y,D,G,V,C,TIEN
+8 SET TIEN=""
SET TIEN=$ORDER(^ATXAX("B",T,TIEN))
IF 'TIEN
QUIT
+9 SET ED=(9999999-EDATE)
SET BD=9999999-BDATE
SET G=0
+10 FOR
SET ED=$ORDER(^AUPNVSIT("AA",P,ED))
IF ED=""!($PIECE(ED,".")>BD)!(G)
QUIT
Begin DoDot:1
+11 SET V=0
FOR
SET V=$ORDER(^AUPNVSIT("AA",P,ED,V))
IF V'=+V!(G)
QUIT
Begin DoDot:2
+12 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+13 IF '$DATA(^AUPNVRAD("AD",V))
QUIT
+14 SET X=0
FOR
SET X=$ORDER(^AUPNVRAD("AD",V,X))
IF X'=+X!(G)
QUIT
Begin DoDot:3
+15 SET EVDATE=$PIECE($GET(^AUPNVRAD(X,12)),U)
+16 IF EVDATE<BDATE!(EVDATE>EDATE)
QUIT
+17 SET C=$PIECE(^AUPNVRAD(X,0),U)
IF C=""
QUIT
SET C=$PIECE($GET(^RAMIS(71,C,0)),U,9)
IF C=""
QUIT
+18 IF $$ICD^ATXCHK(C,TIEN,1)
SET G=X
+19 QUIT
End DoDot:3
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
+22 IF 'G
QUIT ""
+23 IF F=1
QUIT $SELECT(G:1,1:"")
+24 IF F=2
QUIT G
+25 IF F=3
SET V=$PIECE(^AUPNVRAD(G,0),U,3)
IF V
QUIT $PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),".")
+26 IF F=4
SET V=$PIECE(^AUPNVRAD(G,0),U,3)
IF V
QUIT $$FMTE^XLFDT($PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),"."))
+27 IF F=5
SET V=$PIECE(^AUPNVRAD(G,0),U,3)
IF V
QUIT $PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),".")_"^"_$PIECE(^RAMIS(71,$PIECE(^AUPNVRAD(G,0),U),0),U,9)
+28 IF F=6
SET V=$PIECE(^AUPNVRAD(G,0),U,3)
IF V
QUIT 1_"^"_$PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),".")_"^"_$PIECE(^RAMIS(71,$PIECE(^AUPNVRAD(G,0),U),0),U)_"^"_G
+29 IF F=7
SET V=$PIECE(^AUPNVRAD(G,0),U,3)
IF V
QUIT $PIECE($PIECE($GET(^AUPNVRAD(G,12)),U),".")_"^"_$PIECE(^RAMIS(71,$PIECE(^AUPNVRAD(G,0),U),0),U,9)
+30 QUIT ""
CPTI(DFN,BDATE,EDATE,CPTI,SCEX,SCLN,SMOD) ;EP - did patient have this cpt (ien) in date range
+1 IF '$GET(P)
QUIT ""
+2 IF $GET(CPTI)=""
QUIT ""
+3 IF $GET(BDATE)=""
QUIT ""
+4 IF $GET(EDATE)=""
QUIT ""
+5 SET SCEX=$GET(SCEX)
+6 SET SCLN=$GET(SCLN)
+7 SET SMOD=$GET(SMOD)
+8 ;not a valid cpt ien
IF '$DATA(^ICPT(CPTI))
QUIT ""
+9 ;no cpts for this patient
IF '$DATA(^AUPNVCPT("AA",P))
QUIT ""
+10 NEW D,BD,ED,X,Y,D,G,V,I,M,M1,Z,J,K,Q
+11 SET ED=9999999-EDATE-1
SET BD=9999999-BDATE
SET G=""
+12 FOR
SET ED=$ORDER(^AUPNVCPT("AA",P,CPTI,ED))
IF ED=""!($PIECE(ED,".")>BD)!(G)
QUIT
Begin DoDot:1
+13 SET I=0
FOR
SET I=$ORDER(^AUPNVCPT("AA",P,CPTI,ED,I))
IF I'=+I!(G)
QUIT
Begin DoDot:2
+14 SET V=$PIECE($GET(^AUPNVCPT(I,0)),U,3)
+15 IF SCEX]""
IF SCEX[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+16 IF SCLN]""
IF $$CLINIC^APCLV(V,"C")=SCLN
QUIT
+17 SET M=$$VAL^XBDIQ1(9000010.18,I,.08)
+18 SET M1=$$VAL^XBDIQ1(9000010.18,I,.09)
+19 SET Q=0
+20 IF SMOD]""
FOR J=1:1
SET K=$PIECE(SMOD,";",J)
IF K=""
QUIT
IF K=M
SET Q=1
+21 IF Q
QUIT
+22 IF SMOD]""
FOR J=1:1
SET K=$PIECE(SMOD,";",J)
IF K=""
QUIT
IF K=M1
SET Q=1
+23 IF Q
QUIT
+24 SET G="1"_"^"_(9999999-ED)
End DoDot:2
End DoDot:1
+25 QUIT G
+26 ;
LASTITEM(P,BD,ED,BGPT,BGPV) ;PEP - return last item APCLV OF TYPE APCLT DURING BD TO ED IN FORM APCLF
+1 IF $GET(BD)=""
SET BD=$$DOB^AUPNPAT(P)
+2 IF $GET(ED)=""
SET ED=DT
+3 IF $GET(BGPT)=""
QUIT ""
+4 IF $GET(BGPV)=""
QUIT ""
+5 NEW BGPR,%,E,Y
KILL R
SET %=P_"^LAST "_BGPT_" "_BGPV_";DURING "_BD_"-"_ED
SET E=$$START1^APCLDF(%,"BGPR(")
+6 IF '$DATA(BGPR(1))
QUIT ""
+7 QUIT 1_U_$PIECE(BGPR(1),U,1)_U_$PIECE(BGPR(1),U,3)_U_$PIECE(BGPR(1),U,2)
+8 ;
PRV(VISIT,PROV) ;EP - Is this provider a provider for this visit
+1 ;CHANGED ON 10/26 TO ONLY RETURN TRUE IF PRIMARY PROVIDER - PER Aneel Advani
+2 NEW I,PRVIEN,PRVDATA
+3 SET I=""
+4 SET PRVIEN=""
FOR
SET PRVIEN=$ORDER(^AUPNVPRV("AD",VISIT,PRVIEN))
IF '+PRVIEN!(I)
QUIT
Begin DoDot:1
+5 SET PRVDATA=$GET(^AUPNVPRV(PRVIEN,0))
+6 IF $PIECE(PRVDATA,U,1)=PROV&($PIECE(PRVDATA,U,4)="P")
SET I=1
End DoDot:1
+7 QUIT $SELECT(I=1:1,1:"")
PRVOLD(VISIT,PROV) ;Is this provider a provider for this visit - NO PRIMARY/SECONDARY CHECK
+1 NEW I,PRVIEN
+2 SET I=""
+3 SET PRVIEN=""
FOR
SET PRVIEN=$ORDER(^AUPNVPRV("AD",VISIT,PRVIEN))
IF '+PRVIEN!(I)
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^AUPNVPRV(PRVIEN,0)),U,1)=PROV
SET I=1
End DoDot:1
+5 QUIT $SELECT(I=1:1,1:"")
