ABMDVST ; IHS/ASDST/DMJ - PCC Visit Stuff ;
;;2.6;IHS 3P BILLING SYSTEM;**10,19,22**;NOV 12, 2009;Build 418
;Original;TMD;08/19/96 4:45 PM
;
; IHS/SD/SDR - V2.5 P8 - IM12246/IM17548 - Added code to put defaults on claim for CLIAs
; IHS/SD/SDR - v2.5 p8 - task 8 - Added tag for insurer replace and splitting routine
; IHS/SD/SDR - v2.5 p10 - IM19717/IM20374 - Added to check for when to merge visits into one claim
; IHS/SD/SDR - v2.5 p10 - IM20610 - Fix Medicare Part B check so only one claim will generate
; IHS/SD/SDR - v2.5 p10 - task order item 1 - Calls for ChargeMaster added to national code. Calls were
; supplied by Lori Butcher
; IHS/SD/SDR - v2.5 p10 - IM21500 - Added code to check new V Med field POINT OF SALE BILLING STATUS
; and only generate claim if at least one med wasn't billed by POS or was billed and rejected
;
;IHS/SD/SDR - 2.6*19 - HEAT251217 - Made change to populate SERVICE DATE FROM and SERVICE DATE TO all the time.
;IHS/SD/SDR 2.6*22 HEAT335246 - Added call to claim splitter
; *********************************************************************
VAR ;
N ABMSRC,DA,DIE,DIK
K ABMP("DUP"),ABMP("NEWBORN")
I '$D(ABMP("VTYP")) D
.S ABMP("VTYP")=$$VTYP^ABMDVCK1(ABMVDFN,SERVCAT,ABMP("INS"),ABMP("CLN"))
I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,7)="N" D Q
.S DIE="^AUPNVSIT("
.S DA=ABMVDFN
.S DR=".04////22"
.D ^DIE
;Find new Claim ien if ien null
;Not sure what will happen here if the claim is a split claim.
;Clearly only one claim will be updated.
I '$G(ABMP("CDFN")) S ABMP("CDFN")=$O(^ABMDCLM(DUZ(2),"AV",ABMVDFN,""))
I ABMP("CDFN")<1 S ABM=0 F S ABM=$O(^ABMDCLM(DUZ(2),"B",ABMP("PDFN"),ABM)) Q:'ABM D Q:ABMP("CDFN")
.I '$D(^ABMDCLM(DUZ(2),ABM,0)) K ^ABMDCLM(DUZ(2),"B",ABMP("PDFN"),ABM) Q
.Q:$P($G(^ABMDCLM(DUZ(2),ABM,0)),U,2)'=ABMP("VDT") ;encounter(visit) date
.Q:$P($G(^ABMDCLM(DUZ(2),ABM,0)),U,3)'=ABMP("LDFN") ;visit location
.Q:$P($G(^ABMDCLM(DUZ(2),ABM,0)),U,7)'=ABMP("VTYP") ;visit type
.Q:$P($G(^ABMDCLM(DUZ(2),ABM,0)),U,6)'=ABMP("CLN") ;clinic
.D GETPPRV ;get primary provider
.D GETPPOV ;find primary DX
.I ABMVPRV'=0,(ABMCPRV=ABMVPRV),(ABMVICD'=0),(ABMCICD=ABMVICD) S ABMP("CDFN")=ABM
I ABMARPS,ABMP("CDFN")<1 D Q:$G(ABMP("NOKILLABILL"))=2
.S ABMP("CDFN")=$O(^ABMDCLM(ABMP("LDFN"),"AV",ABMVDFN,""))
.I ABMP("CDFN"),'$D(^ABMDCLM(ABMP("LDFN"),ABMP("CDFN"),0)) D
..K ^ABMDCLM(ABMP("LDFN"),"AV",ABMVDFN,ABMP("CDFN"))
..S ABMP("CDFN")=0
.Q:ABMP("CDFN")<1
.S ABMP("NOKILLABILL")=2
G NEW:ABMP("CDFN")<1
Q:$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0))=""
;25= Existing claim modified
N R
S R=$P(^AUPNVSIT(ABMVDFN,0),U,4)
I R'=24!((R=24)&('$D(ABMNFLG))),R'=25 D
.S DIE="^AUPNVSIT("
.S DA=ABMVDFN
.S DR=".04////25"
.D ^DIE
L +^ABMDCLM(DUZ(2),ABMP("CDFN")):10 E S ABMP("LOCKFAIL")=1 Q
S DR=""
S Y=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
I $P(Y,U,10)'=DT D
.S DR=".1////"_DT
I $P(Y,U,2)'=ABMP("VDT") D
.S DR=".02////"_ABMP("VDT")_$S(DR]"":";"_DR,1:"")
S DR=$S(DR]"":DR_";",1:"")_".06////"_ABMP("CLN")
I $P(Y,U,7)'=ABMP("VTYP"),$D(ABMP("PRIMVSIT")) D
.S DR=$S(DR]"":DR_";",1:"")_".07////"_ABMP("VTYP")
;The following works because the only way that 97 will be the value is
;if the primary insurer is billed elswhere (e.g. Data Center)
I ABMP("PRI")=97 S DR=$S(DR]"":DR_";",1:"")_".04////U;.08////"_ABMP("INS")
;The next line checks the active insurer field. If it is null & the
;insurer in ABMP("INS") is the primary insurer set and the mode of
;export
I $P(Y,U,8)="",DR'[".08",'$O(ABML(ABMP("PRI")),-1),$O(ABML(ABMP("PRI"),""))=ABMP("INS") D
.N ABMMODE
.S ABMMODE=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,4)
.S DR=$S(DR]"":DR_";",1:"")_".08////"_ABMP("INS")_$S(ABMMODE:";.14///"_ABMMODE,1:"")
I DR]"" D
.S DIE="^ABMDCLM(DUZ(2),"
.S DA=ABMP("CDFN")
.D ^DIE
D VSIT
D FRATE
D OTHER
;if routine BCMZINHO exists and there are tran codes in the table run BCMZINHO
I $T(^BCMZINHO)]"",$O(^BCMTCA(0)) D:$D(^AUPNVSIT("AD",ABMVDFN)) ^BCMZINHO ;IHS/CMI/LAB-chargemaster call
I $O(^ABMDBILL(DUZ(2),"AV",ABMVDFN,0)),$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)'="U" D Q:ABM("OUT")
.S ABM("OUT")=1
.Q:$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"B",ABMP("INS")))
.S DA=$O(^ABMDBILL(DUZ(2),"AV",ABMVDFN,0))
.S ABM=$P($G(^ABMDBILL(DUZ(2),DA,0)),U,8) ; Active Insurer
.Q:'ABM
.;I $P($G(^AUTNINS(ABM,2)),U)="I" D ;Type of ins = Indian Pat ;abm*2.6*10 HEAT73780
.I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM,".211","I"),1,"I")="I" D ;Type of ins = Indian Pat ;abm*2.6*10 HEAT73780
..S ABM("OUT")=0
..S DIE="^ABMDBILL(DUZ(2),"
..S DR=".04////X" ;Mark bill as cancelled
..D ^ABMDDIE
..S DIE="^ABMDCLM(DUZ(2),"
..S DA=ABMP("CDFN")
..S DR=".04////F;.08////"_ABMP("INS")
..D ^ABMDDIE
I $D(^ABMDBILL(DUZ(2),"AS",ABMP("CDFN"))) Q
Q
;
; *********************************************************************
NEW ;CREATE NEW CLAIM
I $D(^ABMDBILL(DUZ(2),"AV",ABMVDFN)) D Q
.S DIE="^AUPNVSIT("
.S DA=ABMVDFN
.S DR=".04////20"
.D ^DIE
;BILLED POS insurer?
I $P($G(^AUTNINS(ABMP("INS"),2)),U,3)="P" D
.S ABMVMIEN=0
.F S ABMVMIEN=$O(^AUPNVMED("AD",ABMVDFN,ABMVMIEN)) Q:+ABMVMIEN=0 D Q:$G(ABMPSFLG)=1
..I $P($G(^AUPNVMED(ABMVMIEN,11)),U,6)'=1 S ABMPSFLG=1
I $D(^AUPNVMED("AD",ABMVDFN)),$P($G(^AUTNINS(ABMP("INS"),2)),U,3)="P",($G(ABMPSFLG)'=1) D Q
.K ABMPSFLG
.D PCFL^ABMDVCK(62) ;billed POS
S DINUM=$$NXNM^ABMDUTL
I DINUM="" S ABMP("NOKILLABILL")=1 Q
K DIC
S DIC="^ABMDCLM(DUZ(2),"
S DIC(0)="L"
S X=ABMP("PDFN")
K DD,DO
D FILE^DICN
I Y<1 S ABMP("NOKILLABILL")=1 Q
S ABMP("CDFN")=+Y
L +^ABMDCLM(DUZ(2),+Y):1 E S ABMP("LOCKFAIL")=1 Q
S DA=+Y
S DIE=DIC
S DR=".02////"_$P($P(ABMP("V0"),U),".")_";.03////"_ABMP("LDFN")
S DR=DR_";.04////"_"F"_";.06////"_ABMP("CLN")_";.07////"_ABMP("VTYP")
;No active insurer if one insurer billed elsewhere
I '$D(ABML(97)) S DR=DR_";.08////"_ABMP("INS")
S DR=DR_";.1////"_DT_";.17////"_DT
S DR=DR_";.71////"_$P($P(ABMP("V0"),U),".")_";.72////"_$P($P(ABMP("V0"),U),".") ;abm*2.6*19 IHS/SD/SDR HEAT251217
D ^DIE
S DIE="^AUPNVSIT("
S DA=ABMVDFN
S DR=".04////24"
D ^DIE
D VSIT
S ABMNFLG=1
D FRATE
D OTHER
;if routine BCMZINHO exists and there are tran codes in the table run BCMZINHO
I $T(^BCMZINHO)]"",$O(^BCMTCA(0)) D:$D(^AUPNVSIT("AD",ABMVDFN)) ^BCMZINHO ;IHS/CMI/LAB-chargemaster call
K X,Y
D ^ABMPSPLT ;abm*2.6*22 IHS/SD/SDR HEAT335246
D MAIN^ABMASPLT(ABMP("CDFN"))
;I $P($G(^AUTNINS(+ABMP("INS"),2)),U)="R" D ;abm*2.6*10 HEAT73780
I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMP("INS"),".211","I"),1,"I")="R" D ;abm*2.6*10 HEAT73780
.S ABMBONLY=$S($P($G(^ABMDPARM(ABMP("LDFN"),1,5)),U)'="":$P(^ABMDPARM(ABMP("LDFN"),1,5),U),1:2)
.I (ABMBONLY'=2) Q
.D MAIN^ABMDSPLB(ABMP("CDFN"))
Q
;
; *********************************************************************
VSIT ;
S DA(1)=ABMP("CDFN")
S DIC="^ABMDCLM(DUZ(2),"_DA(1)_",11,"
S DIC(0)="LE"
I $D(@(DIC_ABMVDFN_")")),'$D(ABMP("PRIMVSIT")) Q
;This section needs to be done for non-new claims
;Direct set into the claim file
S DIC("P")=$P(^DD(9002274.3,11,0),U,2)
K DD,DO,DR,DIC("DR")
I $D(ABMP("PRIMVSIT")) S DIC("DR")=".02////P"
S (X,DINUM)=ABMVDFN
I '$D(@(DIC_ABMVDFN_")")) D
.D FILE^DICN
E D
.S DIE=DIC
.S DR=DIC("DR")
.S DA=DINUM
.D ^DIE
.K DIE,DR,DINUM
K DIC
Q
;
; *********************************************************************
FRATE ;
;I need code to prevent 2nd visit on claim from undoing eligibility
N V,INSADD,INSSKIP
S V=0
F S V=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,V)) Q:'V D Q:$D(INSADD)
.I V'=ABMVDFN,$D(^TMP($J,"PROC",V)) D
..S IEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"B",ABMP("INS"),""))
..I 'IEN S INSADD="" Q
..I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,IEN,0),U,3)?1(1"P",1"I"),ABMP("PRI")>96 S INSSKIP=""
I '$D(INSSKIP),$D(ABMP("OPONADMIT")) D
.Q:$P(ABML(ABMP("PRI"),ABMP("INS")),U,3)'?1(1"M",1"R")
.Q:ABMP("PRI")<97
.;If the patient has B but not A don't skip.
.I $G(ABML(ABMP("PRI"),ABMP("INS"),"COV",+$O(ABML(ABMP("PRI"),ABMP("INS"),"COV",""))))="B" Q
. I $P(ABML(ABMP("PRI"),ABMP("INS")),U,6)=44 S INSSKIP=""
I '$D(INSSKIP) D ADDCHK^ABMDE2E
S ABMP("C0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
S ABMX("INS")=ABMP("INS")
D:'$D(ABMP("BTYP")) BTYP^ABMDEVAR
D FRATE^ABMDE2X1
D EXP^ABMDE2X5
I ABMP("EXP")=22!(ABMP("EXP")=23)!(ABMP("EXP")=3)!(ABMP("EXP")=14)!(ABMP("EXP")=25) D
.S DIE="^ABMDCLM(DUZ(2),"
.S DA=ABMP("CDFN")
.S DR=".922////"_$P($G(^ABMDPARM(ABMP("LDFN"),1,4)),U,11)
.S DR=DR_";.923///"_$P($G(^ABMDPARM(ABMP("LDFN"),1,4)),U,12)
.D ^DIE
K ABMV,ABMX
Q
;
OTHER ;RUN OTHER STUFFING ROUTINES
;ABMDVST1 - Purpose of visit
;ABMDVST2 - Provider
;ABMDVST3 - ICD Procedure
;ABMDVST4 - Hospitalization
;ABMDVST5 - Pharmacy
;ABMDVST6 - Dental
;ABMDVST7 - Not used
;ABMDVST8 - Not used
;ABMDVST9 - IV Pharmacy
;ABMDVS10 - Not used
;ABMDVS11 - Lab
;ABMDVS12 - Not used
;ABMDVS13 - CPT CODES
S ABMACTVI=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,8)
I ABMACTVI="" S ABMACTVI=ABMP("INS")
K ABM("DONE")
F ABM("COUNTER")=1:1 D Q:$G(ABM("DONE"))
.S ABM("ROUTINE")=$S(ABM("COUNTER")<10:"ABMDVST"_ABM("COUNTER"),1:"ABMDVS"_ABM("COUNTER"))
.Q:(ABM("COUNTER")<5!(ABM("COUNTER")>6))&(ABMACTVI'=ABMP("INS"))&(ABM("COUNTER")<14)
.S X=ABM("ROUTINE")
.X ^%ZOSF("TEST") E S:ABM("COUNTER")>13 ABM("DONE")=1 Q
.I D @("^"_ABM("ROUTINE"))
I ABMACTVI=ABMP("INS") S ABMIDONE=1
I $T(^BCMDVS01)]"",$O(^BCMTCA(0)) D ^BCMDVS01 ;IHS/CMI/LAB-chargemaster call
Q
GETPPRV ;
;get attending/operating provider from claim
S ABMCPRV=+$O(^ABMDCLM(DUZ(2),ABM,41,"C","A",0))
S:ABMCPRV=0 ABMCPRV=+$O(^ABMDCLM(DUZ(2),ABM,41,"C","O",0))
I ABMCPRV'=0 S ABMCPRV=$P($G(^ABMDCLM(DUZ(2),ABM,41,ABMCPRV,0)),U)
;get provider from visit
S ABMV=0
F S ABMV=$O(^AUPNVPRV("AD",ABMVDFN,ABMV)) Q:+ABMV=0 D Q:+$G(ABMVPRV)'=0
.Q:$P($G(^AUPNVPRV(ABMV,0)),U,4)'="P"
.S ABMVPRV=$P($G(^AUPNVPRV(ABMV,0)),U)
I $G(ABMVPRV)="" S ABMVPRV=0
Q
GETPPOV ;
;get Primary/first entry from claim
S ABMCICD=+$O(^ABMDCLM(DUZ(2),ABM,17,0))
;get Primary or first entry from claim
S ABMV=0
K ABMVFST
S ABMVFST=""
F S ABMV=$O(^AUPNVPOV("AD",ABMVDFN,ABMV)) Q:+ABMV=0 D Q:+$G(ABMVICD)'=0
.I $G(ABMVFST)="" S ABMVFST=$P($G(^AUPNVPOV(ABMV,0)),U)
.Q:$P($G(^AUPNVPOV(ABMV,0)),U,12)'="P"
.S ABMVICD=$P($G(^AUPNVPOV(ABMV,0)),U)
I +$G(ABMVICD)=0 S ABMVICD=ABMVFST
Q
ABMDVST ; IHS/ASDST/DMJ - PCC Visit Stuff ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**10,19,22**;NOV 12, 2009;Build 418
+2 ;Original;TMD;08/19/96 4:45 PM
+3 ;
+4 ; IHS/SD/SDR - V2.5 P8 - IM12246/IM17548 - Added code to put defaults on claim for CLIAs
+5 ; IHS/SD/SDR - v2.5 p8 - task 8 - Added tag for insurer replace and splitting routine
+6 ; IHS/SD/SDR - v2.5 p10 - IM19717/IM20374 - Added to check for when to merge visits into one claim
+7 ; IHS/SD/SDR - v2.5 p10 - IM20610 - Fix Medicare Part B check so only one claim will generate
+8 ; IHS/SD/SDR - v2.5 p10 - task order item 1 - Calls for ChargeMaster added to national code. Calls were
+9 ; supplied by Lori Butcher
+10 ; IHS/SD/SDR - v2.5 p10 - IM21500 - Added code to check new V Med field POINT OF SALE BILLING STATUS
+11 ; and only generate claim if at least one med wasn't billed by POS or was billed and rejected
+12 ;
+13 ;IHS/SD/SDR - 2.6*19 - HEAT251217 - Made change to populate SERVICE DATE FROM and SERVICE DATE TO all the time.
+14 ;IHS/SD/SDR 2.6*22 HEAT335246 - Added call to claim splitter
+15 ; *********************************************************************
VAR ;
+1 NEW ABMSRC,DA,DIE,DIK
+2 KILL ABMP("DUP"),ABMP("NEWBORN")
+3 IF '$DATA(ABMP("VTYP"))
Begin DoDot:1
+4 SET ABMP("VTYP")=$$VTYP^ABMDVCK1(ABMVDFN,SERVCAT,ABMP("INS"),ABMP("CLN"))
End DoDot:1
+5 IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,7)="N"
Begin DoDot:1
+6 SET DIE="^AUPNVSIT("
+7 SET DA=ABMVDFN
+8 SET DR=".04////22"
+9 DO ^DIE
End DoDot:1
QUIT
+10 ;Find new Claim ien if ien null
+11 ;Not sure what will happen here if the claim is a split claim.
+12 ;Clearly only one claim will be updated.
+13 IF '$GET(ABMP("CDFN"))
SET ABMP("CDFN")=$ORDER(^ABMDCLM(DUZ(2),"AV",ABMVDFN,""))
+14 IF ABMP("CDFN")<1
SET ABM=0
FOR
SET ABM=$ORDER(^ABMDCLM(DUZ(2),"B",ABMP("PDFN"),ABM))
IF 'ABM
QUIT
Begin DoDot:1
+15 IF '$DATA(^ABMDCLM(DUZ(2),ABM,0))
KILL ^ABMDCLM(DUZ(2),"B",ABMP("PDFN"),ABM)
QUIT
+16 ;encounter(visit) date
IF $PIECE($GET(^ABMDCLM(DUZ(2),ABM,0)),U,2)'=ABMP("VDT")
QUIT
+17 ;visit location
IF $PIECE($GET(^ABMDCLM(DUZ(2),ABM,0)),U,3)'=ABMP("LDFN")
QUIT
+18 ;visit type
IF $PIECE($GET(^ABMDCLM(DUZ(2),ABM,0)),U,7)'=ABMP("VTYP")
QUIT
+19 ;clinic
IF $PIECE($GET(^ABMDCLM(DUZ(2),ABM,0)),U,6)'=ABMP("CLN")
QUIT
+20 ;get primary provider
DO GETPPRV
+21 ;find primary DX
DO GETPPOV
+22 IF ABMVPRV'=0
IF (ABMCPRV=ABMVPRV)
IF (ABMVICD'=0)
IF (ABMCICD=ABMVICD)
SET ABMP("CDFN")=ABM
End DoDot:1
IF ABMP("CDFN")
QUIT
+23 IF ABMARPS
IF ABMP("CDFN")<1
Begin DoDot:1
+24 SET ABMP("CDFN")=$ORDER(^ABMDCLM(ABMP("LDFN"),"AV",ABMVDFN,""))
+25 IF ABMP("CDFN")
IF '$DATA(^ABMDCLM(ABMP("LDFN"),ABMP("CDFN"),0))
Begin DoDot:2
+26 KILL ^ABMDCLM(ABMP("LDFN"),"AV",ABMVDFN,ABMP("CDFN"))
+27 SET ABMP("CDFN")=0
End DoDot:2
+28 IF ABMP("CDFN")<1
QUIT
+29 SET ABMP("NOKILLABILL")=2
End DoDot:1
IF $GET(ABMP("NOKILLABILL"))=2
QUIT
+30 IF ABMP("CDFN")<1
GOTO NEW
+31 IF $GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0))=""
QUIT
+32 ;25= Existing claim modified
+33 NEW R
+34 SET R=$PIECE(^AUPNVSIT(ABMVDFN,0),U,4)
+35 IF R'=24!((R=24)&('$DATA(ABMNFLG)))
IF R'=25
Begin DoDot:1
+36 SET DIE="^AUPNVSIT("
+37 SET DA=ABMVDFN
+38 SET DR=".04////25"
+39 DO ^DIE
End DoDot:1
+40 LOCK +^ABMDCLM(DUZ(2),ABMP("CDFN")):10
IF '$TEST
SET ABMP("LOCKFAIL")=1
QUIT
+41 SET DR=""
+42 SET Y=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
+43 IF $PIECE(Y,U,10)'=DT
Begin DoDot:1
+44 SET DR=".1////"_DT
End DoDot:1
+45 IF $PIECE(Y,U,2)'=ABMP("VDT")
Begin DoDot:1
+46 SET DR=".02////"_ABMP("VDT")_$SELECT(DR]"":";"_DR,1:"")
End DoDot:1
+47 SET DR=$SELECT(DR]"":DR_";",1:"")_".06////"_ABMP("CLN")
+48 IF $PIECE(Y,U,7)'=ABMP("VTYP")
IF $DATA(ABMP("PRIMVSIT"))
Begin DoDot:1
+49 SET DR=$SELECT(DR]"":DR_";",1:"")_".07////"_ABMP("VTYP")
End DoDot:1
+50 ;The following works because the only way that 97 will be the value is
+51 ;if the primary insurer is billed elswhere (e.g. Data Center)
+52 IF ABMP("PRI")=97
SET DR=$SELECT(DR]"":DR_";",1:"")_".04////U;.08////"_ABMP("INS")
+53 ;The next line checks the active insurer field. If it is null & the
+54 ;insurer in ABMP("INS") is the primary insurer set and the mode of
+55 ;export
+56 IF $PIECE(Y,U,8)=""
IF DR'[".08"
IF '$ORDER(ABML(ABMP("PRI")),-1)
IF $ORDER(ABML(ABMP("PRI"),""))=ABMP("INS")
Begin DoDot:1
+57 NEW ABMMODE
+58 SET ABMMODE=$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,4)
+59 SET DR=$SELECT(DR]"":DR_";",1:"")_".08////"_ABMP("INS")_$SELECT(ABMMODE:";.14///"_ABMMODE,1:"")
End DoDot:1
+60 IF DR]""
Begin DoDot:1
+61 SET DIE="^ABMDCLM(DUZ(2),"
+62 SET DA=ABMP("CDFN")
+63 DO ^DIE
End DoDot:1
+64 DO VSIT
+65 DO FRATE
+66 DO OTHER
+67 ;if routine BCMZINHO exists and there are tran codes in the table run BCMZINHO
+68 ;IHS/CMI/LAB-chargemaster call
IF $TEXT(^BCMZINHO)]""
IF $ORDER(^BCMTCA(0))
IF $DATA(^AUPNVSIT("AD",ABMVDFN))
DO ^BCMZINHO
+69 IF $ORDER(^ABMDBILL(DUZ(2),"AV",ABMVDFN,0))
IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)'="U"
Begin DoDot:1
+70 SET ABM("OUT")=1
+71 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"B",ABMP("INS")))
QUIT
+72 SET DA=$ORDER(^ABMDBILL(DUZ(2),"AV",ABMVDFN,0))
+73 ; Active Insurer
SET ABM=$PIECE($GET(^ABMDBILL(DUZ(2),DA,0)),U,8)
+74 IF 'ABM
QUIT
+75 ;I $P($G(^AUTNINS(ABM,2)),U)="I" D ;Type of ins = Indian Pat ;abm*2.6*10 HEAT73780
+76 ;Type of ins = Indian Pat ;abm*2.6*10 HEAT73780
IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM,".211","I"),1,"I")="I"
Begin DoDot:2
+77 SET ABM("OUT")=0
+78 SET DIE="^ABMDBILL(DUZ(2),"
+79 ;Mark bill as cancelled
SET DR=".04////X"
+80 DO ^ABMDDIE
+81 SET DIE="^ABMDCLM(DUZ(2),"
+82 SET DA=ABMP("CDFN")
+83 SET DR=".04////F;.08////"_ABMP("INS")
+84 DO ^ABMDDIE
End DoDot:2
End DoDot:1
IF ABM("OUT")
QUIT
+85 IF $DATA(^ABMDBILL(DUZ(2),"AS",ABMP("CDFN")))
QUIT
+86 QUIT
+87 ;
+88 ; *********************************************************************
NEW ;CREATE NEW CLAIM
+1 IF $DATA(^ABMDBILL(DUZ(2),"AV",ABMVDFN))
Begin DoDot:1
+2 SET DIE="^AUPNVSIT("
+3 SET DA=ABMVDFN
+4 SET DR=".04////20"
+5 DO ^DIE
End DoDot:1
QUIT
+6 ;BILLED POS insurer?
+7 IF $PIECE($GET(^AUTNINS(ABMP("INS"),2)),U,3)="P"
Begin DoDot:1
+8 SET ABMVMIEN=0
+9 FOR
SET ABMVMIEN=$ORDER(^AUPNVMED("AD",ABMVDFN,ABMVMIEN))
IF +ABMVMIEN=0
QUIT
Begin DoDot:2
+10 IF $PIECE($GET(^AUPNVMED(ABMVMIEN,11)),U,6)'=1
SET ABMPSFLG=1
End DoDot:2
IF $GET(ABMPSFLG)=1
QUIT
End DoDot:1
+11 IF $DATA(^AUPNVMED("AD",ABMVDFN))
IF $PIECE($GET(^AUTNINS(ABMP("INS"),2)),U,3)="P"
IF ($GET(ABMPSFLG)'=1)
Begin DoDot:1
+12 KILL ABMPSFLG
+13 ;billed POS
DO PCFL^ABMDVCK(62)
End DoDot:1
QUIT
+14 SET DINUM=$$NXNM^ABMDUTL
+15 IF DINUM=""
SET ABMP("NOKILLABILL")=1
QUIT
+16 KILL DIC
+17 SET DIC="^ABMDCLM(DUZ(2),"
+18 SET DIC(0)="L"
+19 SET X=ABMP("PDFN")
+20 KILL DD,DO
+21 DO FILE^DICN
+22 IF Y<1
SET ABMP("NOKILLABILL")=1
QUIT
+23 SET ABMP("CDFN")=+Y
+24 LOCK +^ABMDCLM(DUZ(2),+Y):1
IF '$TEST
SET ABMP("LOCKFAIL")=1
QUIT
+25 SET DA=+Y
+26 SET DIE=DIC
+27 SET DR=".02////"_$PIECE($PIECE(ABMP("V0"),U),".")_";.03////"_ABMP("LDFN")
+28 SET DR=DR_";.04////"_"F"_";.06////"_ABMP("CLN")_";.07////"_ABMP("VTYP")
+29 ;No active insurer if one insurer billed elsewhere
+30 IF '$DATA(ABML(97))
SET DR=DR_";.08////"_ABMP("INS")
+31 SET DR=DR_";.1////"_DT_";.17////"_DT
+32 ;abm*2.6*19 IHS/SD/SDR HEAT251217
SET DR=DR_";.71////"_$PIECE($PIECE(ABMP("V0"),U),".")_";.72////"_$PIECE($PIECE(ABMP("V0"),U),".")
+33 DO ^DIE
+34 SET DIE="^AUPNVSIT("
+35 SET DA=ABMVDFN
+36 SET DR=".04////24"
+37 DO ^DIE
+38 DO VSIT
+39 SET ABMNFLG=1
+40 DO FRATE
+41 DO OTHER
+42 ;if routine BCMZINHO exists and there are tran codes in the table run BCMZINHO
+43 ;IHS/CMI/LAB-chargemaster call
IF $TEXT(^BCMZINHO)]""
IF $ORDER(^BCMTCA(0))
IF $DATA(^AUPNVSIT("AD",ABMVDFN))
DO ^BCMZINHO
+44 KILL X,Y
+45 ;abm*2.6*22 IHS/SD/SDR HEAT335246
DO ^ABMPSPLT
+46 DO MAIN^ABMASPLT(ABMP("CDFN"))
+47 ;I $P($G(^AUTNINS(+ABMP("INS"),2)),U)="R" D ;abm*2.6*10 HEAT73780
+48 ;abm*2.6*10 HEAT73780
IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMP("INS"),".211","I"),1,"I")="R"
Begin DoDot:1
+49 SET ABMBONLY=$SELECT($PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,5)),U)'="":$PIECE(^ABMDPARM(ABMP("LDFN"),1,5),U),1:2)
+50 IF (ABMBONLY'=2)
QUIT
+51 DO MAIN^ABMDSPLB(ABMP("CDFN"))
End DoDot:1
+52 QUIT
+53 ;
+54 ; *********************************************************************
VSIT ;
+1 SET DA(1)=ABMP("CDFN")
+2 SET DIC="^ABMDCLM(DUZ(2),"_DA(1)_",11,"
+3 SET DIC(0)="LE"
+4 IF $DATA(@(DIC_ABMVDFN_")"))
IF '$DATA(ABMP("PRIMVSIT"))
QUIT
+5 ;This section needs to be done for non-new claims
+6 ;Direct set into the claim file
+7 SET DIC("P")=$PIECE(^DD(9002274.3,11,0),U,2)
+8 KILL DD,DO,DR,DIC("DR")
+9 IF $DATA(ABMP("PRIMVSIT"))
SET DIC("DR")=".02////P"
+10 SET (X,DINUM)=ABMVDFN
+11 IF '$DATA(@(DIC_ABMVDFN_")"))
Begin DoDot:1
+12 DO FILE^DICN
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 SET DIE=DIC
+15 SET DR=DIC("DR")
+16 SET DA=DINUM
+17 DO ^DIE
+18 KILL DIE,DR,DINUM
End DoDot:1
+19 KILL DIC
+20 QUIT
+21 ;
+22 ; *********************************************************************
FRATE ;
+1 ;I need code to prevent 2nd visit on claim from undoing eligibility
+2 NEW V,INSADD,INSSKIP
+3 SET V=0
+4 FOR
SET V=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,V))
IF 'V
QUIT
Begin DoDot:1
+5 IF V'=ABMVDFN
IF $DATA(^TMP($JOB,"PROC",V))
Begin DoDot:2
+6 SET IEN=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"B",ABMP("INS"),""))
+7 IF 'IEN
SET INSADD=""
QUIT
+8 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,IEN,0),U,3)?1(1"P",1"I")
IF ABMP("PRI")>96
SET INSSKIP=""
End DoDot:2
End DoDot:1
IF $DATA(INSADD)
QUIT
+9 IF '$DATA(INSSKIP)
IF $DATA(ABMP("OPONADMIT"))
Begin DoDot:1
+10 IF $PIECE(ABML(ABMP("PRI"),ABMP("INS")),U,3)'?1(1"M",1"R")
QUIT
+11 IF ABMP("PRI")<97
QUIT
+12 ;If the patient has B but not A don't skip.
+13 IF $GET(ABML(ABMP("PRI"),ABMP("INS"),"COV",+$ORDER(ABML(ABMP("PRI"),ABMP("INS"),"COV",""))))="B"
QUIT
+14 IF $PIECE(ABML(ABMP("PRI"),ABMP("INS")),U,6)=44
SET INSSKIP=""
End DoDot:1
+15 IF '$DATA(INSSKIP)
DO ADDCHK^ABMDE2E
+16 SET ABMP("C0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
+17 SET ABMX("INS")=ABMP("INS")
+18 IF '$DATA(ABMP("BTYP"))
DO BTYP^ABMDEVAR
+19 DO FRATE^ABMDE2X1
+20 DO EXP^ABMDE2X5
+21 IF ABMP("EXP")=22!(ABMP("EXP")=23)!(ABMP("EXP")=3)!(ABMP("EXP")=14)!(ABMP("EXP")=25)
Begin DoDot:1
+22 SET DIE="^ABMDCLM(DUZ(2),"
+23 SET DA=ABMP("CDFN")
+24 SET DR=".922////"_$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,4)),U,11)
+25 SET DR=DR_";.923///"_$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,4)),U,12)
+26 DO ^DIE
End DoDot:1
+27 KILL ABMV,ABMX
+28 QUIT
+29 ;
OTHER ;RUN OTHER STUFFING ROUTINES
+1 ;ABMDVST1 - Purpose of visit
+2 ;ABMDVST2 - Provider
+3 ;ABMDVST3 - ICD Procedure
+4 ;ABMDVST4 - Hospitalization
+5 ;ABMDVST5 - Pharmacy
+6 ;ABMDVST6 - Dental
+7 ;ABMDVST7 - Not used
+8 ;ABMDVST8 - Not used
+9 ;ABMDVST9 - IV Pharmacy
+10 ;ABMDVS10 - Not used
+11 ;ABMDVS11 - Lab
+12 ;ABMDVS12 - Not used
+13 ;ABMDVS13 - CPT CODES
+14 SET ABMACTVI=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,8)
+15 IF ABMACTVI=""
SET ABMACTVI=ABMP("INS")
+16 KILL ABM("DONE")
+17 FOR ABM("COUNTER")=1:1
Begin DoDot:1
+18 SET ABM("ROUTINE")=$SELECT(ABM("COUNTER")<10:"ABMDVST"_ABM("COUNTER"),1:"ABMDVS"_ABM("COUNTER"))
+19 IF (ABM("COUNTER")<5!(ABM("COUNTER")>6))&(ABMACTVI'=ABMP("INS"))&(ABM("COUNTER")<14)
QUIT
+20 SET X=ABM("ROUTINE")
+21 XECUTE ^%ZOSF("TEST")
IF '$TEST
IF ABM("COUNTER")>13
SET ABM("DONE")=1
QUIT
+22 IF $TEST
DO @("^"_ABM("ROUTINE"))
End DoDot:1
IF $GET(ABM("DONE"))
QUIT
+23 IF ABMACTVI=ABMP("INS")
SET ABMIDONE=1
+24 ;IHS/CMI/LAB-chargemaster call
IF $TEXT(^BCMDVS01)]""
IF $ORDER(^BCMTCA(0))
DO ^BCMDVS01
+25 QUIT
GETPPRV ;
+1 ;get attending/operating provider from claim
+2 SET ABMCPRV=+$ORDER(^ABMDCLM(DUZ(2),ABM,41,"C","A",0))
+3 IF ABMCPRV=0
SET ABMCPRV=+$ORDER(^ABMDCLM(DUZ(2),ABM,41,"C","O",0))
+4 IF ABMCPRV'=0
SET ABMCPRV=$PIECE($GET(^ABMDCLM(DUZ(2),ABM,41,ABMCPRV,0)),U)
+5 ;get provider from visit
+6 SET ABMV=0
+7 FOR
SET ABMV=$ORDER(^AUPNVPRV("AD",ABMVDFN,ABMV))
IF +ABMV=0
QUIT
Begin DoDot:1
+8 IF $PIECE($GET(^AUPNVPRV(ABMV,0)),U,4)'="P"
QUIT
+9 SET ABMVPRV=$PIECE($GET(^AUPNVPRV(ABMV,0)),U)
End DoDot:1
IF +$GET(ABMVPRV)'=0
QUIT
+10 IF $GET(ABMVPRV)=""
SET ABMVPRV=0
+11 QUIT
GETPPOV ;
+1 ;get Primary/first entry from claim
+2 SET ABMCICD=+$ORDER(^ABMDCLM(DUZ(2),ABM,17,0))
+3 ;get Primary or first entry from claim
+4 SET ABMV=0
+5 KILL ABMVFST
+6 SET ABMVFST=""
+7 FOR
SET ABMV=$ORDER(^AUPNVPOV("AD",ABMVDFN,ABMV))
IF +ABMV=0
QUIT
Begin DoDot:1
+8 IF $GET(ABMVFST)=""
SET ABMVFST=$PIECE($GET(^AUPNVPOV(ABMV,0)),U)
+9 IF $PIECE($GET(^AUPNVPOV(ABMV,0)),U,12)'="P"
QUIT
+10 SET ABMVICD=$PIECE($GET(^AUPNVPOV(ABMV,0)),U)
End DoDot:1
IF +$GET(ABMVICD)'=0
QUIT
+11 IF +$GET(ABMVICD)=0
SET ABMVICD=ABMVFST
+12 QUIT
