- 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
