ABMDVST.m

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)