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