ABMDBETA ; IHS/ASDST/DMJ - Routine to Update Beta Sites ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
I '$D(DUZ(2)) D ^XBKVAR
W !!!,"Wait, processing..."
S DA=$O(^AUTNINS("B","BENEFICIARY PATIENT (INDIAN)","")) I DA,$P($G(^AUTNINS(DA,2)),U)'="I" S DR=".21////I",DIE="^AUTNINS(" D ^ABMDDIE Q:$D(ABM("DIE-FAIL"))
S DA(2)=$O(^AUTNINS("B","MEDICARE","")),DA(1)=831 I DA(2),'$O(^AUTNINS(DA(2),39,DA(1),11,1)) S DA=1,DR=".03///@",DIE="^AUTNINS("_DA(2)_",39,831,11," D ^ABMDDIE Q:$D(ABM("DIE-FAIL"))
G XIT:$D(^ABMDERR(48,0))
I $D(^DD(9002274.0111,.01,0)),^(0)'["DINUM" S ^(0)=$P(^(0),"X=+Y")_"(DINUM,X)=+Y"_$P(^(0),"X=+Y",2)
I $D(^DD(9002274.51111,.01,0)),^(0)'["SURGERY" S ^(0)=$P(^(0),"EMERGENCY ROOM")_"SURGERY"_$P(^(0),"EMERGENCY ROOM",2)
I $P($G(^DD(9002274.3035,.02,0)),U,5,99)["<37" S ^(0)=$P(^(0),"37")_"36!($E(^(0),1,2)=40)"_$P(^(0),"37",2,99)
I $G(^DD(9002274.3035,.02,12.1))["<37" S ^(12.1)=$P(^(12.1),"<37")_"<36!($E(^(0),1,2)=40)"_$P(^(12.1),"<37",2)
I $P($G(^DD(9002274.4035,.02,0)),U,5,99)["<37" S ^(0)=$P(^(0),"37")_"36!($E(^(0),1,2)=40)"_$P(^(0),"37",2,99)
I $G(^DD(9002274.4035,.02,12.1))["<37" S ^(12.1)=$P(^(12.1),"<37")_"<36!($E(^(0),1,2)=40)"_$P(^(12.1),"<37",2)
S DIE="^ABMDTXST(",DA=0 F S DA=$O(^ABMDTXST(DA)) Q:'DA I "UH"[$P(^(DA,0),U,2) S DR=".02////"_$S($P(^(0),U,2)="H":2,1:1) D ^ABMDDIE Q:$D(ABM("DIE-FAIL")) W "."
S DIE="^ABMDBILL(",DA=0 F S DA=$O(^ABMDBILL(DA)) Q:'DA D
.S DR=".16///@"
.I "TAR"'[$P(^ABMDBILL(DA,0),U,4),'$P($G(^ABMDBILL(DA,1)),U,8) S DR=".16////A"
.D ^ABMDDIE W "." Q:$D(ABM("DIE-FAIL"))
;
W "." K DD,DO S DIC="^ABMDERR(",DIC(0)="L",DINUM=4,X="CLAIM HAS NO CHARGES (PROCEDURES OR SERVICES) TO BILL"
S DIC("DR")=".02////Enter in all procedures, services, accomodations, and medications in the Worksheet (CPT) Pages." D FILE^DICN
W "." K DD,DO S DINUM=40,X="CLINIC IS DESIGNATED AS UNBILLABLE"
S DIC("DR")=".02////The Insurer is unbillable for this clinic as designated in the Coverage Type File." D FILE^DICN
W "." K DD,DO S DINUM=46,X="DIAGNOSIS IS DESIGNATED AS UNBILLABLE"
S DIC("DR")=".02////The Insurer is unbillable for the Diagnosis as designated in the Coverage Type File." D FILE^DICN
W "." K DD,DO S DINUM=41,X="PROVIDER DISIPLINE IS DESIGNATED AS UNBILLABLE"
S DIC("DR")=".02////The Insurer is unbillable for the Provider Disipline as designated in the Coverage Type File." D FILE^DICN
W "." K DD,DO S DINUM=42,X="VISIT TYPE IS DESIGNATED AS UNBILLABLE"
S DIC("DR")=".02////The Insurer is unbillable for this Visit Type as designated in the Insurer File." D FILE^DICN
W "." K DD,DO S DINUM=43,X="DENTAL VISITS ARE DESIGNATED AS UNBILLABLE"
S DIC("DR")=".02////The Insurer is unbillable for Dental Visits as designated in the Insurer File." D FILE^DICN
W "." K DD,DO S DINUM=44,X="PHARMACY VISITS ARE DESIGNATED AS UNBILLABLE"
S DIC("DR")=".02////The Insurer is unbillable for Pharmacy Visits as designated in the Insurer File." D FILE^DICN
W "." K DD,DO S DINUM=45,X="ONLY DENTAL VISITS ARE BILLABLE"
S DIC("DR")=".02////The Insurer covers Dental visits only as designated in the Insurer File." D FILE^DICN
W "." K DD,DO S DINUM=47,X="POLICY IS DESIGNATED AS BEING SUPPLEMENTAL TO MEDICARE"
S DIC("DR")=".02////If the policy is not supplemental to Medicare the linkage to the Coverage Type that is designated as Medicarte Supplemental should be removed." D FILE^DICN
W "." K DD,DO S DINUM=48,X="MEDICARE IS UNBILLABLE AND POLICY IS SUPPLEMENTAL TO MEDICARE"
S DIC("DR")=".02////A bill can not be generated for a policy that is supplemental to Medicare when Medicare can not be billed." D FILE^DICN
UPDT S DIE="^ABMDERR(",DR=".03////E;.05////1"
F DA=4,6,8,40,41,42,43,44,45,46,48,92,110,111,115,121,122,123,124,125,126,127,152,153,162,173 D ^ABMDDIE W "." Q:$D(ABM("DIE-FAIL"))
S DA=170,DR=".03////W;.05////0" D ^ABMDDIE Q:$D(ABM("DIE-FAIL"))
S DA=105,DR=".01///POLICY HOLDER'S ADDRESS UNSPECIFIED;.02////Edit the appropriate Private Insurance Policy so that the Address of the Policy Holder is specified." D ^ABMDDIE Q:$D(ABM("DIE-FAIL"))
W "." K DA,DD,DO,DIC,DINUM
S DA=$O(^AUTNINS("B","WORKMEN'S COMP","")) I 'DA S DIC="^AUTNINS(",DIC(0)="L",X="WORKMEN'S COMP" D FILE^DICN S DA=$S(+Y:+Y,1:"")
I DA S DIE="^AUTNINS(",DR=".17////2;.21////W;.41////WORKMEN'S COMPENSATION" D ^ABMDDIE Q:$D(ABM("DIE-FAIL"))
S DA=0 F S DA=$O(^AUTNINS(DA)) Q:'DA D KEYWD^ABMDTINS W "."
;
XIT K ABM
Q
ABMDBETA ; IHS/ASDST/DMJ - Routine to Update Beta Sites ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 IF '$DATA(DUZ(2))
DO ^XBKVAR
+4 WRITE !!!,"Wait, processing..."
+5 SET DA=$ORDER(^AUTNINS("B","BENEFICIARY PATIENT (INDIAN)",""))
IF DA
IF $PIECE($GET(^AUTNINS(DA,2)),U)'="I"
SET DR=".21////I"
SET DIE="^AUTNINS("
DO ^ABMDDIE
IF $DATA(ABM("DIE-FAIL"))
QUIT
+6 SET DA(2)=$ORDER(^AUTNINS("B","MEDICARE",""))
SET DA(1)=831
IF DA(2)
IF '$ORDER(^AUTNINS(DA(2),39,DA(1),11,1))
SET DA=1
SET DR=".03///@"
SET DIE="^AUTNINS("_DA(2)_",39,831,11,"
DO ^ABMDDIE
IF $DATA(ABM("DIE-FAIL"))
QUIT
+7 IF $DATA(^ABMDERR(48,0))
GOTO XIT
+8 IF $DATA(^DD(9002274.0111,.01,0))
IF ^(0)'["DINUM"
SET ^(0)=$PIECE(^(0),"X=+Y")_"(DINUM,X)=+Y"_$PIECE(^(0),"X=+Y",2)
+9 IF $DATA(^DD(9002274.51111,.01,0))
IF ^(0)'["SURGERY"
SET ^(0)=$PIECE(^(0),"EMERGENCY ROOM")_"SURGERY"_$PIECE(^(0),"EMERGENCY ROOM",2)
+10 IF $PIECE($GET(^DD(9002274.3035,.02,0)),U,5,99)["<37"
SET ^(0)=$PIECE(^(0),"37")_"36!($E(^(0),1,2)=40)"_$PIECE(^(0),"37",2,99)
+11 IF $GET(^DD(9002274.3035,.02,12.1))["<37"
SET ^(12.1)=$PIECE(^(12.1),"<37")_"<36!($E(^(0),1,2)=40)"_$PIECE(^(12.1),"<37",2)
+12 IF $PIECE($GET(^DD(9002274.4035,.02,0)),U,5,99)["<37"
SET ^(0)=$PIECE(^(0),"37")_"36!($E(^(0),1,2)=40)"_$PIECE(^(0),"37",2,99)
+13 IF $GET(^DD(9002274.4035,.02,12.1))["<37"
SET ^(12.1)=$PIECE(^(12.1),"<37")_"<36!($E(^(0),1,2)=40)"_$PIECE(^(12.1),"<37",2)
+14 SET DIE="^ABMDTXST("
SET DA=0
FOR
SET DA=$ORDER(^ABMDTXST(DA))
IF 'DA
QUIT
IF "UH"[$PIECE(^(DA,0),U,2)
SET DR=".02////"_$SELECT($PIECE(^(0),U,2)="H":2,1:1)
DO ^ABMDDIE
IF $DATA(ABM("DIE-FAIL"))
QUIT
WRITE "."
+15 SET DIE="^ABMDBILL("
SET DA=0
FOR
SET DA=$ORDER(^ABMDBILL(DA))
IF 'DA
QUIT
Begin DoDot:1
+16 SET DR=".16///@"
+17 IF "TAR"'[$PIECE(^ABMDBILL(DA,0),U,4)
IF '$PIECE($GET(^ABMDBILL(DA,1)),U,8)
SET DR=".16////A"
+18 DO ^ABMDDIE
WRITE "."
IF $DATA(ABM("DIE-FAIL"))
QUIT
End DoDot:1
+19 ;
+20 WRITE "."
KILL DD,DO
SET DIC="^ABMDERR("
SET DIC(0)="L"
SET DINUM=4
SET X="CLAIM HAS NO CHARGES (PROCEDURES OR SERVICES) TO BILL"
+21 SET DIC("DR")=".02////Enter in all procedures, services, accomodations, and medications in the Worksheet (CPT) Pages."
DO FILE^DICN
+22 WRITE "."
KILL DD,DO
SET DINUM=40
SET X="CLINIC IS DESIGNATED AS UNBILLABLE"
+23 SET DIC("DR")=".02////The Insurer is unbillable for this clinic as designated in the Coverage Type File."
DO FILE^DICN
+24 WRITE "."
KILL DD,DO
SET DINUM=46
SET X="DIAGNOSIS IS DESIGNATED AS UNBILLABLE"
+25 SET DIC("DR")=".02////The Insurer is unbillable for the Diagnosis as designated in the Coverage Type File."
DO FILE^DICN
+26 WRITE "."
KILL DD,DO
SET DINUM=41
SET X="PROVIDER DISIPLINE IS DESIGNATED AS UNBILLABLE"
+27 SET DIC("DR")=".02////The Insurer is unbillable for the Provider Disipline as designated in the Coverage Type File."
DO FILE^DICN
+28 WRITE "."
KILL DD,DO
SET DINUM=42
SET X="VISIT TYPE IS DESIGNATED AS UNBILLABLE"
+29 SET DIC("DR")=".02////The Insurer is unbillable for this Visit Type as designated in the Insurer File."
DO FILE^DICN
+30 WRITE "."
KILL DD,DO
SET DINUM=43
SET X="DENTAL VISITS ARE DESIGNATED AS UNBILLABLE"
+31 SET DIC("DR")=".02////The Insurer is unbillable for Dental Visits as designated in the Insurer File."
DO FILE^DICN
+32 WRITE "."
KILL DD,DO
SET DINUM=44
SET X="PHARMACY VISITS ARE DESIGNATED AS UNBILLABLE"
+33 SET DIC("DR")=".02////The Insurer is unbillable for Pharmacy Visits as designated in the Insurer File."
DO FILE^DICN
+34 WRITE "."
KILL DD,DO
SET DINUM=45
SET X="ONLY DENTAL VISITS ARE BILLABLE"
+35 SET DIC("DR")=".02////The Insurer covers Dental visits only as designated in the Insurer File."
DO FILE^DICN
+36 WRITE "."
KILL DD,DO
SET DINUM=47
SET X="POLICY IS DESIGNATED AS BEING SUPPLEMENTAL TO MEDICARE"
+37 SET DIC("DR")=".02////If the policy is not supplemental to Medicare the linkage to the Coverage Type that is designated as Medicarte Supplemental should be removed."
DO FILE^DICN
+38 WRITE "."
KILL DD,DO
SET DINUM=48
SET X="MEDICARE IS UNBILLABLE AND POLICY IS SUPPLEMENTAL TO MEDICARE"
+39 SET DIC("DR")=".02////A bill can not be generated for a policy that is supplemental to Medicare when Medicare can not be billed."
DO FILE^DICN
UPDT SET DIE="^ABMDERR("
SET DR=".03////E;.05////1"
+1 FOR DA=4,6,8,40,41,42,43,44,45,46,48,92,110,111,115,121,122,123,124,125,126,127,152,153,162,173
DO ^ABMDDIE
WRITE "."
IF $DATA(ABM("DIE-FAIL"))
QUIT
+2 SET DA=170
SET DR=".03////W;.05////0"
DO ^ABMDDIE
IF $DATA(ABM("DIE-FAIL"))
QUIT
+3 SET DA=105
SET DR=".01///POLICY HOLDER'S ADDRESS UNSPECIFIED;.02////Edit the appropriate Private Insurance Policy so that the Address of the Policy Holder is specified."
DO ^ABMDDIE
IF $DATA(ABM("DIE-FAIL"))
QUIT
+4 WRITE "."
KILL DA,DD,DO,DIC,DINUM
+5 SET DA=$ORDER(^AUTNINS("B","WORKMEN'S COMP",""))
IF 'DA
SET DIC="^AUTNINS("
SET DIC(0)="L"
SET X="WORKMEN'S COMP"
DO FILE^DICN
SET DA=$SELECT(+Y:+Y,1:"")
+6 IF DA
SET DIE="^AUTNINS("
SET DR=".17////2;.21////W;.41////WORKMEN'S COMPENSATION"
DO ^ABMDDIE
IF $DATA(ABM("DIE-FAIL"))
QUIT
+7 SET DA=0
FOR
SET DA=$ORDER(^AUTNINS(DA))
IF 'DA
QUIT
DO KEYWD^ABMDTINS
WRITE "."
+8 ;
XIT KILL ABM
+1 QUIT
