ABMDEMLE ; IHS/ASDST/DMJ - Edit Utility - FOR MULTIPLES ;
;;2.6;IHS 3P BILLING SYSTEM;**3,6,8,9,10,11,13,14,15,18,21,23**;NOV 12, 2009;Build 427
;
; IHS/SD/SDR - v2.5 p5 - 5/18/04 - Modified to put POS and TOS by line item
; IHS/SD/SDR - v2.5 p6 - 7/9/04 - IM14079 and IM14121 - Edited code for TOS
; call to not do if 837 format
; IHS/SD/SDR - v2.5 p8 - IM12246/IM17548 - Coded new prompts for In-House and Reference Lab CLIAs
; IHS/SD/SDR - v2.5 p8 - task 6 - Added code for mileage population on page 3A and message about editing
; IHS/SD/SDR - v2.5 p9 - task 1 - Added code for new provider multiple on service lines
; IHS/SD/SDR - v2.5 p9 - IM19820 - Fix for <UNDEF>E2+37^ABMDEMLE
; IHS/SD/SDR - v2.5 p10 - task order item 1 - Calls added for Chargemaster. Calls supplied by Lori Butcher
; IHS/SD/SDR - v2.5 p11 - IM23175 - Added code so G0107 could be entered on the lab page. It needs a CLIA number
;
; IHS/SD/SDR - v2.6 CSV
; IHS/SD/SDR - abm*2.6*6 - 5010 - added code for SV5 segment
; IHS/SD/SDR - abm*2.6*6 - 5010 - added code for 2400 DTP Test Date
;IHS/SD/SDR - 2.6*13 - exp mode 35. Linked occurrence codes (01 and 11) to page 3 questions (Date First Symptom and Injury Date)
;IHS/SD/SDR - 2.6*14 - HEAT161263 - Changed to use $$GET1^DIQ so output transform will execute for SNOMED/Provider Narrative; also
; made change so provider narrative can't be edited if there are SNOMED codes present on claim
;IHS/SD/SDR - 2.6*14 - HEAT165301 - Removed link between page 9a and 3 introduced in patch 13
;IHS/SD/SDR - 2.6*15 - Added change so they can edit the POA even if there is a SNOMED on the claim
;IHS/SD/SDR - 2.6*18 - HEAT240919 - put code back from p14 so user can edit provider narrative
;IHS/SD/AML - 2.6*21 - HEAT197195 - Removed dot so POA would be editable on page 5A.
;IHS/SD/SDR - 2.6*21 - HEAT233742 - Updated check for CPT Narrative prompt. Wasnt' including Surgical (21) or Ambulance (47) because the range
; wasn't inclusive. Changed >21 to >20 and <47 to <48.
;IHS/SD/AML 2.6*23 HEAT247169 - Add .19 for NDC to list of editable fields if subfile is 43
;
E1 ; Edit Multiple
I ABMZ("NUM")=0 W *7,!!,"There are no entries to edit, you must first ADD an entry.",! K DIR S DIR(0)="E" D ^DIR K DIR Q
S ABMX("EDIT")=""
I $E(Y,2)>0&($E(Y,2)<(ABMZ("NUM")+1)) S Y=$E(Y,2) G E2
I ABMZ("NUM")=1 S Y=1 G E2
K DIR S DIR(0)="NO^1:"_ABMZ("NUM")_":0"
S DIR("?")="Enter the Sequence Number of "_ABMZ("ITEM")_" to Edit",DIR("A")="Sequence Number to EDIT"
D ^DIR K DIR
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(+Y'>0)
E2 W !!!,"[",+Y,"] ",$P(ABMZ(+Y),U) S ABMX("Y")=+Y
I $P(ABMZ(+Y),U)="A0",$P($G(^DIC(40.7,ABMP("CLN"),0)),U,2)="A3" W !,"Please edit this value on page 3A1" H 1 K ABMZ("Y"),ABMZ("DR") Q
;only execute MOD2^ABMDEMLC if it is not a tran code entry (Chargemaster)
I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),$P(ABMZ(ABMX("Y")),U,2),0),U,17)'["|TC" D
.I $D(ABMZ("MOD")),$P($G(^ABMDPARM(DUZ(2),1,2)),"^",5) D MOD2^ABMDEMLC S ABMZ("DR")=ABMZ("DR")_ABMZ("CHRG")_"////"_ABMZ("MODFEE")
;start new code abm*2.6*9 NARR
;I ABMZ("SUB")>21,ABMZ("SUB")<47,ABMZ("SUB")'=41,$D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMZIEN)) D ;abm*2.6*10 HEAT74291
;I ABMZ("SUB")>21,ABMZ("SUB")<47,ABMZ("SUB")'=41,$G(ABMZIEN)'="",$D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMZIEN)) D ;abm*2.6*10 HEAT74291 ;abm*2.6*21 IHS/SD/SDR HEAT233742
I ABMZ("SUB")>20,ABMZ("SUB")<48,ABMZ("SUB")'=41,$G(ABMZIEN)'="",$D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMZIEN)) D ;abm*2.6*10 HEAT74291 ;abm*2.6*21 IHS/SD/SDR HEAT233742
.Q:$P($G(^ABMDEXP(ABMP("EXP"),0)),U)'["5010" ;only 5010 formats
.S ABMCNCK=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMZIEN,0))
.I ABMCNCK,$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMCNCK,0)),U,2)="Y" S ABMZ("DR")=ABMZ("DR")_";22"
;end new code NARR
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
I $D(ABMZ("DIAG")) D DX^ABMDEMLC G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) S ABMZ("DR")=ABMZ("DR")_ABMZ("DIAG")_"////"_$G(Y(0))
I $D(ABMZ("NARR")),$P(ABMZ(ABMX("Y")),U,$P(ABMZ("NARR"),U,3)) D ;abm*2.6*14 HEAT161263 ;abm*2.6*18 IHS/SD/SDR HEAT240919 uncommented line
.;I $D(ABMZ("NARR")),$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,$P(ABMZ(ABMX("Y")),U,2),1))="",$P(ABMZ(ABMX("Y")),U,$P(ABMZ("NARR"),U,3)) D ;only allow editing of prv narr if SNOMED not present ;abm*2.6*14 HEAT161263
.;S ABMX("DICB")=$G(^AUTNPOV($P(ABMZ(ABMX("Y")),U,$P(ABMZ("NARR"),U,3)),0))_U_$P(ABMZ(ABMX("Y")),U,$P(ABMZ("NARR"),U,3)) ;abm*2.6*14 HEAT161263
.S IENS=$P(ABMZ(ABMX("Y")),U,$P(ABMZ("NARR"),U,3)) ;abm*2.6*14 HEAT161263
.S ABMX("DICB")=$$GET1^DIQ(9999999.27,IENS,".01","E") ;abm*2.6*14 HEAT161263
.D NARR^ABMDEMLC S ABMZ("DR")=ABMZ("DR")_$P(ABMZ("NARR"),U)_+Y
.;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//" ;abm*2.6*15
;end old abm*2.6*18 IHS/SD/SDR HEAT240919
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//" ;abm*2.6*21 IHS/SD/SDR HEAT197195 edit POA
; don't do POS if page 5 (Dxs)
I $G(ABMZ("SUB"))'=17 D
.D POSA^ABMDEMLC ;abm*2.6*9 NOHEAT ;abm*2.6*10 IHS/SD/AML HEAT76189 - <<REACTIVATED LINE>> REMOVE DUPLICATE POS FIELD FROM 8G, ASKS FOR POS NOW
.I ABMP("EXP")'=21,(ABMP("EXP")'=22),(ABMP("EXP")'=23) D TOSA^ABMDEMLC ;don't do for 837 formats
;I $G(ABMZIEN)'="",((ABMZIEN>79999)&(ABMZIEN<90000))!($P($$CPT^ABMCVAPI(ABMZIEN,ABMP("VDT")),U,2)="G0107") D ;G0107 or Lab charges only ;CSV-c ;abm*2.6*3 HEAT11696
;I $G(ABMZIEN)'="",((ABMZIEN>79999)&(ABMZIEN<90000))!($P($$CPT^ABMCVAPI(ABMZIEN,ABMP("VDT")),U,2)="G0107")!(ABMZIEN=36415) D ;G0107 or Lab charges only ;CSV-c ;abm*2.6*3 HEAT11696 ;abm*2.6*8 HEAT40295
I $G(ABMZIEN)'="",((ABMZIEN>79999)&(ABMZIEN<90000))!($E($P($$CPT^ABMCVAPI(ABMZIEN,ABMP("VDT")),U,2))="G")!(ABMZIEN=36415) D ;G0107 or Lab charges only ;CSV-c ;abm*2.6*3 HEAT11696 ;abm*2.6*8 HEAT40295
.S ABMXMOD=""
.S DA=$P(ABMZ(ABMX("Y")),U,2)
.I ABMZ("SUB")=43 F ABMMOD=5,8,9 I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,ABMMOD)=90 S ABMXMOD=1
.I ABMZ("SUB")=37 F ABMMOD=6,7,8 I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,ABMMOD)=90 S ABMXMOD=1
.I $G(ABMXMOD)'="" D
..S ABMODFLT=$S($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,14):$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,14),1:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,23))
..S ABMODFLT=$$GET1^DIQ(9002274.35,ABMODFLT,".01","E") ;display ref lab by name, not IEN into ref lab file ;abm*2.6*11 HEAT85498
..S ABMZ("DR")=ABMZ("DR")_";.13////@;.14//^S X=ABMODFLT"
.E S ABMZ("DR")=ABMZ("DR")_";.14////@;.13//"_$S($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,13):$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,13),1:$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,22))
I ABMZ("SUB")=37 D
.Q:+$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",ABMZIEN,0))=0
.S ABMIIEN=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",ABMZIEN,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) ABMZ("DR")=ABMZ("DR")_";W !,!,""Value Code 48 or 49 should be present on Page 9C"",!"
I $D(ABMZ("REVN")) S ABMZ("DR")=ABMZ("DR")_$P(ABMZ("REVN"),"//")
I $D(ABMZ("CONTRACT")) D CONT^ABMDEMLB
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
I $D(ABMZ("OUTLAB")) D LAB^ABMDEMLB
;I $D(ABMP(638)),$D(ABMZ("CHRG")) S ABMZ("DR")=ABMZ("DR")_ABMZ("CHRG") ;abm*2.6*3
I $D(ABMZ("CHRG")) S ABMZ("DR")=ABMZ("DR")_ABMZ("CHRG") ;abm*2.6*3
I $D(ABMZ("RX")),'$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,$P(ABMZ(ABMX("Y")),U,2),0),U,6) D
.W !!,"Select PRESCRIPTION NUMBER: "
.D RX^ABMDEMLB
.I Y>0 S ABMZ("DR")=ABMZ("DR")_";.06////"_$P(Y(0),U) Q
.W !,*7,"No match was found in the PRESCRIPTION FILE for this Drug and Patient!",!
I ABMZ("SUB")=39 D 39^ABMDEML
I ABMZ("SUB")=43 S ABMZ("DR")=ABMZ("DR")_";.19" ;abm*2.6*23 IHS/SD/AML HEAT247169
I ABMZ("SUB")=43&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,4)="Y") S ABM("DR")=$S($G(ABM("DR")):ABM("DR")_";11;12;13;14",1:"11;12;13;14") ;abm*2.6*6 5010
S DA(1)=ABMP("CDFN"),DA=$P(ABMZ(ABMX("Y")),U,2),DIE="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMZ("SUB")_",",DR=$E(ABMZ("DR"),2,200) D ^DIE K DR
S DR=".17///M" D ^DIE
;start new code abm*2.6*6 5010
I ABMZ("SUB")=21!(ABMZ("SUB")=27)!(ABMZ("SUB")=35)!(ABMZ("SUB")=37)!(ABMZ("SUB")=39)!(ABMZ("SUB")=43)!(ABMZ("SUB")=47) D
.I $P($G(^ICPT($P(ABMZ(ABMX("Y")),U),0)),U,3)="" Q ;CPT has no CPT category to check
.I ($P($G(^DIC(81.1,$P($G(^ICPT(+$P(ABMZ(ABMX("Y")),U),0)),U,3),0)),U)["IMMUNIZATION") S DR="15//" D ^DIE
;end new code 5010
;I ABMZ("SUB")=51,"^01^11^"[("^"_$P($G(^ABMDCODE($P(ABMZ(ABMX("Y")),U,2),0)),U)_"^") S ABMOIEN=$P(ABMZ(ABMX("Y")),U,2) D OCCURCD^ABMDEML ;abm*2.6*13 exp mode 35 ;abm*2.6*14 HEAT165301
PROV ;
S DA=$P(ABMZ(ABMX("Y")),U,2)
I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,"P",0))>0 D
.W !
.S ABMIEN=0
.F S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,"P",ABMIEN)) Q:+ABMIEN=0 D
..W !?5,$P($G(^VA(200,$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,"P",ABMIEN,0)),U),0)),U)
..W ?40,$S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,"P",ABMIEN,0)),U,2)="R":"RENDERING",$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,"P",ABMIEN,0)),U,2)="D":"ORDERING",1:"")
.W !
K DIC,DR,DIE,DA
S DA(2)=ABMP("CDFN")
S DA(1)=$P(ABMZ(ABMX("Y")),U,2)
S DIC="^ABMDCLM(DUZ(2),"_DA(2)_","_ABMZ("SUB")_","_DA(1)_",""P"","
S DIC(0)="AELMQ"
S ABMFLNM="9002274.30"_$G(ABMZ("SUB"))
S DIC("P")=$P($G(^DD(ABMFLNM,.18,0)),U,2)
Q:DIC("P")=""
I $G(ABMDPRV)'="" S DIC("B")=ABMDPRV ;abm*2.6*10
S DIC("DR")=".01;.02//RENDERING"
I +$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA(1),"P","C","R",0))>0 S DIC("DR")=".01;.02//ORDERING"
D ^DIC
K DIC,DR,DIE,DA
I +Y>0,(+$P(Y,U,3)=0) D
.K DIE,DA,DR
.S DA(2)=ABMP("CDFN")
.S DA(1)=$P(ABMZ(ABMX("Y")),U,2)
.S DIE="^ABMDCLM(DUZ(2),"_DA(2)_","_ABMZ("SUB")_","_DA(1)_",""P"","
.S DA=+Y
.S DR=".01//;.02"
.D ^DIE
I $G(ABMP("EXP"))=14!($G(ABMP("EXP"))=22) D
.S ABMPVCKR=0
.S ABMPVCKD=0
.S ABMTYP=""
.S ABMLN=$P(ABMZ(ABMX("Y")),U,2)
.F S ABMTYP=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMLN,"P","C",ABMTYP)) Q:ABMTYP="" D
..S ABMIEN=0
..F S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMLN,"P","C",ABMTYP,ABMIEN)) Q:+ABMIEN=0 D
...I ABMTYP="R" S ABMPVCKR=+$G(ABMPVCKR)+1
...I ABMTYP="D" S ABMPVCKD=+$G(ABMPVCKD)+1
.I ABMPVCKR>1!(ABMPVCKD>1) D G PROV
..W !!,"YOU HAVE ENTERED TWO ",$S(ABMPVCKR>1:"RENDERING",1:"ORDERING")," PROVIDERS AND ONLY ONE CAN BE PUT ON AN 837P."
..K ABMPVCKR,ABMPVCKD,ABMTYP,ABMIEN,ABMLN
MILEAGE ;
;I ((ABMZ("SUB")=47)!(ABMZ("SUB")=43)),("A0888^A0425"[$P(ABMZ(ABMX("Y")),U)) D ;abm*2.6*10 COB billing
I ((ABMZ("SUB")=47)!(ABMZ("SUB")=43)),("^A0888^A0425^"[("^"_$P(ABMZ(ABMX("Y")),U))_"^") D ;abm*2.6*10 COB billing
.S DIE="^ABMDCLM(DUZ(2),"
.S DA=ABMP("CDFN")
.;start old code abm*2.6*10 HEAT68832
.;S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),"B",ABMX("Y"),0))
.;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
.;end old code start new code HEAT68832
.S ABMIEN=$P(ABMZ(ABMX("Y")),U,2)
.I $P(ABMZ(ABMX("Y")),U)="A0425" D
..;changed below during p10 testing to update page 3A all the time
..;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 ;abm*2.6*10
..S DR=".128////"_$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMIEN,0)),U,3) ;abm*2.6*10
.I $P(ABMZ(ABMX("Y")),U)="A0888" D
..;changed below during p10 testing to update page 3A all the time
..;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 ;abm*2.6*10
..S DR=".129////"_$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMIEN,0)),U,3) ;abm*2.6*10
.;end new code HEAT68832
.D ^DIE
;
XIT K ABMX
Q
ABMDEMLE ; IHS/ASDST/DMJ - Edit Utility - FOR MULTIPLES ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**3,6,8,9,10,11,13,14,15,18,21,23**;NOV 12, 2009;Build 427
+2 ;
+3 ; IHS/SD/SDR - v2.5 p5 - 5/18/04 - Modified to put POS and TOS by line item
+4 ; IHS/SD/SDR - v2.5 p6 - 7/9/04 - IM14079 and IM14121 - Edited code for TOS
+5 ; call to not do if 837 format
+6 ; IHS/SD/SDR - v2.5 p8 - IM12246/IM17548 - Coded new prompts for In-House and Reference Lab CLIAs
+7 ; IHS/SD/SDR - v2.5 p8 - task 6 - Added code for mileage population on page 3A and message about editing
+8 ; IHS/SD/SDR - v2.5 p9 - task 1 - Added code for new provider multiple on service lines
+9 ; IHS/SD/SDR - v2.5 p9 - IM19820 - Fix for <UNDEF>E2+37^ABMDEMLE
+10 ; IHS/SD/SDR - v2.5 p10 - task order item 1 - Calls added for Chargemaster. Calls supplied by Lori Butcher
+11 ; IHS/SD/SDR - v2.5 p11 - IM23175 - Added code so G0107 could be entered on the lab page. It needs a CLIA number
+12 ;
+13 ; IHS/SD/SDR - v2.6 CSV
+14 ; IHS/SD/SDR - abm*2.6*6 - 5010 - added code for SV5 segment
+15 ; IHS/SD/SDR - abm*2.6*6 - 5010 - added code for 2400 DTP Test Date
+16 ;IHS/SD/SDR - 2.6*13 - exp mode 35. Linked occurrence codes (01 and 11) to page 3 questions (Date First Symptom and Injury Date)
+17 ;IHS/SD/SDR - 2.6*14 - HEAT161263 - Changed to use $$GET1^DIQ so output transform will execute for SNOMED/Provider Narrative; also
+18 ; made change so provider narrative can't be edited if there are SNOMED codes present on claim
+19 ;IHS/SD/SDR - 2.6*14 - HEAT165301 - Removed link between page 9a and 3 introduced in patch 13
+20 ;IHS/SD/SDR - 2.6*15 - Added change so they can edit the POA even if there is a SNOMED on the claim
+21 ;IHS/SD/SDR - 2.6*18 - HEAT240919 - put code back from p14 so user can edit provider narrative
+22 ;IHS/SD/AML - 2.6*21 - HEAT197195 - Removed dot so POA would be editable on page 5A.
+23 ;IHS/SD/SDR - 2.6*21 - HEAT233742 - Updated check for CPT Narrative prompt. Wasnt' including Surgical (21) or Ambulance (47) because the range
+24 ; wasn't inclusive. Changed >21 to >20 and <47 to <48.
+25 ;IHS/SD/AML 2.6*23 HEAT247169 - Add .19 for NDC to list of editable fields if subfile is 43
+26 ;
E1 ; Edit Multiple
+1 IF ABMZ("NUM")=0
WRITE *7,!!,"There are no entries to edit, you must first ADD an entry.",!
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+2 SET ABMX("EDIT")=""
+3 IF $EXTRACT(Y,2)>0&($EXTRACT(Y,2)<(ABMZ("NUM")+1))
SET Y=$EXTRACT(Y,2)
GOTO E2
+4 IF ABMZ("NUM")=1
SET Y=1
GOTO E2
+5 KILL DIR
SET DIR(0)="NO^1:"_ABMZ("NUM")_":0"
+6 SET DIR("?")="Enter the Sequence Number of "_ABMZ("ITEM")_" to Edit"
SET DIR("A")="Sequence Number to EDIT"
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!(+Y'>0)
GOTO XIT
E2 WRITE !!!,"[",+Y,"] ",$PIECE(ABMZ(+Y),U)
SET ABMX("Y")=+Y
+1 IF $PIECE(ABMZ(+Y),U)="A0"
IF $PIECE($GET(^DIC(40.7,ABMP("CLN"),0)),U,2)="A3"
WRITE !,"Please edit this value on page 3A1"
HANG 1
KILL ABMZ("Y"),ABMZ("DR")
QUIT
+2 ;only execute MOD2^ABMDEMLC if it is not a tran code entry (Chargemaster)
+3 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),$PIECE(ABMZ(ABMX("Y")),U,2),0),U,17)'["|TC"
Begin DoDot:1
+4 IF $DATA(ABMZ("MOD"))
IF $PIECE($GET(^ABMDPARM(DUZ(2),1,2)),"^",5)
DO MOD2^ABMDEMLC
SET ABMZ("DR")=ABMZ("DR")_ABMZ("CHRG")_"////"_ABMZ("MODFEE")
End DoDot:1
+5 ;start new code abm*2.6*9 NARR
+6 ;I ABMZ("SUB")>21,ABMZ("SUB")<47,ABMZ("SUB")'=41,$D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMZIEN)) D ;abm*2.6*10 HEAT74291
+7 ;I ABMZ("SUB")>21,ABMZ("SUB")<47,ABMZ("SUB")'=41,$G(ABMZIEN)'="",$D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMZIEN)) D ;abm*2.6*10 HEAT74291 ;abm*2.6*21 IHS/SD/SDR HEAT233742
+8 ;abm*2.6*10 HEAT74291 ;abm*2.6*21 IHS/SD/SDR HEAT233742
IF ABMZ("SUB")>20
IF ABMZ("SUB")<48
IF ABMZ("SUB")'=41
IF $GET(ABMZIEN)'=""
IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMZIEN))
Begin DoDot:1
+9 ;only 5010 formats
IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),0)),U)'["5010"
QUIT
+10 SET ABMCNCK=$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,"B",ABMZIEN,0))
+11 IF ABMCNCK
IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),5,ABMCNCK,0)),U,2)="Y"
SET ABMZ("DR")=ABMZ("DR")_";22"
End DoDot:1
+12 ;end new code NARR
+13 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
+14 IF $DATA(ABMZ("DIAG"))
DO DX^ABMDEMLC
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
SET ABMZ("DR")=ABMZ("DR")_ABMZ("DIAG")_"////"_$GET(Y(0))
+15 ;abm*2.6*14 HEAT161263 ;abm*2.6*18 IHS/SD/SDR HEAT240919 uncommented line
IF $DATA(ABMZ("NARR"))
IF $PIECE(ABMZ(ABMX("Y")),U,$PIECE(ABMZ("NARR"),U,3))
Begin DoDot:1
+16 ;I $D(ABMZ("NARR")),$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,$P(ABMZ(ABMX("Y")),U,2),1))="",$P(ABMZ(ABMX("Y")),U,$P(ABMZ("NARR"),U,3)) D ;only allow editing of prv narr if SNOMED not present ;abm*2.6*14 HEAT161263
+17 ;S ABMX("DICB")=$G(^AUTNPOV($P(ABMZ(ABMX("Y")),U,$P(ABMZ("NARR"),U,3)),0))_U_$P(ABMZ(ABMX("Y")),U,$P(ABMZ("NARR"),U,3)) ;abm*2.6*14 HEAT161263
+18 ;abm*2.6*14 HEAT161263
SET IENS=$PIECE(ABMZ(ABMX("Y")),U,$PIECE(ABMZ("NARR"),U,3))
+19 ;abm*2.6*14 HEAT161263
SET ABMX("DICB")=$$GET1^DIQ(9999999.27,IENS,".01","E")
+20 DO NARR^ABMDEMLC
SET ABMZ("DR")=ABMZ("DR")_$PIECE(ABMZ("NARR"),U)_+Y
+21 ;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//" ;abm*2.6*15
End DoDot:1
+22 ;end old abm*2.6*18 IHS/SD/SDR HEAT240919
+23 ;abm*2.6*21 IHS/SD/SDR HEAT197195 edit POA
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//"
+24 ; don't do POS if page 5 (Dxs)
+25 IF $GET(ABMZ("SUB"))'=17
Begin DoDot:1
+26 ;abm*2.6*9 NOHEAT ;abm*2.6*10 IHS/SD/AML HEAT76189 - <<REACTIVATED LINE>> REMOVE DUPLICATE POS FIELD FROM 8G, ASKS FOR POS NOW
DO POSA^ABMDEMLC
+27 ;don't do for 837 formats
IF ABMP("EXP")'=21
IF (ABMP("EXP")'=22)
IF (ABMP("EXP")'=23)
DO TOSA^ABMDEMLC
End DoDot:1
+28 ;I $G(ABMZIEN)'="",((ABMZIEN>79999)&(ABMZIEN<90000))!($P($$CPT^ABMCVAPI(ABMZIEN,ABMP("VDT")),U,2)="G0107") D ;G0107 or Lab charges only ;CSV-c ;abm*2.6*3 HEAT11696
+29 ;I $G(ABMZIEN)'="",((ABMZIEN>79999)&(ABMZIEN<90000))!($P($$CPT^ABMCVAPI(ABMZIEN,ABMP("VDT")),U,2)="G0107")!(ABMZIEN=36415) D ;G0107 or Lab charges only ;CSV-c ;abm*2.6*3 HEAT11696 ;abm*2.6*8 HEAT40295
+30 ;G0107 or Lab charges only ;CSV-c ;abm*2.6*3 HEAT11696 ;abm*2.6*8 HEAT40295
IF $GET(ABMZIEN)'=""
IF ((ABMZIEN>79999)&(ABMZIEN<90000))!($EXTRACT($PIECE($$CPT^ABMCVAPI(ABMZIEN,ABMP("VDT")),U,2))="G")!(ABMZIEN=36415)
Begin DoDot:1
+31 SET ABMXMOD=""
+32 SET DA=$PIECE(ABMZ(ABMX("Y")),U,2)
+33 IF ABMZ("SUB")=43
FOR ABMMOD=5,8,9
IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,ABMMOD)=90
SET ABMXMOD=1
+34 IF ABMZ("SUB")=37
FOR ABMMOD=6,7,8
IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,ABMMOD)=90
SET ABMXMOD=1
+35 IF $GET(ABMXMOD)'=""
Begin DoDot:2
+36 SET ABMODFLT=$SELECT($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,14):$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,14),1:$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,23))
+37 ;display ref lab by name, not IEN into ref lab file ;abm*2.6*11 HEAT85498
SET ABMODFLT=$$GET1^DIQ(9002274.35,ABMODFLT,".01","E")
+38 SET ABMZ("DR")=ABMZ("DR")_";.13////@;.14//^S X=ABMODFLT"
End DoDot:2
+39 IF '$TEST
SET ABMZ("DR")=ABMZ("DR")_";.14////@;.13//"_$SELECT($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,13):$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,0),U,13),1:$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,22))
End DoDot:1
+40 IF ABMZ("SUB")=37
Begin DoDot:1
+41 IF +$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",ABMZIEN,0))=0
QUIT
+42 SET ABMIIEN=$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,"B",ABMZIEN,0))
+43 IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),4,ABMIIEN,0)),U,2)'="Y"
QUIT
+44 IF (ABMP("EXP")=22)
SET ABMZ("DR")=ABMZ("DR")_";W !,!,""Enter LABORATORY Results:"";.19;.21"
+45 ;abm*2.6*6 5010
IF (ABMP("EXP")=32)
SET ABMZ("DR")=ABMZ("DR")_";W !,!,""Enter LABORATORY Results:"";.19;.21;.22"
+46 IF (ABMP("EXP")=21)
SET ABMZ("DR")=ABMZ("DR")_";W !,!,""Value Code 48 or 49 should be present on Page 9C"",!"
End DoDot:1
+47 IF $DATA(ABMZ("REVN"))
SET ABMZ("DR")=ABMZ("DR")_$PIECE(ABMZ("REVN"),"//")
+48 IF $DATA(ABMZ("CONTRACT"))
DO CONT^ABMDEMLB
+49 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
+50 IF $DATA(ABMZ("OUTLAB"))
DO LAB^ABMDEMLB
+51 ;I $D(ABMP(638)),$D(ABMZ("CHRG")) S ABMZ("DR")=ABMZ("DR")_ABMZ("CHRG") ;abm*2.6*3
+52 ;abm*2.6*3
IF $DATA(ABMZ("CHRG"))
SET ABMZ("DR")=ABMZ("DR")_ABMZ("CHRG")
+53 IF $DATA(ABMZ("RX"))
IF '$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,$PIECE(ABMZ(ABMX("Y")),U,2),0),U,6)
Begin DoDot:1
+54 WRITE !!,"Select PRESCRIPTION NUMBER: "
+55 DO RX^ABMDEMLB
+56 IF Y>0
SET ABMZ("DR")=ABMZ("DR")_";.06////"_$PIECE(Y(0),U)
QUIT
+57 WRITE !,*7,"No match was found in the PRESCRIPTION FILE for this Drug and Patient!",!
End DoDot:1
+58 IF ABMZ("SUB")=39
DO 39^ABMDEML
+59 ;abm*2.6*23 IHS/SD/AML HEAT247169
IF ABMZ("SUB")=43
SET ABMZ("DR")=ABMZ("DR")_";.19"
+60 ;abm*2.6*6 5010
IF ABMZ("SUB")=43&($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,4)="Y")
SET ABM("DR")=$SELECT($GET(ABM("DR")):ABM("DR")_";11;12;13;14",1:"11;12;13;14")
+61 SET DA(1)=ABMP("CDFN")
SET DA=$PIECE(ABMZ(ABMX("Y")),U,2)
SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMZ("SUB")_","
SET DR=$EXTRACT(ABMZ("DR"),2,200)
DO ^DIE
KILL DR
+62 SET DR=".17///M"
DO ^DIE
+63 ;start new code abm*2.6*6 5010
+64 IF ABMZ("SUB")=21!(ABMZ("SUB")=27)!(ABMZ("SUB")=35)!(ABMZ("SUB")=37)!(ABMZ("SUB")=39)!(ABMZ("SUB")=43)!(ABMZ("SUB")=47)
Begin DoDot:1
+65 ;CPT has no CPT category to check
IF $PIECE($GET(^ICPT($PIECE(ABMZ(ABMX("Y")),U),0)),U,3)=""
QUIT
+66 IF ($PIECE($GET(^DIC(81.1,$PIECE($GET(^ICPT(+$PIECE(ABMZ(ABMX("Y")),U),0)),U,3),0)),U)["IMMUNIZATION")
SET DR="15//"
DO ^DIE
End DoDot:1
+67 ;end new code 5010
+68 ;I ABMZ("SUB")=51,"^01^11^"[("^"_$P($G(^ABMDCODE($P(ABMZ(ABMX("Y")),U,2),0)),U)_"^") S ABMOIEN=$P(ABMZ(ABMX("Y")),U,2) D OCCURCD^ABMDEML ;abm*2.6*13 exp mode 35 ;abm*2.6*14 HEAT165301
PROV ;
+1 SET DA=$PIECE(ABMZ(ABMX("Y")),U,2)
+2 IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,"P",0))>0
Begin DoDot:1
+3 WRITE !
+4 SET ABMIEN=0
+5 FOR
SET ABMIEN=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,"P",ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:2
+6 WRITE !?5,$PIECE($GET(^VA(200,$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,"P",ABMIEN,0)),U),0)),U)
+7 WRITE ?40,$SELECT($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,"P",ABMIEN,0)),U,2)="R":"RENDERING",$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA,"P",ABMIEN,0)),U,2)="D":"ORDERING",1:"")
End DoDot:2
+8 WRITE !
End DoDot:1
+9 KILL DIC,DR,DIE,DA
+10 SET DA(2)=ABMP("CDFN")
+11 SET DA(1)=$PIECE(ABMZ(ABMX("Y")),U,2)
+12 SET DIC="^ABMDCLM(DUZ(2),"_DA(2)_","_ABMZ("SUB")_","_DA(1)_",""P"","
+13 SET DIC(0)="AELMQ"
+14 SET ABMFLNM="9002274.30"_$GET(ABMZ("SUB"))
+15 SET DIC("P")=$PIECE($GET(^DD(ABMFLNM,.18,0)),U,2)
+16 IF DIC("P")=""
QUIT
+17 ;abm*2.6*10
IF $GET(ABMDPRV)'=""
SET DIC("B")=ABMDPRV
+18 SET DIC("DR")=".01;.02//RENDERING"
+19 IF +$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),DA(1),"P","C","R",0))>0
SET DIC("DR")=".01;.02//ORDERING"
+20 DO ^DIC
+21 KILL DIC,DR,DIE,DA
+22 IF +Y>0
IF (+$PIECE(Y,U,3)=0)
Begin DoDot:1
+23 KILL DIE,DA,DR
+24 SET DA(2)=ABMP("CDFN")
+25 SET DA(1)=$PIECE(ABMZ(ABMX("Y")),U,2)
+26 SET DIE="^ABMDCLM(DUZ(2),"_DA(2)_","_ABMZ("SUB")_","_DA(1)_",""P"","
+27 SET DA=+Y
+28 SET DR=".01//;.02"
+29 DO ^DIE
End DoDot:1
+30 IF $GET(ABMP("EXP"))=14!($GET(ABMP("EXP"))=22)
Begin DoDot:1
+31 SET ABMPVCKR=0
+32 SET ABMPVCKD=0
+33 SET ABMTYP=""
+34 SET ABMLN=$PIECE(ABMZ(ABMX("Y")),U,2)
+35 FOR
SET ABMTYP=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMLN,"P","C",ABMTYP))
IF ABMTYP=""
QUIT
Begin DoDot:2
+36 SET ABMIEN=0
+37 FOR
SET ABMIEN=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMLN,"P","C",ABMTYP,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:3
+38 IF ABMTYP="R"
SET ABMPVCKR=+$GET(ABMPVCKR)+1
+39 IF ABMTYP="D"
SET ABMPVCKD=+$GET(ABMPVCKD)+1
End DoDot:3
End DoDot:2
+40 IF ABMPVCKR>1!(ABMPVCKD>1)
Begin DoDot:2
+41 WRITE !!,"YOU HAVE ENTERED TWO ",$SELECT(ABMPVCKR>1:"RENDERING",1:"ORDERING")," PROVIDERS AND ONLY ONE CAN BE PUT ON AN 837P."
+42 KILL ABMPVCKR,ABMPVCKD,ABMTYP,ABMIEN,ABMLN
End DoDot:2
GOTO PROV
End DoDot:1
MILEAGE ;
+1 ;I ((ABMZ("SUB")=47)!(ABMZ("SUB")=43)),("A0888^A0425"[$P(ABMZ(ABMX("Y")),U)) D ;abm*2.6*10 COB billing
+2 ;abm*2.6*10 COB billing
IF ((ABMZ("SUB")=47)!(ABMZ("SUB")=43))
IF ("^A0888^A0425^"[("^"_$PIECE(ABMZ(ABMX("Y")),U))_"^")
Begin DoDot:1
+3 SET DIE="^ABMDCLM(DUZ(2),"
+4 SET DA=ABMP("CDFN")
+5 ;start old code abm*2.6*10 HEAT68832
+6 ;S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),"B",ABMX("Y"),0))
+7 ;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
+8 ;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
+9 ;end old code start new code HEAT68832
+10 SET ABMIEN=$PIECE(ABMZ(ABMX("Y")),U,2)
+11 IF $PIECE(ABMZ(ABMX("Y")),U)="A0425"
Begin DoDot:2
+12 ;changed below during p10 testing to update page 3A all the time
+13 ;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 ;abm*2.6*10
+14 ;abm*2.6*10
SET DR=".128////"_$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMIEN,0)),U,3)
End DoDot:2
+15 IF $PIECE(ABMZ(ABMX("Y")),U)="A0888"
Begin DoDot:2
+16 ;changed below during p10 testing to update page 3A all the time
+17 ;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 ;abm*2.6*10
+18 ;abm*2.6*10
SET DR=".129////"_$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),ABMIEN,0)),U,3)
End DoDot:2
+19 ;end new code HEAT68832
+20 DO ^DIE
End DoDot:1
+21 ;
XIT KILL ABMX
+1 QUIT
