ABMDVCK ; IHS/ASDST/DMJ - PCC Visit Edits ;
;;2.6;IHS 3P BILLING SYSTEM;**11,19,20,21**;NOV 12, 2009;Build 379
;Original;TMD;08/19/96 4:49 PM
;Note special input variable ABMDFN
;It is optional
;If it is defined claims will be generated only for the one patient
;whose ien is the value of ABMDFN.
;If it is undefined claims will be generated for all patient with new
;PCC visits.
;
; IHS/SD/SDR - v2.5 p8
; Check for uncoded Dxs on visit
;
; IHS/SD/SDR - v2.5 p8
; Check PCC EHR/Chart Audit Start Date; if populated, the Chart Audit
; Status will need to be checked for ea visit with a service cat or
; A/O/S. If DOS is equal or after the Audit Start Date and the status
; is anything but REVIEWED the claim will not generate.
;
; IHS/SD/SDR - v2.5 p8 -When inpatient, check if coding complete field is null; if so, generate claim.
; IHS/SD/SDR - v2.5 p9 - IM19304 - Fix supplied by Jim Gray, checking to see if variable ABMP("INS") is set
; IHS/SD/SDR - v2.5 p9 - Fix to Uncoded Dxs to check lag time
; IHS/SD/SDR - v2.5 p10 - IM21846 - Made change to stop error <UNDEF>EXP+1^ABMDE2X5
;
;IHS/SD/SDR - 2.6*19 - HEAT128988 - Made change to CG to check A/R PARENT/SATELLITE SETUP so CG can check
; parent locations first, then satellites; claims were generated under wrong location when satellite IEN
; was lower than parent IEN.
;IHS/SD/SDR - 2.6*19 - HEAT251398 - Changed claim generator to allow service category TELEMEDICINE to
; generate claims.
;IHS/SD/SDR - 2.6*20 - HEAT270671 - Made change to stop <UNDEF>SITE+1^ABMDVCK error. Occurs when there is an entry
; in the A/R Parent/Satellite file but no matching entry in the 3P Parameter file.
;IHS/SD/SDR - 2.6*21 - HEAT130406 - Removed auto-purge of claims from CG.
; *********************************************************************
START ;START HERE
I DUZ(2)="" S DUZ(2)=1
S X="APCDCHKJ"
X ^%ZOSF("TEST") ;See if rtn exists.
I D ^APCDCHKJ ;PCC linker - INPAT
I '$D(ABMDFN) D ^APCDK ;PCC relinker
N ABMVDFN,ABMCPTTB,ABMDT
S X1=DT
S X2=-180
D C^%DTC
S ABM("C")=X
;The ^ABMDTMP("KCLM" nodes are still being set in ver 2.0 as of 8/27/96
S ABM=0
F S ABM=$O(^ABMDTMP("KCLM",ABM)) Q:'ABM Q:ABM>ABM("C") D
.S ABM("D")=0
.F S ABM("D")=$O(^ABMDTMP("KCLM",ABM,ABM("D"))) Q:'ABM("D") D
..K ^ABMDTMP("KCLM",ABM,ABM("D"))
;These ^ABMDTMP("KBILL" nodes are not being set in version 2.0
;These nodes are the audit trail from ver 1.6
;This checking must continue for 6 months after conversion from 1.6
S ABM=0
F S ABM=$O(^ABMDTMP("KBILL",ABM)) Q:'ABM Q:ABM>ABM("C") D
.S ABM("D")=0
.F S ABM("D")=$O(^ABMDTMP("KBILL",ABM,ABM("D"))) Q:'ABM("D") D
..K ^ABMDTMP("KBILL",ABM,ABM("D"))
S U="^"
K ABM,ABMP,ABML
I $D(^ABMDTMP("VCK",DT)),^(DT)'=$J,'$D(ABMDFN) Q
S:'$D(ABMDFN) ^ABMDTMP("VCK",DT)=$J
;Set up ABILL X-ref for parent of all added or changed I & D visits
N V,V0,P,P0
S ABMDT=""
F S ABMDT=$O(^AUPNVSIT("ABILL",ABMDT)) Q:'ABMDT D
.S V=""
.F S V=$O(^AUPNVSIT("ABILL",ABMDT,V)) Q:'V D
..S V0=$G(^AUPNVSIT(V,0))
..S SERVCAT=$P(V0,U,7)
..Q:"ID"'[SERVCAT ;SERVCAT needs to be either I or D
..I $D(ABMDFN),ABMDFN'=$P(V0,U,5) Q ;For a set patient
..S P=$P(V0,U,12)
..Q:'P
..S P0=$G(^AUPNVSIT(P,0))
..Q:"HOS"'[$P(P0,U,7)
..S ^AUPNVSIT("ABILL",+P0,P)=""
I $D(ABMDFN) D SITE Q ;For real time billing
;
LOOP ;LOOP THROUGH SITES
;start old code abm*2.6*11 HEAT86425
;Only loop through sites that are in the parameters file
S DUZ(2)=0
;start old abm*2.6*19 HEAT128988
;F S DUZ(2)=$O(^ABMDPARM(DUZ(2))) Q:+DUZ(2)=0 D Q:$G(ZTSTOP)
;.Q:$D(^ABMDPARM(DUZ(2),1))'=10
;.D SITE
;.D ^ABMDACK
;.S DIE="^ABMDPARM(DUZ(2),"
;.S DA=1
;.S DR=".21////"_DT
;.D ^ABMDDIE
;end old start new abm*2.6*19 HEAT128988
F S DUZ(2)=$O(^BAR(90052.05,DUZ(2))) Q:+DUZ(2)=0 D Q:$G(ZTSTOP)
.Q:$D(^ABMDPARM(DUZ(2),1))'=10
.I +$P($G(^ABMDPARM(DUZ(2),1,4)),U,9)=1 D LOOP2 Q
.S ABMHDUZ=DUZ(2)
.S DUZ(2)=0
.F S DUZ(2)=$O(^BAR(90052.05,ABMHDUZ,DUZ(2))) Q:+DUZ(2)=0 D Q:$G(ZTSTOP)
..Q:$D(^ABMDPARM(DUZ(2),1))'=10 ;abm*2.6*20 IHS/SD/SDR HEAT270671
..D LOOP2
.S DUZ(2)=ABMHDUZ
;end new code abm*2.6*19 HEAT128988
;end old code start new code HEAT86425
;K ABMPSLST
;S DUZ(2)=0
;F S DUZ(2)=$O(^BAR(90052.05,DUZ(2))) Q:'DUZ(2) D
;.S ABMLDFN=0
;.F S ABMLDFN=$O(^BAR(90052.05,DUZ(2),ABMLDFN)) Q:'ABMLDFN D
;..S ABMPSLST(DUZ(2),ABMLDFN)=$S(DUZ(2)=ABMLDFN:$P($G(^ABMDPARM(DUZ(2),1,4)),U,9),1:"")
;..I ABMLDFN=DUZ(2) S ABMPS(DUZ(2))=""
;;
;S ABMDUZ2=0
;F S ABMDUZ2=$O(ABMPS(ABMDUZ2)) Q:'ABMDUZ2 D
;.S ABMARPS=$G(ABMPSLST(ABMDUZ2,ABMDUZ2))
;.I ABMARPS D Q
;..S DUZ(2)=ABMDUZ2
;..Q:$D(^ABMDPARM(DUZ(2),1))'=10 ;not setup in 3P Parameters
;..D SITE
;..D ^ABMDACK
;..S DIE="^ABMDPARM(DUZ(2),"
;..S DA=1
;..S DR=".21////"_DT
;..D ^ABMDDIE
;.I 'ABMARPS D Q
;..S DUZ(2)=0
;..F S DUZ(2)=$O(ABMPSLST(ABMDUZ2,DUZ(2))) Q:'DUZ(2) D
;...Q:$D(^ABMDPARM(DUZ(2),1))'=10 ;not setup in 3P Parameters
;...D SITE
;...D ^ABMDACK
;...S DIE="^ABMDPARM(DUZ(2),"
;...S DA=1
;...S DR=".21////"_DT
;...D ^ABMDDIE
;end new code HEAT86425
K ^ABMDTMP("VCK")
K ABMP,ABMACTVI,ABMCOVD,ABMD,ABMPCAT,ABMPINS,ABMSRC,ABMV,DIE,DA,DR
K SERVCAT,X,X1,X2,Y0
Q
;start new abm*2.6*19 IHS/SD/SDR HEAT128988
LOOP2 ;
D SITE
D ^ABMDACK
S DIE="^ABMDPARM(DUZ(2),"
S DA=1
S DR=".21////"_DT
D ^ABMDDIE
Q
;end new code abm*2.6*19 IHS/SD/SDR HEAT128988
;
; *********************************************************************
SITE ;ONE SITE
I '$D(ABMDFN),$P(^ABMDPARM(DUZ(2),1,0),U,19) D ^ABMDBACK
;
AP ;AUTO PURGE CLAIMS
;start old abm*2.6*21 IHS/SD/SDR HEAT130406
;S ABM("DIF")=$S($P($G(^ABMDPARM(DUZ(2),1,2)),U,8):$P(^(2),U,8),1:180)
;S X1=DT
;S X2=-ABM("DIF")
;D C^%DTC
;S ABM("DIF")=X
;;X-ref AC on date last edited
;I '$D(ABMDFN) D
;.;F ABM("C")=0:0 S ABM("C")=$O(^ABMDCLM(DUZ(2),"AC",ABM("C"))) Q:'ABM("C") Q:ABM("C")>ABM("DIF") D
;..S ABMP("CDFN")=0
;..F S ABMP("CDFN")=$O(^ABMDCLM(DUZ(2),"AC",ABM("C"),ABMP("CDFN"))) Q:'ABMP("CDFN") D
;...Q:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),"^",4)="U"
;...Q:$D(^ABMDBILL(DUZ(2),"AS",ABMP("CDFN")))
;...;Kill claim
;...S DR=".04///2"
;...D KCLM^ABMDECAN
;end old abm*2.6*21 IHS/SD/SDR HEAT130406
;
VLP ;LOOP THROUGH VISITS IN VISIT FILE
;ABILL X-REF set in ABMDBACK. On date visit created
;ENDT is the entry date, not the end date
S ABMP("ENDT")=""
F S ABMP("ENDT")=$O(^AUPNVSIT("ABILL",ABMP("ENDT"))) Q:ABMP("ENDT")="" D Q:$G(ZTSTOP)
.S ABMVDFN=0
.F S ABMVDFN=$O(^AUPNVSIT("ABILL",ABMP("ENDT"),ABMVDFN)) Q:'ABMVDFN D Q:$G(ZTSTOP)
..S ABMODFN=ABMVDFN
..I $$S^%ZTLOAD S ZTSTOP=1 Q
..I $D(ABMDFN),'$D(^AUPNVSIT("AC",ABMDFN,ABMVDFN)) Q ;Real time claim
..D V2
..D:$G(ABMNFLG) ^ABMEAUTO
..K ABMNFLG
..I ABMVDFN="" S ABMVDFN=ABMODFN
..D RESET
K ^TMP($J,"PROC")
K ABMDFN
Q
;
; ********************************************************************
V2 ;CHECK VISIT (NEEDS ABMVDFN DEFINED)
;This entry point can be called from the debugger
;ABMP("V0") is the zero node of the visit file rec
;ABMDA is the ien of the V file source.
N SERVCAT,ABMHIEN,ABMDISDT,ABMPARNT,ABMDA
;ABMP("ENDT") is the entry date or the visit date
;ABMP("VDT") is the visit date (.01) with the time stripped off
Q:'$D(^AUPNVSIT(ABMVDFN,0))
S ABMP("V0")=^AUPNVSIT(ABMVDFN,0)
S ABMP("VDT")=$P(ABMP("V0"),U)\1
S SERVCAT=$P(ABMP("V0"),U,7)
; I is an offspring of an H category. O is more like an admission.
; It is not expected to be the offspring of H.
; ABMHIEN is the ien for the corresponding V HOSPITALIZATION entry
S ABMHIEN=$O(^AUPNVINP("AD",ABMVDFN,0))
S ABMDISDT=$S(ABMHIEN]"":$P(^AUPNVINP(ABMHIEN,0),U,1),1:0)
S ABMPARNT=$P(ABMP("V0"),U,12)
S ABMP("PRIMVSIT")=ABMVDFN
; I will also check the parent links to make sure these visits
; are being attached right.
S ABMIFLG=$$ICDCHK^ABMDVCK3(ABMVDFN) ;check for uncoded ICDs (.9999)
I $G(ABMIFLG)=1 D
.S ABMILAG=$P($G(^ABMDPARM(DUZ(2),1,5)),U,2)
.S X1=DT
.S X2=ABMP("VDT")
.D ^%DTC
.I X>ABMILAG K ABMIFLG ;past lag time
I $G(ABMIFLG)=1 D PCFL(59) Q ;error for uncoded Dx
;I "ASO"[SERVCAT,($P($G(^APCCCTRL(DUZ(2),0)),U,12)'=""),($P(^APCCCTRL(DUZ(2),0),U,12)'>ABMP("VDT")),($P($G(^AUPNVSIT(ABMVDFN,11)),U,11)'="R") D PCFL(60) Q ;EHR/Chart Audit Start Date ;abm*2.6*19 IHS/SD/SDR HEAT251398
I "ASOM"[SERVCAT,($P($G(^APCCCTRL(DUZ(2),0)),U,12)'=""),($P(^APCCCTRL(DUZ(2),0),U,12)'>ABMP("VDT")),($P($G(^AUPNVSIT(ABMVDFN,11)),U,11)'="R") D PCFL(60) Q ;EHR/Chart Audit Start Date ;abm*2.6*19 IHS/SD/SDR HEAT251398
I "AS"[SERVCAT D Q
.;If the visit has a parent and
.;the visit is in the date range I will treat it like an I type.
.I ABMPARNT]"",ABMP("VDT")'>ABMDISDT,ABMP("VDT")'<^AUPNVSIT(ABMPARNT,0) Q
.Q:$D(^TMP($J,"PROC",ABMVDFN))
.D VCHX^ABMDVCK0(ABMVDFN)
.; Assume children of S cat visit belong to the S visit
.Q:SERVCAT="A"
.S ABMV=""
.F S ABMV=$O(^AUPNVSIT("AD",ABMVDFN,ABMV)) Q:'ABMV D
..Q:$D(^TMP($J,"PROC",ABMV))
..I '$G(ABMP("CDFN")) D Q
...;No claim created for parent visit
...D PCFL(30)
...S ^TMP($J,"PROC",ABMV)=""
...D KABILL(ABMV,$P(^AUPNVSIT(ABMV,0),U,2))
..D VCHX^ABMDVCK0(ABMV)
..D KABILL(ABMV,$P(^AUPNVSIT(ABMV,0),U,2))
I "O"=SERVCAT,$P(ABMP("V0"),U,12)="" D Q
.Q:$D(^TMP($J,"PROC",ABMVDFN))
.D VCHX^ABMDVCK0(ABMVDFN)
.S ABMV=""
.F S ABMV=$O(^AUPNVSIT("AD",ABMVDFN,ABMV)) Q:'ABMV D
..Q:$D(^TMP($J,"PROC",ABMV))
..I '$G(ABMP("CDFN")) D Q
...;No claim created for parent visit
...D PCFL(30)
...S ^TMP($J,"PROC",ABMV)=""
...D KABILL(ABMV,$P(^AUPNVSIT(ABMV,0),U,2))
..S Y0=^AUPNVSIT(ABMV,0)
..I ABMP("VDT")>((+Y0)\1) D Q
...Q:$P(Y0,U,7)=""!("ID"'[$P(Y0,U,7))
...;I visit linked to an O visit on a different date.
...D PCFL(26)
...S ^TMP($J,"PROC",ABMV)=""
...D KABILL(ABMV,$P(^AUPNVSIT(ABMV,0),U,2))
..D VCHX^ABMDVCK0(ABMV)
..D KABILL(ABMV,$P(^AUPNVSIT(ABMV,0),U,2))
I "ID"[SERVCAT,ABMPARNT="" D VCHX^ABMDVCK0(ABMVDFN) Q
I "ID"[SERVCAT S ABMP("FLAG1")=1 Q
I "H"=SERVCAT D Q
.I $G(ABMHIEN)="" D PCFL(61) Q ;abm*2.6*11 HEAT89149
.I $G(ABMHIEN)'="",($P($G(^AUPNVINP(ABMHIEN,0)),U,15)'="") D PCFL(61) Q ;inpt coding complete?
.N ABMF,ABMACTVI
.I $D(^TMP($J,"PROC",ABMVDFN)) D Q:ABMF
..I $P(ABMP("V0"),U,4)>23 S ABMF=0 Q
..I $P(ABMP("V0"),U,12)="" S ABMF=0 Q
..S ABMF=1
..;Hospitalization with a parent link.
..S DIE="^AUPNVSIT("
..S DA=ABMVDFN
..S DR=".04////27"
..D ^DIE
.D VCHX^ABMDVCK0(ABMVDFN)
.S ABMV=""
.F S ABMV=$O(^AUPNVSIT("AD",ABMVDFN,ABMV)) Q:'ABMV D
..I '$G(ABMP("CDFN")) D Q
...;No claim created for parent visit
...S DIE="^AUPNVSIT("
...S DA=ABMV
...S DR=".04////30"
...D ^DIE
...S ^TMP($J,"PROC",ABMV)=""
...D KABILL(ABMV,$P(^AUPNVSIT(ABMV,0),U,2))
..D VCHX^ABMDVCK0(ABMV)
..N ABMEDT,ABMD,ABMF
..S ABMEDT=$P(^AUPNVSIT(ABMV,0),U,2)
..I '$D(^AUPNVSIT("ABILL",ABMEDT,ABMV)),$D(ABMP("ENDT")) D
...S ABMD=+^AUPNVSIT(ABMV,0)-.3
...S ABMF=0
...S ABMDL=$S($G(ABMP("DDT"))>ABMP("ENDT"):ABMP("DDT")+.25,ABMP("ENDT")>ABMEDT:ABMP("ENDT")+.25,1:ABMEDT+10000)
...F S ABMD=$O(^AUPNVSIT("ABILL",ABMD)) Q:'ABMD!(ABMD>ABMDL) D Q:ABMF
....Q:'$D(^AUPNVSIT("ABILL",ABMD,ABMV))
....S ABMF=1
....S ABMEDT=ABMD
..D KABILL(ABMV,ABMEDT)
.;I need code here to check if ABMP("DDT") exists and if so
.;ABMP("HDATE") is equal to it. If not I need a way to redo
.;ABMDVST4.
.I $D(ABMP("DDT")),ABMP("HDATE")<ABMP("DDT") D
..N ABMCHVDT,P,I
..;Vars need to be set up for use by ABMDVST4
..S ABMCHVDT=ABMP("DDT")
..S P=0
..F S P=$O(ABML(P)) Q:'P D Q:ABMP("PRI")=P
...S I=0
...F S I=$O(ABML(P,I)) Q:'I D Q:ABMP("INS")=I
....Q:I'=ABMACTVI
....S ABMP("PRI")=P
....S ABMP("INS")=I
..Q:ABMP("INS")=""
..D DISCHRG^ABMDVSTH
.S ABMV=""
.F S ABMV=$O(^AUPNVSIT("ABP",ABMVDFN,ABMV)) Q:'ABMV D
..;ABMVDFN is the H visit, ABMV may be an OP visit in 3 days.
..S V0=^AUPNVSIT(ABMV,0) ;Check for OP vis on admit day
..Q:$P(V0,U,11) ;Deleted visit
..Q:"AS"'[$P(V0,U,7)
..S X1=ABMP("VDT")
..S X2=-3
..D C^%DTC
..Q:$P(+V0,".")<X
..Q:$P(+V0,".")>ABMP("VDT")
..I '$D(ABMP("CDFN")) D Q
...;No claim created for parent visit
...S DIE="^AUPNVSIT("
...S DA=ABMV
...S DR=".04////30"
...D ^DIE
...S ^TMP($J,"PROC",ABMV)=""
...D KABILL(ABMV,$P(^AUPNVSIT(ABMV,0),U,2))
..D VCHX^ABMDVCK0(ABMV),KABILL(ABMV,$P(^AUPNVSIT(ABMV,0),U,2))
Q:$D(^TMP($J,"PROC",ABMVDFN))
D VCHX^ABMDVCK0(ABMVDFN)
Q
;
; ********************************************************************
KABILL(V,ENTDT) ;
I '$D(ENTDT) S ENTDT=$G(ABMP("ENDT"))
Q:'$D(^TMP($J,"PROC",V))
Q:$D(ABMP("LOCKFAIL"))
Q:$G(ABMP("NOKILLABILL"))
I $G(ENTDT),$G(ABMP("FLAG1")) K ^AUPNVSIT("ABILL",ENTDT,V)
Q
;
; *********************************************************************
RESET ;
D KABILL(ABMVDFN,ABMP("ENDT"))
S ABM("ENDT")=$G(ABMP("ENDT"))
K ABMP
S ABMP("ENDT")=ABM("ENDT")
K ABM,ABML,ABMI,ABMR,DA
Q
;
; *********************************************************************
PCFL(X) ;EP-file VISIT file field .04
S DIE="^AUPNVSIT("
S DA=ABMVDFN
S DR=".04////"_X
D ^DIE
Q
ABMDVCK ; IHS/ASDST/DMJ - PCC Visit Edits ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**11,19,20,21**;NOV 12, 2009;Build 379
+2 ;Original;TMD;08/19/96 4:49 PM
+3 ;Note special input variable ABMDFN
+4 ;It is optional
+5 ;If it is defined claims will be generated only for the one patient
+6 ;whose ien is the value of ABMDFN.
+7 ;If it is undefined claims will be generated for all patient with new
+8 ;PCC visits.
+9 ;
+10 ; IHS/SD/SDR - v2.5 p8
+11 ; Check for uncoded Dxs on visit
+12 ;
+13 ; IHS/SD/SDR - v2.5 p8
+14 ; Check PCC EHR/Chart Audit Start Date; if populated, the Chart Audit
+15 ; Status will need to be checked for ea visit with a service cat or
+16 ; A/O/S. If DOS is equal or after the Audit Start Date and the status
+17 ; is anything but REVIEWED the claim will not generate.
+18 ;
+19 ; IHS/SD/SDR - v2.5 p8 -When inpatient, check if coding complete field is null; if so, generate claim.
+20 ; IHS/SD/SDR - v2.5 p9 - IM19304 - Fix supplied by Jim Gray, checking to see if variable ABMP("INS") is set
+21 ; IHS/SD/SDR - v2.5 p9 - Fix to Uncoded Dxs to check lag time
+22 ; IHS/SD/SDR - v2.5 p10 - IM21846 - Made change to stop error <UNDEF>EXP+1^ABMDE2X5
+23 ;
+24 ;IHS/SD/SDR - 2.6*19 - HEAT128988 - Made change to CG to check A/R PARENT/SATELLITE SETUP so CG can check
+25 ; parent locations first, then satellites; claims were generated under wrong location when satellite IEN
+26 ; was lower than parent IEN.
+27 ;IHS/SD/SDR - 2.6*19 - HEAT251398 - Changed claim generator to allow service category TELEMEDICINE to
+28 ; generate claims.
+29 ;IHS/SD/SDR - 2.6*20 - HEAT270671 - Made change to stop <UNDEF>SITE+1^ABMDVCK error. Occurs when there is an entry
+30 ; in the A/R Parent/Satellite file but no matching entry in the 3P Parameter file.
+31 ;IHS/SD/SDR - 2.6*21 - HEAT130406 - Removed auto-purge of claims from CG.
+32 ; *********************************************************************
START ;START HERE
+1 IF DUZ(2)=""
SET DUZ(2)=1
+2 SET X="APCDCHKJ"
+3 ;See if rtn exists.
XECUTE ^%ZOSF("TEST")
+4 ;PCC linker - INPAT
IF $TEST
DO ^APCDCHKJ
+5 ;PCC relinker
IF '$DATA(ABMDFN)
DO ^APCDK
+6 NEW ABMVDFN,ABMCPTTB,ABMDT
+7 SET X1=DT
+8 SET X2=-180
+9 DO C^%DTC
+10 SET ABM("C")=X
+11 ;The ^ABMDTMP("KCLM" nodes are still being set in ver 2.0 as of 8/27/96
+12 SET ABM=0
+13 FOR
SET ABM=$ORDER(^ABMDTMP("KCLM",ABM))
IF 'ABM
QUIT
IF ABM>ABM("C")
QUIT
Begin DoDot:1
+14 SET ABM("D")=0
+15 FOR
SET ABM("D")=$ORDER(^ABMDTMP("KCLM",ABM,ABM("D")))
IF 'ABM("D")
QUIT
Begin DoDot:2
+16 KILL ^ABMDTMP("KCLM",ABM,ABM("D"))
End DoDot:2
End DoDot:1
+17 ;These ^ABMDTMP("KBILL" nodes are not being set in version 2.0
+18 ;These nodes are the audit trail from ver 1.6
+19 ;This checking must continue for 6 months after conversion from 1.6
+20 SET ABM=0
+21 FOR
SET ABM=$ORDER(^ABMDTMP("KBILL",ABM))
IF 'ABM
QUIT
IF ABM>ABM("C")
QUIT
Begin DoDot:1
+22 SET ABM("D")=0
+23 FOR
SET ABM("D")=$ORDER(^ABMDTMP("KBILL",ABM,ABM("D")))
IF 'ABM("D")
QUIT
Begin DoDot:2
+24 KILL ^ABMDTMP("KBILL",ABM,ABM("D"))
End DoDot:2
End DoDot:1
+25 SET U="^"
+26 KILL ABM,ABMP,ABML
+27 IF $DATA(^ABMDTMP("VCK",DT))
IF ^(DT)'=$JOB
IF '$DATA(ABMDFN)
QUIT
+28 IF '$DATA(ABMDFN)
SET ^ABMDTMP("VCK",DT)=$JOB
+29 ;Set up ABILL X-ref for parent of all added or changed I & D visits
+30 NEW V,V0,P,P0
+31 SET ABMDT=""
+32 FOR
SET ABMDT=$ORDER(^AUPNVSIT("ABILL",ABMDT))
IF 'ABMDT
QUIT
Begin DoDot:1
+33 SET V=""
+34 FOR
SET V=$ORDER(^AUPNVSIT("ABILL",ABMDT,V))
IF 'V
QUIT
Begin DoDot:2
+35 SET V0=$GET(^AUPNVSIT(V,0))
+36 SET SERVCAT=$PIECE(V0,U,7)
+37 ;SERVCAT needs to be either I or D
IF "ID"'[SERVCAT
QUIT
+38 ;For a set patient
IF $DATA(ABMDFN)
IF ABMDFN'=$PIECE(V0,U,5)
QUIT
+39 SET P=$PIECE(V0,U,12)
+40 IF 'P
QUIT
+41 SET P0=$GET(^AUPNVSIT(P,0))
+42 IF "HOS"'[$PIECE(P0,U,7)
QUIT
+43 SET ^AUPNVSIT("ABILL",+P0,P)=""
End DoDot:2
End DoDot:1
+44 ;For real time billing
IF $DATA(ABMDFN)
DO SITE
QUIT
+45 ;
LOOP ;LOOP THROUGH SITES
+1 ;start old code abm*2.6*11 HEAT86425
+2 ;Only loop through sites that are in the parameters file
+3 SET DUZ(2)=0
+4 ;start old abm*2.6*19 HEAT128988
+5 ;F S DUZ(2)=$O(^ABMDPARM(DUZ(2))) Q:+DUZ(2)=0 D Q:$G(ZTSTOP)
+6 ;.Q:$D(^ABMDPARM(DUZ(2),1))'=10
+7 ;.D SITE
+8 ;.D ^ABMDACK
+9 ;.S DIE="^ABMDPARM(DUZ(2),"
+10 ;.S DA=1
+11 ;.S DR=".21////"_DT
+12 ;.D ^ABMDDIE
+13 ;end old start new abm*2.6*19 HEAT128988
+14 FOR
SET DUZ(2)=$ORDER(^BAR(90052.05,DUZ(2)))
IF +DUZ(2)=0
QUIT
Begin DoDot:1
+15 IF $DATA(^ABMDPARM(DUZ(2),1))'=10
QUIT
+16 IF +$PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,9)=1
DO LOOP2
QUIT
+17 SET ABMHDUZ=DUZ(2)
+18 SET DUZ(2)=0
+19 FOR
SET DUZ(2)=$ORDER(^BAR(90052.05,ABMHDUZ,DUZ(2)))
IF +DUZ(2)=0
QUIT
Begin DoDot:2
+20 ;abm*2.6*20 IHS/SD/SDR HEAT270671
IF $DATA(^ABMDPARM(DUZ(2),1))'=10
QUIT
+21 DO LOOP2
End DoDot:2
IF $GET(ZTSTOP)
QUIT
+22 SET DUZ(2)=ABMHDUZ
End DoDot:1
IF $GET(ZTSTOP)
QUIT
+23 ;end new code abm*2.6*19 HEAT128988
+24 ;end old code start new code HEAT86425
+25 ;K ABMPSLST
+26 ;S DUZ(2)=0
+27 ;F S DUZ(2)=$O(^BAR(90052.05,DUZ(2))) Q:'DUZ(2) D
+28 ;.S ABMLDFN=0
+29 ;.F S ABMLDFN=$O(^BAR(90052.05,DUZ(2),ABMLDFN)) Q:'ABMLDFN D
+30 ;..S ABMPSLST(DUZ(2),ABMLDFN)=$S(DUZ(2)=ABMLDFN:$P($G(^ABMDPARM(DUZ(2),1,4)),U,9),1:"")
+31 ;..I ABMLDFN=DUZ(2) S ABMPS(DUZ(2))=""
+32 ;;
+33 ;S ABMDUZ2=0
+34 ;F S ABMDUZ2=$O(ABMPS(ABMDUZ2)) Q:'ABMDUZ2 D
+35 ;.S ABMARPS=$G(ABMPSLST(ABMDUZ2,ABMDUZ2))
+36 ;.I ABMARPS D Q
+37 ;..S DUZ(2)=ABMDUZ2
+38 ;..Q:$D(^ABMDPARM(DUZ(2),1))'=10 ;not setup in 3P Parameters
+39 ;..D SITE
+40 ;..D ^ABMDACK
+41 ;..S DIE="^ABMDPARM(DUZ(2),"
+42 ;..S DA=1
+43 ;..S DR=".21////"_DT
+44 ;..D ^ABMDDIE
+45 ;.I 'ABMARPS D Q
+46 ;..S DUZ(2)=0
+47 ;..F S DUZ(2)=$O(ABMPSLST(ABMDUZ2,DUZ(2))) Q:'DUZ(2) D
+48 ;...Q:$D(^ABMDPARM(DUZ(2),1))'=10 ;not setup in 3P Parameters
+49 ;...D SITE
+50 ;...D ^ABMDACK
+51 ;...S DIE="^ABMDPARM(DUZ(2),"
+52 ;...S DA=1
+53 ;...S DR=".21////"_DT
+54 ;...D ^ABMDDIE
+55 ;end new code HEAT86425
+56 KILL ^ABMDTMP("VCK")
+57 KILL ABMP,ABMACTVI,ABMCOVD,ABMD,ABMPCAT,ABMPINS,ABMSRC,ABMV,DIE,DA,DR
+58 KILL SERVCAT,X,X1,X2,Y0
+59 QUIT
+60 ;start new abm*2.6*19 IHS/SD/SDR HEAT128988
LOOP2 ;
+1 DO SITE
+2 DO ^ABMDACK
+3 SET DIE="^ABMDPARM(DUZ(2),"
+4 SET DA=1
+5 SET DR=".21////"_DT
+6 DO ^ABMDDIE
+7 QUIT
+8 ;end new code abm*2.6*19 IHS/SD/SDR HEAT128988
+9 ;
+10 ; *********************************************************************
SITE ;ONE SITE
+1 IF '$DATA(ABMDFN)
IF $PIECE(^ABMDPARM(DUZ(2),1,0),U,19)
DO ^ABMDBACK
+2 ;
AP ;AUTO PURGE CLAIMS
+1 ;start old abm*2.6*21 IHS/SD/SDR HEAT130406
+2 ;S ABM("DIF")=$S($P($G(^ABMDPARM(DUZ(2),1,2)),U,8):$P(^(2),U,8),1:180)
+3 ;S X1=DT
+4 ;S X2=-ABM("DIF")
+5 ;D C^%DTC
+6 ;S ABM("DIF")=X
+7 ;;X-ref AC on date last edited
+8 ;I '$D(ABMDFN) D
+9 ;.;F ABM("C")=0:0 S ABM("C")=$O(^ABMDCLM(DUZ(2),"AC",ABM("C"))) Q:'ABM("C") Q:ABM("C")>ABM("DIF") D
+10 ;..S ABMP("CDFN")=0
+11 ;..F S ABMP("CDFN")=$O(^ABMDCLM(DUZ(2),"AC",ABM("C"),ABMP("CDFN"))) Q:'ABMP("CDFN") D
+12 ;...Q:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),"^",4)="U"
+13 ;...Q:$D(^ABMDBILL(DUZ(2),"AS",ABMP("CDFN")))
+14 ;...;Kill claim
+15 ;...S DR=".04///2"
+16 ;...D KCLM^ABMDECAN
+17 ;end old abm*2.6*21 IHS/SD/SDR HEAT130406
+18 ;
VLP ;LOOP THROUGH VISITS IN VISIT FILE
+1 ;ABILL X-REF set in ABMDBACK. On date visit created
+2 ;ENDT is the entry date, not the end date
+3 SET ABMP("ENDT")=""
+4 FOR
SET ABMP("ENDT")=$ORDER(^AUPNVSIT("ABILL",ABMP("ENDT")))
IF ABMP("ENDT")=""
QUIT
Begin DoDot:1
+5 SET ABMVDFN=0
+6 FOR
SET ABMVDFN=$ORDER(^AUPNVSIT("ABILL",ABMP("ENDT"),ABMVDFN))
IF 'ABMVDFN
QUIT
Begin DoDot:2
+7 SET ABMODFN=ABMVDFN
+8 IF $$S^%ZTLOAD
SET ZTSTOP=1
QUIT
+9 ;Real time claim
IF $DATA(ABMDFN)
IF '$DATA(^AUPNVSIT("AC",ABMDFN,ABMVDFN))
QUIT
+10 DO V2
+11 IF $GET(ABMNFLG)
DO ^ABMEAUTO
+12 KILL ABMNFLG
+13 IF ABMVDFN=""
SET ABMVDFN=ABMODFN
+14 DO RESET
End DoDot:2
IF $GET(ZTSTOP)
QUIT
End DoDot:1
IF $GET(ZTSTOP)
QUIT
+15 KILL ^TMP($JOB,"PROC")
+16 KILL ABMDFN
+17 QUIT
+18 ;
+19 ; ********************************************************************
V2 ;CHECK VISIT (NEEDS ABMVDFN DEFINED)
+1 ;This entry point can be called from the debugger
+2 ;ABMP("V0") is the zero node of the visit file rec
+3 ;ABMDA is the ien of the V file source.
+4 NEW SERVCAT,ABMHIEN,ABMDISDT,ABMPARNT,ABMDA
+5 ;ABMP("ENDT") is the entry date or the visit date
+6 ;ABMP("VDT") is the visit date (.01) with the time stripped off
+7 IF '$DATA(^AUPNVSIT(ABMVDFN,0))
QUIT
+8 SET ABMP("V0")=^AUPNVSIT(ABMVDFN,0)
+9 SET ABMP("VDT")=$PIECE(ABMP("V0"),U)\1
+10 SET SERVCAT=$PIECE(ABMP("V0"),U,7)
+11 ; I is an offspring of an H category. O is more like an admission.
+12 ; It is not expected to be the offspring of H.
+13 ; ABMHIEN is the ien for the corresponding V HOSPITALIZATION entry
+14 SET ABMHIEN=$ORDER(^AUPNVINP("AD",ABMVDFN,0))
+15 SET ABMDISDT=$SELECT(ABMHIEN]"":$PIECE(^AUPNVINP(ABMHIEN,0),U,1),1:0)
+16 SET ABMPARNT=$PIECE(ABMP("V0"),U,12)
+17 SET ABMP("PRIMVSIT")=ABMVDFN
+18 ; I will also check the parent links to make sure these visits
+19 ; are being attached right.
+20 ;check for uncoded ICDs (.9999)
SET ABMIFLG=$$ICDCHK^ABMDVCK3(ABMVDFN)
+21 IF $GET(ABMIFLG)=1
Begin DoDot:1
+22 SET ABMILAG=$PIECE($GET(^ABMDPARM(DUZ(2),1,5)),U,2)
+23 SET X1=DT
+24 SET X2=ABMP("VDT")
+25 DO ^%DTC
+26 ;past lag time
IF X>ABMILAG
KILL ABMIFLG
End DoDot:1
+27 ;error for uncoded Dx
IF $GET(ABMIFLG)=1
DO PCFL(59)
QUIT
+28 ;I "ASO"[SERVCAT,($P($G(^APCCCTRL(DUZ(2),0)),U,12)'=""),($P(^APCCCTRL(DUZ(2),0),U,12)'>ABMP("VDT")),($P($G(^AUPNVSIT(ABMVDFN,11)),U,11)'="R") D PCFL(60) Q ;EHR/Chart Audit Start Date ;abm*2.6*19 IHS/SD/SDR HEAT251398
+29 ;EHR/Chart Audit Start Date ;abm*2.6*19 IHS/SD/SDR HEAT251398
IF "ASOM"[SERVCAT
IF ($PIECE($GET(^APCCCTRL(DUZ(2),0)),U,12)'="")
IF ($PIECE(^APCCCTRL(DUZ(2),0),U,12)'>ABMP("VDT"))
IF ($PIECE($GET(^AUPNVSIT(ABMVDFN,11)),U,11)'="R")
DO PCFL(60)
QUIT
+30 IF "AS"[SERVCAT
Begin DoDot:1
+31 ;If the visit has a parent and
+32 ;the visit is in the date range I will treat it like an I type.
+33 IF ABMPARNT]""
IF ABMP("VDT")'>ABMDISDT
IF ABMP("VDT")'<^AUPNVSIT(ABMPARNT,0)
QUIT
+34 IF $DATA(^TMP($JOB,"PROC",ABMVDFN))
QUIT
+35 DO VCHX^ABMDVCK0(ABMVDFN)
+36 ; Assume children of S cat visit belong to the S visit
+37 IF SERVCAT="A"
QUIT
+38 SET ABMV=""
+39 FOR
SET ABMV=$ORDER(^AUPNVSIT("AD",ABMVDFN,ABMV))
IF 'ABMV
QUIT
Begin DoDot:2
+40 IF $DATA(^TMP($JOB,"PROC",ABMV))
QUIT
+41 IF '$GET(ABMP("CDFN"))
Begin DoDot:3
+42 ;No claim created for parent visit
+43 DO PCFL(30)
+44 SET ^TMP($JOB,"PROC",ABMV)=""
+45 DO KABILL(ABMV,$PIECE(^AUPNVSIT(ABMV,0),U,2))
End DoDot:3
QUIT
+46 DO VCHX^ABMDVCK0(ABMV)
+47 DO KABILL(ABMV,$PIECE(^AUPNVSIT(ABMV,0),U,2))
End DoDot:2
End DoDot:1
QUIT
+48 IF "O"=SERVCAT
IF $PIECE(ABMP("V0"),U,12)=""
Begin DoDot:1
+49 IF $DATA(^TMP($JOB,"PROC",ABMVDFN))
QUIT
+50 DO VCHX^ABMDVCK0(ABMVDFN)
+51 SET ABMV=""
+52 FOR
SET ABMV=$ORDER(^AUPNVSIT("AD",ABMVDFN,ABMV))
IF 'ABMV
QUIT
Begin DoDot:2
+53 IF $DATA(^TMP($JOB,"PROC",ABMV))
QUIT
+54 IF '$GET(ABMP("CDFN"))
Begin DoDot:3
+55 ;No claim created for parent visit
+56 DO PCFL(30)
+57 SET ^TMP($JOB,"PROC",ABMV)=""
+58 DO KABILL(ABMV,$PIECE(^AUPNVSIT(ABMV,0),U,2))
End DoDot:3
QUIT
+59 SET Y0=^AUPNVSIT(ABMV,0)
+60 IF ABMP("VDT")>((+Y0)\1)
Begin DoDot:3
+61 IF $PIECE(Y0,U,7)=""!("ID"'[$PIECE(Y0,U,7))
QUIT
+62 ;I visit linked to an O visit on a different date.
+63 DO PCFL(26)
+64 SET ^TMP($JOB,"PROC",ABMV)=""
+65 DO KABILL(ABMV,$PIECE(^AUPNVSIT(ABMV,0),U,2))
End DoDot:3
QUIT
+66 DO VCHX^ABMDVCK0(ABMV)
+67 DO KABILL(ABMV,$PIECE(^AUPNVSIT(ABMV,0),U,2))
End DoDot:2
End DoDot:1
QUIT
+68 IF "ID"[SERVCAT
IF ABMPARNT=""
DO VCHX^ABMDVCK0(ABMVDFN)
QUIT
+69 IF "ID"[SERVCAT
SET ABMP("FLAG1")=1
QUIT
+70 IF "H"=SERVCAT
Begin DoDot:1
+71 ;abm*2.6*11 HEAT89149
IF $GET(ABMHIEN)=""
DO PCFL(61)
QUIT
+72 ;inpt coding complete?
IF $GET(ABMHIEN)'=""
IF ($PIECE($GET(^AUPNVINP(ABMHIEN,0)),U,15)'="")
DO PCFL(61)
QUIT
+73 NEW ABMF,ABMACTVI
+74 IF $DATA(^TMP($JOB,"PROC",ABMVDFN))
Begin DoDot:2
+75 IF $PIECE(ABMP("V0"),U,4)>23
SET ABMF=0
QUIT
+76 IF $PIECE(ABMP("V0"),U,12)=""
SET ABMF=0
QUIT
+77 SET ABMF=1
+78 ;Hospitalization with a parent link.
+79 SET DIE="^AUPNVSIT("
+80 SET DA=ABMVDFN
+81 SET DR=".04////27"
+82 DO ^DIE
End DoDot:2
IF ABMF
QUIT
+83 DO VCHX^ABMDVCK0(ABMVDFN)
+84 SET ABMV=""
+85 FOR
SET ABMV=$ORDER(^AUPNVSIT("AD",ABMVDFN,ABMV))
IF 'ABMV
QUIT
Begin DoDot:2
+86 IF '$GET(ABMP("CDFN"))
Begin DoDot:3
+87 ;No claim created for parent visit
+88 SET DIE="^AUPNVSIT("
+89 SET DA=ABMV
+90 SET DR=".04////30"
+91 DO ^DIE
+92 SET ^TMP($JOB,"PROC",ABMV)=""
+93 DO KABILL(ABMV,$PIECE(^AUPNVSIT(ABMV,0),U,2))
End DoDot:3
QUIT
+94 DO VCHX^ABMDVCK0(ABMV)
+95 NEW ABMEDT,ABMD,ABMF
+96 SET ABMEDT=$PIECE(^AUPNVSIT(ABMV,0),U,2)
+97 IF '$DATA(^AUPNVSIT("ABILL",ABMEDT,ABMV))
IF $DATA(ABMP("ENDT"))
Begin DoDot:3
+98 SET ABMD=+^AUPNVSIT(ABMV,0)-.3
+99 SET ABMF=0
+100 SET ABMDL=$SELECT($GET(ABMP("DDT"))>ABMP("ENDT"):ABMP("DDT")+.25,ABMP("ENDT")>ABMEDT:ABMP("ENDT")+.25,1:ABMEDT+10000)
+101 FOR
SET ABMD=$ORDER(^AUPNVSIT("ABILL",ABMD))
IF 'ABMD!(ABMD>ABMDL)
QUIT
Begin DoDot:4
+102 IF '$DATA(^AUPNVSIT("ABILL",ABMD,ABMV))
QUIT
+103 SET ABMF=1
+104 SET ABMEDT=ABMD
End DoDot:4
IF ABMF
QUIT
End DoDot:3
+105 DO KABILL(ABMV,ABMEDT)
End DoDot:2
+106 ;I need code here to check if ABMP("DDT") exists and if so
+107 ;ABMP("HDATE") is equal to it. If not I need a way to redo
+108 ;ABMDVST4.
+109 IF $DATA(ABMP("DDT"))
IF ABMP("HDATE")<ABMP("DDT")
Begin DoDot:2
+110 NEW ABMCHVDT,P,I
+111 ;Vars need to be set up for use by ABMDVST4
+112 SET ABMCHVDT=ABMP("DDT")
+113 SET P=0
+114 FOR
SET P=$ORDER(ABML(P))
IF 'P
QUIT
Begin DoDot:3
+115 SET I=0
+116 FOR
SET I=$ORDER(ABML(P,I))
IF 'I
QUIT
Begin DoDot:4
+117 IF I'=ABMACTVI
QUIT
+118 SET ABMP("PRI")=P
+119 SET ABMP("INS")=I
End DoDot:4
IF ABMP("INS")=I
QUIT
End DoDot:3
IF ABMP("PRI")=P
QUIT
+120 IF ABMP("INS")=""
QUIT
+121 DO DISCHRG^ABMDVSTH
End DoDot:2
+122 SET ABMV=""
+123 FOR
SET ABMV=$ORDER(^AUPNVSIT("ABP",ABMVDFN,ABMV))
IF 'ABMV
QUIT
Begin DoDot:2
+124 ;ABMVDFN is the H visit, ABMV may be an OP visit in 3 days.
+125 ;Check for OP vis on admit day
SET V0=^AUPNVSIT(ABMV,0)
+126 ;Deleted visit
IF $PIECE(V0,U,11)
QUIT
+127 IF "AS"'[$PIECE(V0,U,7)
QUIT
+128 SET X1=ABMP("VDT")
+129 SET X2=-3
+130 DO C^%DTC
+131 IF $PIECE(+V0,".")<X
QUIT
+132 IF $PIECE(+V0,".")>ABMP("VDT")
QUIT
+133 IF '$DATA(ABMP("CDFN"))
Begin DoDot:3
+134 ;No claim created for parent visit
+135 SET DIE="^AUPNVSIT("
+136 SET DA=ABMV
+137 SET DR=".04////30"
+138 DO ^DIE
+139 SET ^TMP($JOB,"PROC",ABMV)=""
+140 DO KABILL(ABMV,$PIECE(^AUPNVSIT(ABMV,0),U,2))
End DoDot:3
QUIT
+141 DO VCHX^ABMDVCK0(ABMV)
DO KABILL(ABMV,$PIECE(^AUPNVSIT(ABMV,0),U,2))
End DoDot:2
End DoDot:1
QUIT
+142 IF $DATA(^TMP($JOB,"PROC",ABMVDFN))
QUIT
+143 DO VCHX^ABMDVCK0(ABMVDFN)
+144 QUIT
+145 ;
+146 ; ********************************************************************
KABILL(V,ENTDT) ;
+1 IF '$DATA(ENTDT)
SET ENTDT=$GET(ABMP("ENDT"))
+2 IF '$DATA(^TMP($JOB,"PROC",V))
QUIT
+3 IF $DATA(ABMP("LOCKFAIL"))
QUIT
+4 IF $GET(ABMP("NOKILLABILL"))
QUIT
+5 IF $GET(ENTDT)
IF $GET(ABMP("FLAG1"))
KILL ^AUPNVSIT("ABILL",ENTDT,V)
+6 QUIT
+7 ;
+8 ; *********************************************************************
RESET ;
+1 DO KABILL(ABMVDFN,ABMP("ENDT"))
+2 SET ABM("ENDT")=$GET(ABMP("ENDT"))
+3 KILL ABMP
+4 SET ABMP("ENDT")=ABM("ENDT")
+5 KILL ABM,ABML,ABMI,ABMR,DA
+6 QUIT
+7 ;
+8 ; *********************************************************************
PCFL(X) ;EP-file VISIT file field .04
+1 SET DIE="^AUPNVSIT("
+2 SET DA=ABMVDFN
+3 SET DR=".04////"_X
+4 DO ^DIE
+5 QUIT
