- 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 ;
