APCDKDTC ; IHS/CMI/LAB - LINK DIF DAY LAB VISITS ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
EP ;EP nightly re-linker for DTC
;go through all visits from 60 days ago and find visits
;with a DTC (V Tran with an ordering prov and ordering date)
;and NO Billing Link and attempt to do the billing link
NEW APCDKDTC
S X1=DT,X2=-61 D C^%DTC S APCDKDTC("DATE")=X_.999999
F S APCDKDTC("DATE")=$O(^AUPNVSIT("B",APCDKDTC("DATE"))) Q:APCDKDTC("DATE")="" D
.S APCDKDTC("V")=0 F S APCDKDTC("V")=$O(^AUPNVSIT("B",APCDKDTC("DATE"),APCDKDTC("V"))) Q:APCDKDTC("V")'=+APCDKDTC("V") D
..S APCDKDTC("VR")=^AUPNVSIT(APCDKDTC("V"),0)
..Q:$P(APCDKDTC("VR"),U,11) ;deleted visit
..Q:'$P(APCDKDTC("VR"),U,9) ;no dep entries
..Q:$P(APCDKDTC("VR"),U,28)]"" ;already has billing link
..Q:'$$DTC(APCDKDTC("V")) ;no DTC's
..D LINK(APCDKDTC("V"))
..Q
.Q
K APCDKDTC
Q
;
START(APCDV) ;EP - FIND ORDERING VISIT OF dtc
Q:'$G(APCDV)
Q:'$D(^AUPNVSIT(APCDV))
Q:$P(^AUPNVSIT(APCDV,0),U,11)
Q:'$P(^AUPNVSIT(APCDV,0),U,9)
Q:'$$DTC(APCDV)
D LINK(APCDV) ;link to original visit
Q
;
;
DTC(V) ;EP if have 1 v tc with an ordering date/prov
NEW T,F
S (T,F)=0 F S T=$O(^AUPNVTC("AD",V,T)) Q:T'=+T!(F) I $P($G(^AUPNVTC(T,12)),U,2)]"",$P($G(^AUPNVTC(T,12)),U,11)]"" S F=1
Q F
LINK(APCDVST) ; -- find orig visit and set link
NEW APCDX,APCDTC,ORDT,ORDPRV,DFN,DATE,PRV,ORDV,LINK
;
; -- get first v tran code with an ordering date and prov
NEW F S (F,APCDTC)=0 F S APCDTC=$O(^AUPNVTC("AD",APCDVST,APCDTC)) Q:APCDTC'=+APCDTC!(F) D
. S DFN=$P($G(^AUPNVTC(APCDTC,0)),U,2) Q:DFN="" ;patient
. S ORDT=$P($P($G(^AUPNVTC(APCDTC,12)),U,11),".") Q:ORDT="" ;order date
. S ORDPRV=$P($G(^AUPNVTC(APCDTC,12)),U,2) Q:ORDPRV="" ;ordering provider
. S ORDPRV=$S($P(^DD(9000010.06,.01,0),U,2)[6:$P($G(^DIC(3,ORDPRV,0)),U,16),1:ORDPRV) Q:ORDPRV=""
. S F=1
. Q
Q:'F
;
; -- look for orig visit based on order date for patient and provider
K LINK S DATE=$$RVDT(ORDT)-.0001,END=$$RVDT(ORDT)+.9999999
F S DATE=$O(^AUPNVSIT("AA",DFN,DATE)) Q:'DATE!(DATE>END)!($D(LINK)) D
. ; -- find all visits for patient on order date
. S ORDV=0 F S ORDV=$O(^AUPNVSIT("AA",DFN,DATE,ORDV)) Q:'ORDV D
.. Q:ORDV=APCDVST ;don't link to itself
.. ; -- find if ordering provider linked to this visit
.. S PRV=0 F S PRV=$O(^AUPNVPRV("AD",ORDV,PRV)) Q:'PRV!($D(LINK)) D
... I +^AUPNVPRV(PRV,0)=ORDPRV S LINK=ORDV ;orig visit found
;
; -- if orig visit found, set link
I $G(LINK) S DIE=9000010,DA=APCDVST,DR=".28////"_LINK D ^DIE
Q
;
;
RVDT(X) ; -- returns reverse date
Q 9999999-X
;
APCDKDTC ; IHS/CMI/LAB - LINK DIF DAY LAB VISITS ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
EP ;EP nightly re-linker for DTC
+1 ;go through all visits from 60 days ago and find visits
+2 ;with a DTC (V Tran with an ordering prov and ordering date)
+3 ;and NO Billing Link and attempt to do the billing link
+4 NEW APCDKDTC
+5 SET X1=DT
SET X2=-61
DO C^%DTC
SET APCDKDTC("DATE")=X_.999999
+6 FOR
SET APCDKDTC("DATE")=$ORDER(^AUPNVSIT("B",APCDKDTC("DATE")))
IF APCDKDTC("DATE")=""
QUIT
Begin DoDot:1
+7 SET APCDKDTC("V")=0
FOR
SET APCDKDTC("V")=$ORDER(^AUPNVSIT("B",APCDKDTC("DATE"),APCDKDTC("V")))
IF APCDKDTC("V")'=+APCDKDTC("V")
QUIT
Begin DoDot:2
+8 SET APCDKDTC("VR")=^AUPNVSIT(APCDKDTC("V"),0)
+9 ;deleted visit
IF $PIECE(APCDKDTC("VR"),U,11)
QUIT
+10 ;no dep entries
IF '$PIECE(APCDKDTC("VR"),U,9)
QUIT
+11 ;already has billing link
IF $PIECE(APCDKDTC("VR"),U,28)]""
QUIT
+12 ;no DTC's
IF '$$DTC(APCDKDTC("V"))
QUIT
+13 DO LINK(APCDKDTC("V"))
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 KILL APCDKDTC
+17 QUIT
+18 ;
START(APCDV) ;EP - FIND ORDERING VISIT OF dtc
+1 IF '$GET(APCDV)
QUIT
+2 IF '$DATA(^AUPNVSIT(APCDV))
QUIT
+3 IF $PIECE(^AUPNVSIT(APCDV,0),U,11)
QUIT
+4 IF '$PIECE(^AUPNVSIT(APCDV,0),U,9)
QUIT
+5 IF '$$DTC(APCDV)
QUIT
+6 ;link to original visit
DO LINK(APCDV)
+7 QUIT
+8 ;
+9 ;
DTC(V) ;EP if have 1 v tc with an ordering date/prov
+1 NEW T,F
+2 SET (T,F)=0
FOR
SET T=$ORDER(^AUPNVTC("AD",V,T))
IF T'=+T!(F)
QUIT
IF $PIECE($GET(^AUPNVTC(T,12)),U,2)]""
IF $PIECE($GET(^AUPNVTC(T,12)),U,11)]""
SET F=1
+3 QUIT F
LINK(APCDVST) ; -- find orig visit and set link
+1 NEW APCDX,APCDTC,ORDT,ORDPRV,DFN,DATE,PRV,ORDV,LINK
+2 ;
+3 ; -- get first v tran code with an ordering date and prov
+4 NEW F
SET (F,APCDTC)=0
FOR
SET APCDTC=$ORDER(^AUPNVTC("AD",APCDVST,APCDTC))
IF APCDTC'=+APCDTC!(F)
QUIT
Begin DoDot:1
+5 ;patient
SET DFN=$PIECE($GET(^AUPNVTC(APCDTC,0)),U,2)
IF DFN=""
QUIT
+6 ;order date
SET ORDT=$PIECE($PIECE($GET(^AUPNVTC(APCDTC,12)),U,11),".")
IF ORDT=""
QUIT
+7 ;ordering provider
SET ORDPRV=$PIECE($GET(^AUPNVTC(APCDTC,12)),U,2)
IF ORDPRV=""
QUIT
+8 SET ORDPRV=$SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[6:$PIECE($GET(^DIC(3,ORDPRV,0)),U,16),1:ORDPRV)
IF ORDPRV=""
QUIT
+9 SET F=1
+10 QUIT
End DoDot:1
+11 IF 'F
QUIT
+12 ;
+13 ; -- look for orig visit based on order date for patient and provider
+14 KILL LINK
SET DATE=$$RVDT(ORDT)-.0001
SET END=$$RVDT(ORDT)+.9999999
+15 FOR
SET DATE=$ORDER(^AUPNVSIT("AA",DFN,DATE))
IF 'DATE!(DATE>END)!($DATA(LINK))
QUIT
Begin DoDot:1
+16 ; -- find all visits for patient on order date
+17 SET ORDV=0
FOR
SET ORDV=$ORDER(^AUPNVSIT("AA",DFN,DATE,ORDV))
IF 'ORDV
QUIT
Begin DoDot:2
+18 ;don't link to itself
IF ORDV=APCDVST
QUIT
+19 ; -- find if ordering provider linked to this visit
+20 SET PRV=0
FOR
SET PRV=$ORDER(^AUPNVPRV("AD",ORDV,PRV))
IF 'PRV!($DATA(LINK))
QUIT
Begin DoDot:3
+21 ;orig visit found
IF +^AUPNVPRV(PRV,0)=ORDPRV
SET LINK=ORDV
End DoDot:3
End DoDot:2
End DoDot:1
+22 ;
+23 ; -- if orig visit found, set link
+24 IF $GET(LINK)
SET DIE=9000010
SET DA=APCDVST
SET DR=".28////"_LINK
DO ^DIE
+25 QUIT
+26 ;
+27 ;
RVDT(X) ; -- returns reverse date
+1 QUIT 9999999-X
+2 ;
