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