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

ABMDEML.m

Go to the documentation of this file. 
  1. ABMDEML ; IHS/SD/SDR - Edit Utility - FOR MULTIPLES ;   
  1.  ;;2.6;IHS Third Party Billing;**1,2,3,6,8,9,10,11,13,14,18,21,23,27**;NOV 12, 2009;Build 486
  1.  ;
  1.  ;IHS/ASDS/DMJ 2.4*7 NOIS HQW-0701-100066 Modifications made related to Medicare Part B
  1.  ;IHS/ASDS/LSL 2.4*9 NOIS HQW-0701-100066 Above change doesn't work as ABMP("HCFA") is undefined. Changed code back to listing HCFA modes of export
  1.  ;
  1.  ;IHS/SD/SDR 2.5*4 IM11671 Added 837 format to list so it would inquire for corr. diagnosis
  1.  ;IHS/SD/SDR 2.5*5 Modified to put POS, TOS by line item
  1.  ;IHS/SD/SDR 2.5*8 IM14079 Edited code to not do TOS prompt if 837 format
  1.  ;IHS/SD/SDR 2.5*8 IM12246 Added In-House and Reference LAB CLIA prompts
  1.  ;IHS/SD/SDR 2.5*8 task 6 Added code to populate mileage on page 3A when A0425/A0888 are used
  1.  ;IHS/SD/SDR 2.5*9 task 1 Coded for new line item provider multiple
  1.  ;IHS/SD/SDR 2.5*10 IM20346 Variables getting carried over for Stuff tag
  1.  ;IHS/SD/SDR 2.5*10 IM21539 Made OBSTETRICAL? question be asked in correct place
  1.  ;IHS/SD/SDR 2.5*13 POA changes
  1.  ;
  1.  ;IHS/SD/SDR 2.6 CSV
  1.  ;IHS/SD/SDR 2.6*1 HEAT6566 populate anes based on MCR/non-MCR
  1.  ;IHS/SD/SDR 2.6*2 3PMS10003A modified to call ABMFEAPI
  1.  ;IHS/SD/SDR 2.6*3 HEAT11696 added 36415 to use lab prompts
  1.  ;IHS/SD/SDR 2.6*3 HEAT12742 removed HEAT6566 changes
  1.  ;IHS/SD/SDR 2.6*6 5010 Added prompt for 2400 DTP test date
  1.  ;IHS/SD/SDR 2.6*13 added check for new export mode 35 and to populate DATE OF FIRST SYMPTOM and INJURY DATE based on occurrence code 11
  1.  ;IHS/SD/SDR 2.6*14 ICD10 002F and 002H - when adding DX or PX to claim, populated PRIORITY and ICD INDICATOR accordingly
  1.  ;IHS/SD/SDR 2.6*14 HEAT165301 Removed link between page 9A and page 3 questions introduced in patch13
  1.  ;IHS/SD/SDR 2.6*21 HEAT240919 Added Provider Narrative default for DX and PX.  Was missing default after switch to ICD10.
  1.  ;IHS/SD/SDR 2.6*21 HEAT136508 Made change to ask for CLIA if lab code starts with 'G'
  1.  ;IHS/SD/SDR 2.6*21 HEAT235867 Added code to put default provider narrative for ICD10 codes.  DD change was causing there to be no default
  1.  ;IHS/SD/AML 2.6*23 HEAT247169 Added code to prompt for NDC when subfile is 43.
  1.  ;IHS/SD/SDR 2.6*27 CR8894 Fixed so default fee would show up from fee table if there is one.  Also fixed anesthesia page to use pointer, not actual CPT.
  1.  ;  was causing NO SUCH ENTRY to display for CPT name if CPT wasn't DINUMed.  Also made change for category 13 and the CPT code is something specific,
  1.  ;  like lab or rad
  1.  ; *********************************
  1. A1 ;
  1.  ;Documentation by Linda Lehman 3/19/97
  1.  ;Entry Point for pages in claim editor that allow multiple additions.  Pages 8A, 8B, 8E, 8F, 8G, 8H, 8I
  1.  ;(If select A as desired ACTION)
  1.  ;
  1.  ;VARIABLES:
  1.  ;ABMZ("DR") String of fields to be filed by ^DIE
  1.  ;ABMZ("TITL") Title corresponding to Claim Editor page number
  1.  ;ABMZ("DICS") Specific code for lookup screen
  1.  ;ABMZ("SUB") Number of multiple in 3P Claim File
  1.  ;ABMZ("DICI")
  1.  ;ABMZ("DICW")
  1.  ;ABMZ("ANTH") Set to null if page 8G, otherwise undefined
  1.  ;ABMZ("REVN") Revenue code field for DR string (only set on pages 8A, 8E, 8F)
  1.  ;ABMZ("MOD") Modifier field # in 3P Claim appropriate multiple ^ modifier category ^ 2nd modifier field # (only if HCFA) ^ 3rd modifier field # (only if HCFA)
  1.  ;  Modifier category:
  1.  ;  1 = Medical    (27)
  1.  ;  2 = Anesthesia (39)
  1.  ;  3 = Surgical   (21)
  1.  ;  4 = Radiology  (35)
  1.  ;  5 = Laboratory (37)
  1.  ; 
  1.  ;ABMZ("NARR") Providers narrative, 1st piece is field # for DR
  1.  ;ABMZ("CHRG")  
  1.  I $G(ABM)]"" S ABMZ("DR")=ABM
  1.  E  S ABM=ABMZ("DR")
  1.  K ABMX,DIC
  1.  W:$D(ABMZ("TITL")) !!!,"===============  ADD MODE - ",ABMZ("TITL"),"  ==============="
  1.  I $D(ABMZ("RX")) D  Q:Y<1  G DUPCHK
  1.  .D RX^ABMDEMLB
  1.  .Q:Y<1
  1.  .S Y=$P(Y(0),U,6)
  1.  .S ABMZ("DR")=$P(ABMZ("DR"),".03")_".03//"_$P(Y(0),U,7)_$P(ABMZ("DR"),".03",2)_";.06////"_$P(Y(0),U)
  1.  ;If a special screen exist for this page (only 8G), then use that code.  Otherwise, find the screen for file, .01 field 
  1.  ;of specified 3P claim file multiple points to.
  1.  I $D(ABMZ("DICS")) S DIC("S")=ABMZ("DICS")
  1.  E  S ABMX("DICS")="9002274.30"_ABMZ("SUB") X:$D(^DD(ABMX("DICS"),.01,12.1)) ^DD(ABMX("DICS"),.01,12.1)
  1.  S DIC=$S($D(ABMZ("DICI")):ABMZ("DICI"),1:ABMZ("DIC"))
  1.  ;S DIC(0)="QEAM"  ;abm*2.6*14
  1.  S DIC(0)="QEAMI"  ;abm*2.6*14
  1.  S DIC("A")="Select "_ABMZ("ITEM")_": "
  1.  S:$D(ABMZ("DICW")) DIC("W")=ABMZ("DICW")
  1.  ;
  1. DIC ;
  1.  ;Perform look-up into specified file.
  1.  D ^DIC
  1.  G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(X=""),DIC:+Y<1
  1.  K DIC
  1.  ;if anesthesia page or revenue code multiple
  1.  ;I $D(ABMZ("ANTH"))!(ABMZ("SUB")=25) S Y=$P(Y,U,2)  ;abm*2.6*27 IHS/SD/SDR CR8894
  1.  I (ABMZ("SUB")=25) S Y=$P(Y,U,2)  ;abm*2.6*27 IHS/SD/SDR CR8894
  1.  ;
  1. DUPCHK ;USED TO BE THE DUPLICATE CHECK LINE TAG
  1.  S ABMX("Y")=+Y
  1.  ;
  1.  ;if Dental multiple (page)
  1.  ;and no opsite asked add level of serive to DR string
  1.  I $G(ABMZ("SUB"))=33 D
  1.  .I $P(^AUTTADA(ABMX("Y"),0),U,9)]"" S ABMZ("DR")=$P(ABMZ("DR"),";.05")
  1.  .S ABMX("NEWY")=1_$P(Y,"^",2)
  1.  ;Go get modifiers if no rev code
  1.  G MOD:'$D(ABMZ("REVN"))
  1.  ;If default rev code for CPT code, add to DR string and get mods
  1.  I $P($$IHSCPT^ABMCVAPI(ABMX("Y"),ABMP("VDT")),U,3)>0 S ABMZ("DR")=ABMZ("DR")_$P(ABMZ("REVN"),"//")_"//"_$P($$IHSCPT^ABMCVAPI(ABMX("Y"),ABMP("VDT")),U,3) G MOD  ;CSV-c
  1.  ;If CPT category and it has default rev code in the
  1.  ;CPT category file, add it DR string and get mods
  1.  I $P($$CPT^ABMCVAPI(ABMX("Y"),ABMP("VDT")),U,4)>0,$P($$IHSCAT^ABMCVAPI($P($$CPT^ABMCVAPI(ABMX("Y"),ABMP("VDT")),U,4),ABMP("VDT")),U)'="" D  G MOD  ;CSV-c
  1.  .S ABMZ("DR")=ABMZ("DR")_$P(ABMZ("REVN"),"//")_"//"_$P($$IHSCAT^ABMCVAPI($P($$CPT^ABMCVAPI(ABMX("Y"),ABMP("VDT")),U,4),ABMP("VDT")),U)  ;CSV-c
  1.  S ABMZ("DR")=ABMZ("DR")_ABMZ("REVN")
  1.  ;
  1. MOD ;
  1.  I $D(ABMZ("MOD")) D MOD^ABMDEMLC   ;Add modifiers
  1.  ;If provider narrative, ask it, add to DR string
  1.  I $D(ABMZ("NARR")) D
  1.  .S ABMX("DICB")=$P(@(ABMZ("DIC")_ABMX("Y")_",0)"),U,$P(ABMZ("NARR"),U,2))
  1.  .I ABMZ("SUB")=17 S ABMX("DICB")=$P($$DX^ABMCVAPI(ABMX("Y"),ABMP("VDT"),"",""),U,4)  ;abm*2.6*21 IHS/SD/SDR HEAT235867, 240919
  1.  .I ABMZ("SUB")=19 S ABMX("DICB")=$P($$ICDOP^ABMCVAPI(ABMX("Y"),ABMP("VDT"),"",""),U,5)  ;abm*2.6*21 IHS/SD/SDR HEAT235867, 240919
  1.  .D NARR^ABMDEMLC
  1.  .I $G(ABMZ("SUB"))=17&($P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y")&(($E(ABMP("BTYP"),1,2)=11)!($E(ABMP("BTYP"),1,2)="12")) S ABMZ("DR")=ABMZ("DR")_";.05//"
  1.  .S ABMZ("DR")=ABMZ("DR")_$P(ABMZ("NARR"),U)_+Y
  1.  I '$D(ABMZ("CHRG")) G DIAG
  1.  S ABMX("DIC")=$S($E(ABMZ("DIC"),3,5)="CPT":ABMZ("CAT"),$E(ABMZ("DIC"),6,8)="ADA":21,1:31)
  1.  I ABMX("DIC")=31 S Y=$E(Y,1,2)_"0"
  1.  I $G(ABMZ("CAT"))=13 D
  1.  .;start new abm*2.6*27 IHS/SD/SDR CR8894
  1.  .S ABMX("TST")=$P($G(^ICPT(ABMX("Y"),0)),U)
  1.  .S ABMTF=0
  1.  .F ABMT=1:1:($L(ABMX("TST"))) D  ;if there's an alpha char involved leave category as 13 for HCPCS
  1.  ..I $A($E(ABMX("TST"),ABMT))>64 S ABMTF=1
  1.  .I ABMTF=1 Q
  1.  .S ABMX("Y")=ABMX("TST")
  1.  .I ABMX("Y")<2000 S ABMX("DIC")=23 Q
  1.  .;end new abm*2.6*27 IHS/SD/SDR CR8894
  1.  .I ABMX("Y")<70000 S ABMX("DIC")=11 Q
  1.  .I ABMX("Y")<80000 S ABMX("DIC")=15 Q
  1.  .I ABMX("Y")<90000 S ABMX("DIC")=17 Q
  1.  .I ABMX("Y")<100000 S ABMX("DIC")=19 Q
  1.  I $D(ABMZ("ANTH")) S ABMX("DIC")=23
  1.  I $D(ABMZ("CONTRACT")) D CONT^ABMDEMLB I Y=1 G DIAG
  1.  I $D(ABMZ("OUTLAB")) D LAB^ABMDEMLB I Y=1 G DIAG
  1.  S:'$G(ABMX("NEWY")) ABMX("NEWY")=ABMX("Y")
  1.  S ABMZ("DR")=ABMZ("DR")_ABMZ("CHRG")
  1.  ;I $D(^ABMDFEE(ABMP("FEE"),ABMX("DIC"),ABMX("NEWY"),0)) D  ;abm*2.6*27 IHS/SD/SDR CR8894
  1.  I $D(^ABMDFEE(ABMP("FEE"),ABMX("DIC"),+$$DINUM^ABMFOFS($P($G(^ICPT(+ABMX("NEWY"),0)),U)),0)) D  ;abm*2.6*27 IHS/SD/SDR CR8894
  1.  .S ABMZ("DR")=ABMZ("DR")_$S($D(ABMP("638")):"//",ABMZ("SUB")=43:"//",ABMZ("CAT")=23:"//",1:"///")
  1.  .I +$G(ABMZ("MODFEE"))=$G(ABMZ("MODFEE")) D  Q
  1.  ..S ABMZ("DR")=ABMZ("DR")_ABMZ("MODFEE")
  1.  .;S ABMZ("DR")=ABMZ("DR")_$P($$ONE^ABMFEAPI(ABMP("FEE"),ABMX("DIC"),ABMX("NEWY"),ABMP("VDT")),U)  ;abm*2.6*2 3PMS10003A  ;abm*2.6*27 IHS/SD/SDR CR8894
  1.  .S ABMZ("DR")=ABMZ("DR")_$P($$ONE^ABMFEAPI(ABMP("FEE"),ABMX("DIC"),$P($G(^ICPT(+ABMX("NEWY"),0)),U),ABMP("VDT")),U)  ;abm*2.6*2 3PMS10003A  ;abm*2.6*27 IHS/SD/SDR CR8894
  1.  ;start new abm*2.6*9 NARR
  1.  I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMX("Y"))) D
  1.  .Q:$P($G(^ABMDEXP(ABMP("EXP"),0)),U)'["5010"  ;only 5010 formats
  1.  .S ABMCNCK=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMX("Y"),0))
  1.  .I ABMCNCK,$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMCNCK,0)),U,2)="Y" S ABMZ("DR")=ABMZ("DR")_";22Narrative"
  1.  ;end new NARR
  1.  D POSA^ABMDEMLC
  1.  ;I ABMP("EXP")'=21,(ABMP("EXP")'=22),(ABMP("EXP")'=23),(ABMP("EXP")'=32) D TOSA^ABMDEMLC  ;don't do for 837 formats  ;abm*2.6*6 5010  ;abm*2.6*8 5010
  1.  I ABMP("EXP")'=21,(ABMP("EXP")'=22),(ABMP("EXP")'=23),(ABMP("EXP")'=31),(ABMP("EXP")'=32),(ABMP("EXP")'=33) D TOSA^ABMDEMLC  ;don't do for 837 formats  ;abm*2.6*6 5010  ;abm*2.6*8 5010
  1.  I ABMZ("SUB")=43 S ABMZ("DR")=ABMZ("DR")_";.19"  ;abm*2.6*23 IHS/SD/AML HEAT247169
  1.  ;I ($G(ABMX("Y"))>79999&($G(ABMX("Y"))<90000))!($G(ABMZ("SUB"))=37&(ABMX("Y")=36415)) D  ;lab charges only  ;abm*2.6*3 HEAT11696  ;abm*2.6*21 HEAT136508
  1.  I ($G(ABMX("Y"))>79999&($G(ABMX("Y"))<90000))!($G(ABMZ("SUB"))=37&(ABMX("Y")=36415))!($E($P($$CPT^ABMCVAPI($G(ABMX("Y"),ABMP("VDT")),U,2),U,2))="G") D  ;lab charges only  ;abm*2.6*3 HEAT11696  ;abm*2.6*21 HEAT136508
  1.  .I $D(ABMX("MODS",90)) S ABMZ("DR")=ABMZ("DR")_";.14//"_$S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,23)'="":$P($G(^ABMRLABS($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,23),0)),U,2),1:"")
  1.  .E  S ABMZ("DR")=ABMZ("DR")_";.13//"_$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,22)
  1.  I ABMZ("SUB")=37 D
  1.  .Q:+$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",ABMX("Y"),0))=0
  1.  .S ABMIIEN=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",ABMX("Y"),0))
  1.  .Q:$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,ABMIIEN,0)),U,2)'="Y"
  1.  .S:(ABMP("EXP")=22) ABMZ("DR")=ABMZ("DR")_";W !,!,""Enter LABORATORY Results:"";.19;.21"
  1.  .S:(ABMP("EXP")=32) ABMZ("DR")=ABMZ("DR")_";W !,!,""Enter LABORATORY Results:"";.19;.21;.22"  ;abm*2.6*6 5010
  1.  .S:((ABMP("EXP")=21)!(ABMP("EXP")=31)) ABMZ("DR")=ABMZ("DR")_";W !,!,""Value Code 48 or 49 should be present on Page 9C"",!"  ;abm*2.6*8 5010
  1.  I $P($G(^ICPT(ABMX("Y"),0)),U,3),($P($G(^DIC(81.1,$P($G(^ICPT(ABMX("Y"),0)),U,3),0)),U)["IMMUNIZATION") S ABMZ("DR")=ABMZ("DR")_";15"  ;abm*2.6*6 5010
  1.  ;
  1. DIAG ;CORRESPONDING DIAGNOSES
  1.  D
  1.  .Q:'$D(ABMZ("DIAG"))
  1.  .I '$D(ABMP("EXP",2)),'$D(ABMP("EXP",3)),'$D(ABMP("EXP",14)),'$D(ABMP("EXP",15)),'$D(ABMP("EXP",19)),'$D(ABMP("EXP",20)),'$D(ABMP("EXP",22)),'$D(ABMP("EXP",27)),'$D(ABMP("EXP",32)),'$D(ABMP("EXP",35)) Q  ;abm*2.6*13 export mode 35
  1.  .D DX^ABMDEMLC Q:$G(Y(0))=""
  1.  .S ABMZ("DR")=ABMZ("DR")_ABMZ("DIAG")_"////"_$G(Y(0))
  1.  ;
  1. STUFF ;FILE MULTIPLE
  1.  K DR,DIC,DA
  1.  S ABMZ("DR")=ABMZ("DR")_";.17///M"
  1.  I $L($T(@ABMZ("SUB"))) D @(ABMZ("SUB"))
  1.  I ABMZ("SUB")'=23&(ABMZ("SUB")'=45) D
  1.  .S Y=ABMX("Y")
  1.  .G XIT:'+Y
  1.  .S X=+Y
  1.  .S @ABMZ("X")=X
  1.  .S DA(1)=ABMP("CDFN")
  1.  .S DIC="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMZ("SUB")_","
  1.  .S DIC("DR")=$P(ABMZ("DR"),";",2,99)
  1.  .S DIC(0)="LE"
  1.  .;S:$D(ABMZ("DR2")) DIC("DR")=DIC("DR")_ABMZ("DR2")  ;abm*2.6*14 ICD10 002F and 002H
  1.  .;start new abm*2.6*14 ICD10 002F and 002H
  1.  .I (ABMZ("SUB")=17) D
  1.  ..I ($P($$DX^ABMCVAPI(+X,ABMP("VDT")),U,20)=30)&(ABMP("ICD10")<ABMP("VDT")) S DIC("DR")=DIC("DR")_ABMZ("DR2")
  1.  ..;I ($P($$DX^ABMCVAPI(X,ABMP("VDT")),U,20)=1)&(ABMP("ICD10")>ABMP("VDT")) S DIC("DR")=DIC("DR")_ABMZ("DR2")
  1.  ..I ($P($$DX^ABMCVAPI(+X,ABMP("VDT")),U,20)'=30)&(ABMP("ICD10")>ABMP("VDT")) S DIC("DR")=DIC("DR")_ABMZ("DR2")
  1.  ..I ($P($$DX^ABMCVAPI(+X,ABMP("VDT")),U,20)=30) S DIC("DR")=DIC("DR")_";.06////1"
  1.  .I (ABMZ("SUB")=19) D
  1.  ..I ($P($$ICDOP^ABMCVAPI(+X,ABMP("VDT")),U,15)=31)&(ABMP("ICD10")<ABMP("VDT")) S DIC("DR")=DIC("DR")_ABMZ("DR2")
  1.  ..I ($P($$ICDOP^ABMCVAPI(+X,ABMP("VDT")),U,15)'=31)&(ABMP("ICD10")>ABMP("VDT")) S DIC("DR")=DIC("DR")_ABMZ("DR2")
  1.  ..I ($P($$ICDOP^ABMCVAPI(+X,ABMP("VDT")),U,15)=31) S DIC("DR")=DIC("DR")_";.06////1"
  1.  .I "^17^19^"'[("^"_ABMZ("SUB")_"^") D
  1.  ..S:$D(ABMZ("DR2")) DIC("DR")=DIC("DR")_ABMZ("DR2")
  1.  .;end new 002F and 002H 
  1.  .S:+$G(ABMZ("NUM"))=0 ^ABMDCLM(DUZ(2),DA(1),ABMZ("SUB"),0)="^9002274.30"_ABMZ("SUB")_"P^^"
  1.  .K DD,DO
  1.  .D FILE^DICN
  1.  .S ABMOIEN=ABMX("Y")  ;abm*2.6*13
  1. PROV ;
  1.  I ABMZ("SUB")=21!(ABMZ("SUB")=23)!(ABMZ("SUB")=27)!(ABMZ("SUB")=35)!(ABMZ("SUB")=37)!(ABMZ("SUB")=39)!(ABMZ("SUB")=43)!(ABMZ("SUB")=47) D  ;abm*2.6*10
  1.  .K DIC,DR,DIE,DA
  1.  .S DA(2)=ABMP("CDFN")
  1.  .S DA(1)=+Y
  1.  .S DIC="^ABMDCLM(DUZ(2),"_DA(2)_","_ABMZ("SUB")_","_DA(1)_",""P"","
  1.  .S DIC(0)="AELMQ"
  1.  .S ABMFLNM="9002274.30"_$G(ABMZ("SUB"))
  1.  .I $G(ABMDPRV)'="" S DIC("B")=ABMDPRV
  1.  .K ABMDPRV
  1.  .S DIC("P")=$P(^DD(ABMFLNM,.18,0),U,2)
  1.  .;default to rendering
  1.  .S DIC("DR")=".02//RENDERING"
  1.  .;change default to ordering if rendering exists already
  1.  .I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA(1),"P","C","R")) S DIC("DR")=".02//ORDERING"
  1.  .D ^DIC
  1.  D MILEAGE
  1.  I ABMZ("SUB")=23 D A^ABMDE8D
  1.  G XIT:$D(ABMZ("ADD1"))
  1.  S:$D(ABMZ("DR2")) $P(ABMZ("DR2"),"////",2)=$P(ABMZ("DR2"),"////",2)+1
  1. XIT ;
  1.  K ABMX,DIC
  1.  Q
  1. 39 ;EP - dr string for anesthesia page
  1.  ;S ABMZ("DR")=ABMZ("DR")_";.15//11;.07:.08"  ;abm*2.6*1 HEAT6566  ;abm*2.6*10 HEAT76189
  1.  S ABMZ("DR")=ABMZ("DR")_";.07:.08"  ;abm*2.6*1 HEAT6566  ;IHS/SD/AML 7/20/2012 HEAT76189 - REMOVE DUPLICATE POS FIELD
  1.  ;I ABMP("ITYP")="R" S ABMZ("DR")=ABMZ("DR")_";.12//1;.06;.07:.09;.03"  ;abm*2.6*1 HEAT6566
  1.  Q
  1. MILEAGE ;
  1.  ;I (ABMZ("SUB")=47)!(ABMZ("SUB")=43),"A0888^A0425"[$P($$CPT^ABMCVAPI(ABMX("Y"),ABMP("VDT")),U,2) D  ;CSV-c  ;abm*2.6*10
  1.  I (ABMZ("SUB")=47)!(ABMZ("SUB")=43),"^A0888^A0425^"[("^"_$P($$CPT^ABMCVAPI(ABMX("Y"),ABMP("VDT")),U,2)_"^") D  ;CSV-c  ;abm*2.6*10
  1.  .S DIE="^ABMDCLM(DUZ(2),"
  1.  .S DA=ABMP("CDFN")
  1.  .S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),"B",ABMX("Y"),0))
  1.  .Q:+ABMIEN=0  ;abm*2.6*11 HEAT88601
  1.  .I $P($$CPT^ABMCVAPI(ABMX("Y"),ABMP("VDT")),U,2)="A0425" S DR=".128////"_$S(+$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,8)=0:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMIEN,0)),U,3),1:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,8))  ;CSV-c
  1.  .I $P($$CPT^ABMCVAPI(ABMX("Y"),ABMP("VDT")),U,2)="A0888" S DR=".129////"_$S(+$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,9)=0:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMIEN,0)),U,3),1:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),12)),U,9))  ;CSV-c
  1.  .D ^DIE
  1.  Q
  1.  ;abm*2.6*14 HEAT165301 removed below
  1.  ;start new abm*2.6*13 new export mode
  1.  ;OCCURCD ;
  1.  ;populated page3 DATE OF FIRST SYMPTOM if occurrence code 11 is entered
  1.  ;I ABMZ("SUB")=51 D
  1.  ;.S ABMP("ACDT")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),51,ABMOIEN,0)),U,2)
  1.  ;.S ABMTEST=$P(^ABMDCODE($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),51,ABMOIEN,0)),U),0),U)
  1.  ;.S DIE="^ABMDCLM(DUZ(2),"
  1.  ;.S DA=ABMP("CDFN")
  1.  ;.I ABMTEST="01" S DR=".82////"_$S(+$G(ABMDEL)=1:"@",1:ABMP("ACDT"))
  1.  ;.I ABMTEST=11 S DR=".86////"_$S(+$G(ABMDEL)=1:"@",1:ABMP("ACDT"))
  1.  ;.D ^DIE K DR
  1.  ;Q
  1.  ;end new abm*2.6*13