Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMDTIN1

ABMDTIN1.m

Go to the documentation of this file. 
  1. ABMDTIN1 ; IHS/SD/SDR - Maintenance of INSURER FILE part 2 ;   
  1.  ;;2.6;IHS Third Party Billing;**1,6,8,9,10,11,13,14,21,22,23,27**;NOV 12, 2009;Build 486
  1.  ;IHS/SD/SDR-2.6*1-FIXPMS10028 - prompt for UB04 FL38
  1.  ;IHS/SD/SDR-2.6*6-5010 - added code for BHT06
  1.  ;IHS/SD/SDR-2.6*9-HEAT46087 - Added parameter chk for 4 vs 8 DXs
  1.  ;IHS/SD/SDR-2.6*13 -Added chk for new exp mode 35
  1.  ;IHS/SD/SDR-2.6*14-Changed dt from 10/1/14 to 10/1/15
  1.  ;IHS/SD/SDR 2.6*21 HEAT198159 - Resent routine to get block 28 question added for exp mode 35
  1.  ;IHS/SD/SDR 2.6*22 HEAT329144 Added prompt for fld 121 to print medication name or not
  1.  ;IHS/SD/SDR 2.6*22 HEAT313777 Added prompt to print decimal in amount for ADA-2012
  1.  ;IHS/SD/SDR 2.6*23 HEAT347035 Added prompt for display print order screen claim editor
  1.  ;IHS/SD/SDR 2.6*27 CR9867 Added prompt for Billing Provider Taxonomy
  1.  ; *****************
  1.  W ! K DIC
  1.  S X="`"_ABM("DFN"),DIC="^ABMNINS(DUZ(2),",DIC(0)="LX" D ^DIC Q:+Y<0
  1.  ;S DIE=DIC,DA=+Y,DR=".02;.03;.04;.05;.08;.09;.11;.12//10/1/2013" D ^DIE  ;abm*2.6*10 ICD10 023  ;abm*2.6*13 ICD10 023
  1.  ;S DIE=DIC,DA=+Y,DR=".02;.03;.04;.05;.08;.09;.11;.12//10/1/2014" D ^DIE  ;abm*2.6*13 ICD10 023  ;abm*2.6*14
  1.  S DIE=DIC,DA=+Y,DR=".02;.03;.04;.05;.08;.09;.11;.12//10/1/2015" D ^DIE  ;abm*2.6*14
  1.  S DR=".13" D ^DIE  ;abm*2.6*13 exp mode 35
  1.  I $D(^DD(9002274.093)) D
  1.  .W !
  1.  .S DR=".06"
  1.  .D ^DIE
  1.  W !!,"PROVIDER PIN#",!
  1.  K X,DIC,DIE,Y,DR,DD,DO,DA
  1.  S DA(1)=ABM("DFN")
  1.  S DIC="^ABMNINS(DUZ(2),"_DA(1)_",3,"
  1.  S DIC(0)="ELMQA"
  1.  S DIC("P")=$P(^DD(9002274.09,3,0),U,2)
  1.  S DLAYGO=9002274.093
  1.  D ^DIC
  1.  I +Y>0 D
  1.  .S DIE="^ABMNINS(DUZ(2),"_DA(1)_",3,"
  1.  .S DA=+Y
  1.  .S DR=".02"
  1.  .D ^DIE
  1.  ;D PROV2^ABMDTIN2  ;abm*2.6*6 5010
  1. DISP ;DISPLAY VISIT TYPE TABLE
  1.  D DISP^ABMDTIN2
  1. DIC ;LOOK-UP WITH LAYGO
  1.  W !
  1.  S DA(1)=ABM("DFN")
  1.  S DIC="^ABMNINS(DUZ(2),DA(1),1,",DIC(0)="QLEAM",DIC("A")="Select VISIT TYPE..: "
  1.  S DIC("P")=$P(^DD(9002274.09,1,0),U,2)
  1.  D ^DIC K DIC G XIT:X=""!$D(DTOUT)!$D(DUOUT),DIC:+Y<1
  1.  S DA(1)=ABM("DFN")
  1.  S DIE="^ABMNINS(DUZ(2),DA(1),1,",DA=+Y
  1.  S ABM("VTYP")=DA
  1.  I $P(Y,U,3) S DR=".02////"_$S($P(^AUTNINS(DA(1),2),U,2)="Y":"I",1:"C") D ^DIE K DR  ;icd/cpt?
  1.  S DR=".07Billable (Y/N/E)....:" D ^DIE G XIT:$D(Y)
  1.  I X="N" D INACTVTM(ABM("DFN"),ABM("VTYP"),DT) G DISP
  1.  S DR=".25Reporting purposes only:" D ^DIE G XIT:$D(Y)  ;abm*2.6*6 5010
  1.  D DISPRPL  ;display info about replacement insurer/visit type
  1.  K DIR,X,Y
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Do you want to replace with another insurer/visit type"
  1.  S DIR("?",1)="Answering YES will get you another set of prompts.  Answering these will"
  1.  S DIR("?",2)="make any claims generating with the original insurer/visit type actually"
  1.  S DIR("?",3)="generate like the insurer/visit type in the following prompts."
  1.  S DIR("?",4)="Answering NO will make it work like normal."
  1.  S DIR("?",5)=""
  1.  S DIR("?")="Enter Y to replace or N to continue"
  1.  D ^DIR K DIR
  1.  S ABMMIMIC=Y
  1.  G XIT:$D(DUOUT)!$D(DIROUT)
  1.  I X=""!("Nn"[X) D  ;didn't respond or NO for replacement
  1.  .I $G(ABMVTI)'="" D  ;active replacement insurer
  1.  ..W !?5,"Active replacement insurer entry: " W:$P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,12,ABMVTI,0)),U,3)'="" $P($G(^AUTNINS($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,12,ABMVTI,0)),U,3),0)),U)
  1.  ..W !?10,"Effective: ",$$SDT^ABMDUTL($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,12,ABMVTI,0)),U))
  1.  ..W "Use Visit Type: " W:$P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,12,ABMVTI,0)),U,4)'="" $P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,12,ABMVTI,0)),U,4),!
  1.  ..K DIR,X,Y
  1.  ..S DIR(0)="Y"
  1.  ..S DIR("A",1)="WARNING: you are about to answer visit type set up prompts and there is a"
  1.  ..S DIR("A",2)="replacement insurer entered for this visit type.  If you choose to continue"
  1.  ..S DIR("A",3)="TODAY will be used as an end date on the existing entry.  If TODAY is before"
  1.  ..S DIR("A",4)="the effective date, the effective date will be used as the end date as well."
  1.  ..S DIR("A")="Do you wish to continue and add an end date"
  1.  ..S DIR("B")="N"
  1.  ..D ^DIR K DIR
  1.  ..S ABMNOMIM=Y
  1.  ..;
  1.  ..I ABMNOMIM=1 D
  1.  ...D INACTVTM(ABM("DFN"),ABM("VTYP"),"")  ;they want to cont-stuff end dt
  1.  ...S DIE="^ABMNINS(DUZ(2),"_DA(2)_",1,"
  1.  ...S DA=ABM("VTYP")
  1.  ...S DR=".23////N"  ;change auto-split to NO since all entries will be inactive
  1.  ...D ^DIE
  1.  .I $G(ABMNOMIM)=0 S ABMATCK=1  ;stops rest of prompts from happening
  1.  ;
  1.  I +$G(ABMMIMIC)>0 D
  1.  .D REPLCEIT  ;replace it!
  1.  .D REPLCECK  ;make sure replcmnt is valid
  1.  I $G(ABMINACK)'="" D INACTVTM(ABM("DFN"),ABM("VTYP"),DT)  ;inact other entries
  1.  I $G(ABMATCK)'="" K ABMATCK G DISP
  1.  K DR,DIC,DIE,DIR
  1.  S DA=DA(1)
  1.  S DA(1)=ABM("DFN"),DIE="^ABMNINS(DUZ(2),DA(1),1,"
  1. DIC2 S DA=ABM("VTYP")
  1.  S DR=".14Start Billing Date (create no claims with visit date before)..:" D ^DIE G XIT:$D(Y)
  1.  S DR=".02Procedure Coding....:;I X=""I"" S Y=""@2"";.05Fee Schedule........:;114Add Zero Fees?...:;@2;.06Multiple Forms?.....:"
  1.  D ^DIE G XIT:$D(Y)
  1.  S DR=".08Payer Assigned Provider Number.....:" D ^DIE G XIT:$D(Y)
  1.  S DR=".19EMC Submitter ID #..:" D ^DIE
  1.  S DR="101EMC Reference ID....:" D ^DIE
  1.  S DR=".13Auto Approve?.......:" D ^DIE G XIT:$D(Y)
  1.  S DR=".04Mode of Export......:" D ^DIE
  1.  S DR="123Billing Prv Taxonomy" D ^DIE  ;abm*2.6*27 IHS/SD/AML CR9867
  1.  I ("^28^35^"[("^"_($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,ABM("VTYP"),0)),U,4))_"^")) S DR="121Should Medication Name print?" D ^DIE  ;abm*2.6*22 IHS/SD/SDR HEAT329144
  1.  I ($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,ABM("VTYP"),0)),U,4)=34) S DR="122Print decimal in dollar amount?" D ^DIE  ;abm*2.6*22 IHS/SD/SDR HEAT313777
  1.  K DR
  1.  ;I ("^11^21^31^51^28^"[("^"_($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,ABM("VTYP"),0)),U,4))_"^")) S DR=".18Relationship Code?;.12Itemized UB?.....:;115UB-04 Form Locater 38;109ICD PX on Claim?;.125Print meds on 2 lines?"  ;abm*2.6*8 5010  ;abm*2.6*11 IHS/SD/AML HEAT92962
  1.  I ("^11^21^31^51^28^"[("^"_($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,ABM("VTYP"),0)),U,4))_"^")) D  ;abm*2.6*11 IHS/SD/AML HEAT92962
  1.  .S DR=".18Relationship Code?;.12Itemized UB?.....:;115UB-04 Form Locater 38;109ICD PX on Claim?;.125Print meds on 2 lines?;120UB-04 Block 44 Blank?"  ;abm*2.6*11 IHS/SD/AML HEAT92962
  1.  .I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("DFN"),".211","I"),1,"I")="D" S DR=DR_";124Display Print Order Screen in Claim Editor?"  ;abm*2.6*23 IHS/SD/SDR HEAT347035
  1.  ;start old abm*2.6*10 HEAT72503
  1.  ;I ("^3^14^22^27^32^"[("^"_($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,ABM("VTYP"),0)),U,4))_"^")) S DR=".15Block 24K..........:;.17Block 29...........:;.2Block 33 PIN#......:"  ;abm*2.6*8 HEAT32544
  1.  ;end old start new HEAT72503
  1.  ;I ("^3^14^22^27^32^"[("^"_($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,ABM("VTYP"),0)),U,4))_"^")) D  ;abm*2.6*13 export mode 35
  1.  I ("^3^14^22^27^32^35^"[("^"_($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,ABM("VTYP"),0)),U,4))_"^")) D  ;abm*2.6*13 export mode 35
  1.  .S DR=".15Block 24K..........:"
  1.  .;I $P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,ABM("VTYP"),0)),U,4)=27 S DR=DR_";118Block 28...........:"  ;abm*2.6*13 export mode 35  ;abm*2.6*21 IHS/SD/SDR HEAT198159
  1.  .I "^27^35^"[("^"_$P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,ABM("VTYP"),0)),U,4)_"^") S DR=DR_";118Block 28...........:"  ;abm*2.6*13 export mode 35  ;abm*2.6*21 IHS/SD/SDR HEAT198159
  1.  .S DR=DR_";.17Block 29...........:;.2Block 33 PIN#......:"
  1.  ;end new HEAT72503
  1.  ;start new abm*2.6*11 HEAT66367
  1.  I ("^29^"[("^"_($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,ABM("VTYP"),0)),U,4))_"^")) D
  1.  .S DR="119Block 48..........:"
  1.  ;end new HEAT66367
  1.  D:($G(DR)) ^DIE G XIT:$D(Y)
  1.  ;end new FIXPMS10028
  1.  ;I $P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,ABM("VTYP"),0)),U,4)=27 S DR="116//"_$S($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("DFN"),".211","I"),1,"I")="R":8,1:4)  D ^DIE G XIT:$D(Y)  ;abm*2.6*10 HEAT73780  ;abm*2.6*13 export mode 35
  1.  ;below line new abm*2.6*13 export mode 35
  1.  I "^27^35^"[("^"_$P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,ABM("VTYP"),0)),U,4)_"^") S DR="116//"_$S($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("DFN"),".211","I"),1,"I")="R":8,1:4)  D ^DIE G XIT:$D(Y)  ;abm*2.6*10 HEAT73780
  1.  ;I ($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,ABM("VTYP"),0)),U,4)=3!($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,ABM("VTYP"),0)),U,4)=14)),$P($G(^AUTNINS(ABM("DFN"),2)),U)="D" D  ;abm*2.6*10 HEAT73780
  1.  I ($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,ABM("VTYP"),0)),U,4)=3!($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,ABM("VTYP"),0)),U,4)=14)),$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("DFN"),".211","I"),1,"I")="D" D  ;abm*2.6*10 HEAT73780
  1.  .S DR="107Dash in block 1A?" D ^DIE
  1.  I ("^11^21^31^51^28^"[(U_($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,ABM("VTYP"),0)),U,4))_U)),$P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,0)),U,12)=1!($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,0)),U,4)=11)!($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,0)),U,4)=28) D
  1.  .S DR=".24RX# IN FL44?....." D ^DIE
  1.  S ABM(0)=^ABMNINS(DUZ(2),ABM("DFN"),1,DA,0)
  1.  I $P($G(^ABMNINS(DUZ(2),ABM("DFN"),0)),U,9)="L" S DR="18////@" D ^DIE
  1.  ;
  1.  I $P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,0)),U,4),$P($G(^ABMDEXP($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,0)),U,4),0)),U)["837" D
  1.  .K DR,DIC,DIE,DIR,X,Y
  1.  .S DIR(0)="Y"
  1.  .S DIR("A")="Contract Code Req'd"
  1.  .S:$P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,1)),U,13)'="" DIR("B")=$P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,1)),U,13)
  1.  .S DIR("?")="This may be used by certain payers to report contract information.  This populates the CN1 segment on the 837."
  1.  .D ^DIR K DIR
  1.  .S ABMANS=Y
  1.  .I ABMANS=1 D
  1.  ..K DR,DIC,DIE,DIR,X,Y
  1.  ..S DIR(0)="S^02:PER DIEM;03:VARIABLE PER DIEM;04:FLAT;05:CAPITATED;06:PERCENT;09:OTHER"
  1.  ..I $P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,0)),U,4)=21 S $P(DIR(0),U,2)="01:DIAGNOSIS RELATED GROUP (DRG);"_$P(DIR(0),U,2)
  1.  ..S DIR("A")="Contract Code Type"
  1.  ..S:$P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,1)),U,11) DIR("B")=$P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,1)),U,11)
  1.  ..D ^DIR K DIR
  1.  ..S ABMCTYP=Y
  1.  ..S DA(1)=ABM("DFN")
  1.  ..S DIE="^ABMNINS(DUZ(2),DA(1),1,"
  1.  ..S DA=ABM("VTYP")
  1.  ..S DR="111////"_ABMCTYP_";112;113////Y"
  1.  ..D ^DIE
  1.  .I ABMANS=0 D
  1.  ..S DA(1)=ABM("DFN")
  1.  ..S DIE="^ABMNINS(DUZ(2),DA(1),1,"
  1.  ..S DA=ABM("VTYP")
  1.  ..;S DR="113////N"  ;abm*2.6*10 HEAT61723
  1.  ..S DR="113////N;111////@;112////@"  ;abm*2.6*10 HEAT61723
  1.  ..D ^DIE
  1.  .S DA(1)=ABM("DFN")
  1.  .S DIE="^ABMNINS(DUZ(2),DA(1),1,"
  1.  .S DA=ABM("VTYP")
  1.  D SERVLOC^ABMDTIN2  ;abm*2.6*9 HEAT57746
  1.  ;
  1.  I $P($G(^ABMNINS(DUZ(2),ABM("DFN"),0)),U,9)="N"!($P($G(^ABMNINS(DUZ(2),ABM("DFN"),0)),U,9)="B") S DR="18SUBPART NPI:" D ^DIE
  1.  S DR="104DME Contractor?.....:" D ^DIE
  1.  I $P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,1)),U,4)="Y" D
  1.  .S DR="103DME GROUP NUMBER/NAME:" D ^DIE
  1.  .S DR="105CLIA# req'd for all visits? " D ^DIE
  1.  .I $P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,1)),U,5)="Y" D
  1.  ..S DR="106Which CLIA should print? " D ^DIE
  1.  I $P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,1)),U,4)'="Y" D
  1.  .S DR="103////@;105////@;106////@" D ^DIE
  1.  G DISP:$P(^AUTNINS(ABM("DFN"),2),U,2)'="Y"
  1.  I $P($G(^ABMDEXP(+$P(ABM(0),U,4),0)),U)["UB" D  G XIT:$D(Y)
  1.  .S DR=".03R~Revenue Code........:;.09Revenue Description.:" D ^DIE Q:$D(Y)
  1.  .S DR=".11Bill Type...........:" D ^DIE
  1.  S DR=".16CPT Code............:" D ^DIE Q:$D(Y)
  1.  S DA(2)=ABM("DFN"),DA(1)=ABM("VTYP")
  1.  S DIC("P")=$P(^DD(9002274.091,11,0),U,2)
  1.  S DIC="^ABMNINS(DUZ(2),DA(2),1,DA(1),11,",DIC(0)="AEMQL"
  1.  D ^DIC Q:+Y<0
  1.  S DIE="^ABMNINS(DUZ(2),DA(2),1,DA(1),11,",DA=+Y,DR=".01;.02;.03" D ^DIE
  1.  G DISP
  1.  ;
  1. XIT I '$O(^ABMNINS(DUZ(2),ABM("DFN"),1,0)) K ^ABMNINS(DUZ(2),ABM("DFN"),1,0)
  1.  Q
  1. VHDR ;VISIT TABLE HEADER
  1.  W $$EN^ABMVDF("IOF")
  1.  W !!,"Visit",?27,"Mode of",?39,"Mult",?45,"Fee",?52,"------- Flat Rate --------"
  1.  W !,"Type - Description",?28,"Export",?39,"Form",?44,"Sched",?52,"Start      Stop       Rate "
  1.  W !,"==============================================================================="
  1.  Q
  1. INACTVTM(ABMINS,ABMVTYP,ABMDT) ;Make sure all other entries are termed before adding new one
  1.  S ABMVTIEN=0
  1.  F  S ABMVTIEN=$O(^ABMNINS(DUZ(2),ABMINS,1,ABMVTYP,12,ABMVTIEN)) Q:+ABMVTIEN=0  D
  1.  .I $P($G(^ABMNINS(DUZ(2),ABMINS,1,ABMVTYP,12,ABMVTIEN,0)),U,2)="" D
  1.  ..Q:ABMVTIEN=+$G(ABMINACK)  ;entry that was just added-skip it
  1.  ..S DA(2)=ABMINS
  1.  ..S DA(1)=ABMVTYP
  1.  ..S DIE="^ABMNINS(DUZ(2),"_DA(2)_",1,"_DA(1)_",12,"
  1.  ..S DA=ABMVTIEN
  1.  ..S DR=".02"_$S($G(ABMDT)'="":"////"_ABMDT,1:"//"_DT)  ;stuff today for end date
  1.  ..D ^DIE
  1.  Q
  1. DISPRPL ; EP-display active replacement insurer/visit 
  1.  I $D(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,12,0)) D
  1.  .S ABMMVTD=""
  1.  .F  S ABMMVTD=$O(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,12,"B",ABMMVTD),-1) Q:ABMMVTD=""!($G(ABMVFLG)=1)  D
  1.  ..S ABMVTI=""
  1.  ..F  S ABMVTI=$O(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,12,"B",ABMMVTD,ABMVTI)) Q:ABMVTI=""!($G(ABMVFLG)=1)  D  Q:$G(ABMVFLG)=1
  1.  ...Q:$P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,12,ABMVTI,0)),U,2)'=""  ;end date exists
  1.  ...;active was found-display replacment info and flag to quit
  1.  ...W !!,"This VISIT TYPE is currently replaced with the following:"
  1.  ...W !?3,$$SDT^ABMDUTL($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,12,ABMVTI,0)),U))  ;eff date
  1.  ...W:$P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,12,ABMVTI,0)),U,3)'="" ?20,$P($G(^AUTNINS($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,12,ABMVTI,0)),U,3),0)),U)  ;insurer
  1.  ...W:$P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,12,ABMVTI,0)),U,4)'="" ?45,$P($G(^ABMDVTYP($P($G(^ABMNINS(DUZ(2),ABM("DFN"),1,DA,12,ABMVTI,0)),U,4),0)),U),!  ;visit type
  1.  ...S ABMVFLG=1
  1.  Q
  1. REPLCEIT ;EP- prompt for replacement insurer/visit type
  1.  S DA(2)=ABM("DFN"),DA(1)=ABM("VTYP")
  1.  S ABMATCK=1,ABMPSINS=+Y
  1.  S DIC("P")=$P(^DD(9002274.091,12,0),U,2)
  1.  S DIC="^ABMNINS(DUZ(2),DA(2),1,DA(1),12,",DIC(0)="AEMQL"
  1.  D ^DIC Q:+Y<0
  1.  S (DA,ABMINACK)=+Y
  1.  I $P(Y,U,3)="" D
  1.  .S DIE="^ABMNINS(DUZ(2),DA(2),1,DA(1),12,"
  1.  .S DR=".02;.03;.04"
  1.  .D ^DIE
  1.  Q
  1. REPLCECK ;EP- make sure replacement follows "rules"
  1.  S ABMMINS=$P($G(^ABMNINS(DUZ(2),DA(2),1,DA(1),12,DA,0)),U,3)
  1.  S ABMMVTYP=$P($G(^ABMNINS(DUZ(2),DA(2),1,DA(1),12,DA,0)),U,4)
  1.  I ABMMINS=""!(ABMMVTYP="") D  Q
  1.  .W !,"Replacement must have a Insurer and a visit type to be complete!"
  1.  .S DIK="^ABMNINS(DUZ(2),DA(2),1,DA(1),12," D ^DIK Q  ;incomplete entry
  1.  I ABMMINS=DA(2),ABMMVTYP=DA(1) D  Q
  1.  .W !,"Replacement Insurer/Visit Type can not replace itself!"
  1.  .H 2
  1.  .S DIK="^ABMNINS(DUZ(2),DA(2),1,DA(1),12,"
  1.  .D ^DIK
  1.  I $G(ABMMVTYP),('$D(^ABMNINS(DUZ(2),ABMMINS,1,ABMMVTYP,0))) D  Q
  1.  .W !,"Replacement Insurer/Visit Type not set up!  Must be set up before it can replace."
  1.  .H 2
  1.  .S DIK="^ABMNINS(DUZ(2),DA(2),1,DA(1),12,"
  1.  .D ^DIK
  1.  I $P($G(^AUTNINS(ABMMINS,1)),U,7)=4 D  Q
  1.  .W !,"Replacement Insurer is designated UNBILLABLE."
  1.  .H 2
  1.  .S DIK="^ABMNINS(DUZ(2),DA(2),1,DA(1),12,"
  1.  .D ^DIK
  1.  I $P($G(^AUTNINS(ABMMINS,2)),U,7)'="" D  Q
  1.  .W !,"Replacement Insurer can not be one that's merged."
  1.  .H 2
  1.  .S DIK="^ABMNINS(DUZ(2),DA(2),1,DA(1),12,"
  1.  .D ^DIK
  1.  Q