ABMDE5 ; IHS/SD/SDR - Edit Page 5 - DIAGNOSIS ;
;;2.6;IHS Third Party Billing;**1,3,4,6,10,14,16,18**;NOV 12, 2009;Build 289
;
; IHS/SD/SDR - 11/4/02 - V2.5 P2 - NDA-0500-180002
; Modified to display E-codes
; IHS/SD/SDR - v2.5 p9 - IM19297
; 8 Dxs for 837 formats
; IHS/SD/SDR - v2.5 p11 - Added two more E-Codes for FL72 on
; the new UB-04 format
; IHS/SD/SDR - v2.5 p13 - POA changes
; Changed display to include POA
;
;IHS/SD/SDR - v2.6 CSV
;IHS/SD/SDR - abm*2.6*1 - HEAT7045 - Display page5B if procedure exists
;IHS/SD/SDR - abm*2.6*3 - NOHEAT - Fix display of 5B; wasn't displaying if no procs existed
;IHS/SD/SDR - abm*2.6*6 - HEAT29426 - <UNDEF>PRTTXT+3^ABMDWRAP error if ICD long desc missing; defaulted to short desc.
;IHS/SD/SDR - 2.6*14 ICD10 changes; also added refresh option for page 5A. Will allow user to basically do RBCL option
; for 17 multiple within claim editor.
;IHS/SD/SDR - 2.6*14 - dual coding - added screen so only ICD9 or ICD10 can be added based on ICD Indicator
;IHS/SD/SDR - 2.6*16 - HEAT217211 - Added PLACE OF OCCURRENCE to display
;IHS/SD/SDR - 2.6*18 - HEAT239392 - There are two PLACE OF OCCURRENCEs. It should display the appropriate one based on ICD9 vs ICD10.
;
OPT K ABM,ABME,ABMZ,ABMU
D DISP Q:$D(DUOUT)!$D(DTOUT)!$D(DIRUT)
;W !! S ABMP("OPT")="ADESVNJBQ" S:$G(ABMZ("NUM"))=0 ABMP("DFLT")="A" D SEL^ABMDEOPT K ABMP("ED") I "ADESVN"'[$E(Y) G XIT ;abm*2.6*14 ICD10 Refresh page 5A
W !! S ABMP("OPT")="ADESVNRIJBQ" S:$G(ABMZ("NUM"))=0 ABMP("DFLT")="A" D SEL^ABMDEOPT K ABMP("ED") I "ADESVNRI"'[$E(Y) G XIT ;abm*2.6*14 ICD10 Refresh page 5A
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
;I ABMP("PX")'="I"&($E(Y)="N") G XIT ;abm*2.6*1 HEAT7045
;I '$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,0))&($E(Y)="N") G XIT ;abm*2.6*1 HEAT7045 ;abm*2.6*3 NOHEAT
I (((ABMP("PX")'="I")&($E(Y)="N"))&'$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,0))) G XIT ;abm*2.6*3 NOHEAT
I $P(^ABMDEXP(ABMP("EXP"),0),U)'["UB"&($E(Y)="N") G XIT
I $E(Y)="A",($G(ABMP("EXP"))=21)!($G(ABMP("EXP"))=22)!($G(ABMP("EXP"))=23),($G(ABMZ("NUM"))>7) D ;more than 8 dxs for 837s
.S ABMBFY=Y
.S DIR(0)="Y"
.S DIR("A",1)="THE MODE OF EXPORT YOU ARE SUBMITTING FOR ONLY ALLOWS 8 DIAGNOSIS CODES."
.S DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE ENTERING ADDITIONAL CODES?"
.S DIR("B")="Y"
.D ^DIR
.K DIR
.I +Y<1 Q
.S Y=ABMBFY
G OPT2:$E(Y)="N"
;S ABM("DO")=$S($E(Y)="A":"A1^ABMDEML",$E(Y)="D":"D1^ABMDEMLB",$E(Y)="E":"E1^ABMDEMLE",$E(Y)="V":"^ABMDE5A",1:"S1^ABMDEMLA") D @ABM("DO") ;abm*2.6*14 ICD10 Refresh page 5A
S ABM("DO")=$S($E(Y)="A":"A1^ABMDEML",$E(Y)="D":"D1^ABMDEMLB",$E(Y)="E":"E1^ABMDEMLE",$E(Y)="V":"^ABMDE5A",$E(Y)="R":"REFRESH^ABMDE5A",$E(Y)="I":"IND^ABMDE5A",1:"S1^ABMDEMLA") D @ABM("DO") ;abm*2.6*14 ICD10 Refresh page 5A
D RES^ABMDEMLA(17)
G OPT
;
OPT2 K ABM,ABME,ABMZ
D DISP2^ABMDE5D Q:$D(DUOUT)!$D(DTOUT)!$D(DIRUT)
;W !! S ABMP("OPT")="ADESVNJBQ" D SEL^ABMDEOPT I "AVEVSDB"'[$E(Y) S:$D(ABMP("DDL"))&($E(ABMP("PAGE"),$L(ABMP("PAGE")))=5) ABMP("QUIT")="" G XIT ;abm*2.6*14 ICD10 ICD Indicator
W !! S ABMP("OPT")="ADESVNRIJBQ" D SEL^ABMDEOPT I "AVEVSDBRI"'[$E(Y) S:$D(ABMP("DDL"))&($E(ABMP("PAGE"),$L(ABMP("PAGE")))=5) ABMP("QUIT")="" G XIT ;abm*2.6*14 ICD10 ICD Indicator
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT),OPT:$E(Y)="B"
;S ABM("DO")=$S($E(Y)="A":"A1^ABMDEML",$E(Y)="E":"E1^ABMDEMLE",$E(Y)="D":"D1^ABMDEMLB",$E(Y)="V":"^ABMDE5B",1:"S1^ABMDEMLA") D @ABM("DO") ;abm*2.6*14 ICD10 ICD Indicator
S ABM("DO")=$S($E(Y)="A":"A1^ABMDEML",$E(Y)="E":"E1^ABMDEMLE",$E(Y)="D":"D1^ABMDEMLB",$E(Y)="V":"^ABMDE5B",$E(Y)="R":"REFRESH^ABMDE5A",$E(Y)="I":"IND^ABMDE5A",1:"S1^ABMDEMLA") D @ABM("DO") ;abm*2.6*14 ICD10 ICD Indicator
G OPT2
;
DISP S ABMZ("TITL")="DIAGNOSIS",ABMZ("PG")="5A"
D A^ABMDE5X
I $D(ABMP("DDL")),$Y>(IOSL-9) D PAUSE^ABMDE1 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) I 1
E D SUM^ABMDE1
;
DIAG ; Diagnosis Info
S ABMZ("SUB")=17,ABMZ("ITEM")="Diagnosis",ABMZ("DIC")="^ICD9(",ABMZ("X")="DINUM",ABMZ("DR")="",ABMZ("NARR")=";.03////"_U_3_U_4
;start new abm*2.6*14 dual coding
;screens ICD dx entries based on ICD Indicator
I ABMP("ICD10")>ABMP("VDT") S ABMZ("DICS")="I $P($$DX^ABMCVAPI(+Y,ABMP(""VDT"")),U,20)'=30"
E S ABMZ("DICS")="I $P($$DX^ABMCVAPI(+Y,ABMP(""VDT"")),U,20)=30"
;end new dual coding
D HD G LOOP
HD ;
;I ABMP("ICD10")>ABMP("VDT") W !,"ICD INDICATOR: ICD-9",! ;abm*2.6*10 ICD10 002G ;abm*2.6*14 ICD10 002G
W !,"ICD Indicator for "_$$GET1^DIQ(9999999.18,ABMP("INS"),".01","E")_" : " ;abm*2.6*14 ICD10 002G
W $S(ABMP("ICD10")>ABMP("VDT"):"ICD-9",1:"ICD-10"),! ;abm*2.6*14 ICD10 002G
;W !,"BIL",?6,"ICD9" ;abm*2.6*10 ICD10 002F
W !,"BIL",?7,"ICD" ;abm*2.6*10 ICD10 002F
;W !,"SEQ",?6," CODE " ;abm*2.6*10 ICD10 002F
W !,"SEQ",?6," CODE ",?14,"IND" ;abm*2.6*10 ICD10 002F
I $P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y"&(($E(ABMP("BTYP"),1,2)=11)!($E(ABMP("BTYP"),1,2)="12")) D
.;W ?13,"POA",?23,"Dx DESCRIPTION",?51,"PROVIDER'S NARRATIVE" ;abm*2.6*10 ICD10 002F
.W ?18,"POA",?28,"Dx DESCRIPTION",?54,"PROVIDER'S NARRATIVE" ;abm*2.6*10 ICD10 002F
;E W ?19,"Dx DESCRIPTION",?51,"PROVIDER'S NARRATIVE" ;abm*2.6*10 ICD10 002F
E W ?20,"Dx DESCRIPTION",?50,"PROVIDER'S NARRATIVE" ;abm*2.6*10 ICD10 002F
;W !,"===",?5,"=======" ;abm*2.6*10 ICD10 002F
W !,"===",?5,"========",?14,"===" ;abm*2.6*10 ICD10 002F
I $P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y"&(($E(ABMP("BTYP"),1,2)=11)!($E(ABMP("BTYP"),1,2)="12")) D
.;W ?13,"===",?17,"==========================",?44,"====================================" ;abm*2.6*10 ICD10 002F
.W ?18,"===",?22,"==========================",?49,"===============================" ;abm*2.6*10 ICD10 002F
;E W ?13,"==========================",?40,"=======================================" ;abm*2.6*10 ICD10 002F
E W ?18,"==========================",?45,"===================================" ;abm*2.6*10 ICD10 002F
Q
LOOP ;
S ABMEFLG=0
S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1))=0
;start new code abm*2.6*14 ICD10 002F
;this will remove codes from page 5A if the code set on the sequenced codes doesn't match the code set for the insurer
;manual claims will be a problem (because it will delete everything), but for a PCC claim all POVs will be viewable on
;the View option of page5A
S ABMI=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",0))
I +ABMI'=0 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMI,0))
I (+$G(ABM)'=0) D
.S ABMICDI=+$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABM,0)),U,6)
.I (ABMICDI=1&(ABMP("ICD10")>ABMP("VDT")))!((ABMICDI=0)&(ABMP("ICD10")<ABMP("VDT"))) D
..;remove all entries
..K ^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB")) S ^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),0)="^9002274.30"_ABMZ("SUB")_"P^^"
..D A^ABMDE5X
;end new code 002F
S ABM=""
F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABM)) Q:'ABM S ABM("X")=$O(^(ABM,"")),ABMZ("NUM")=ABM("I") D DX
S ABM("L")=ABMZ("LNUM")+1,ABMZ("DR2")=";.02////"_ABM("L")
I +$O(ABME(0)) S ABME("CONT")="" D ^ABMDERR K ABME("CONT")
Q
DX ;
S ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABM("X"),0) S:ABMZ("LNUM")<$P(^(0),U,2) ABMZ("LNUM")=$P(^(0),U,2)
I $Y>(IOSL-5) D PAUSE^ABMDE1 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) D HD
;ABMZ(ABM("I"))=code^multiple ien^code ien^provider narr^e-code^poa
;S ABMZ(ABM("I"))=$P($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2)_U_ABM("X")_U_$P(ABM("X0"),U)_U_$P(ABM("X0"),U,3)_U_$P(ABM("X0"),U,4)_U_$P(ABM("X0"),U,5) ;CSV-c ;abm*2.6*14 ICD10 002F
S ABMZ(ABM("I"))=$P($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2)_U_ABM("X")_U_$P(ABM("X0"),U)_U_$P(ABM("X0"),U,3)_U_$P(ABM("X0"),U,4)_U_$P(ABM("X0"),U,5)_U_$P(ABM("X0"),U,6) ;CSV-c ;abm*2.6*14 ICD10 002F
W !,$J(ABM("I"),2),?5,$P($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2) ;CSV-c ;code
;W ?15,$S($P(+ABM("X"),U,6)=1:"10",1:"9") ;abm*2.6*10 ICD10 002F ;abm*2.6*14 ICD10 002F
W ?15,$S(+$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,+ABM("X"),0)),U,6)=1:"10",1:"9") ;abm*2.6*14 ICD10 002F
;W:$P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y"&(($E(ABMP("BTYP"),1,2)=11)!($E(ABMP("BTYP"),1,2)="12")) ?14,$P(ABM("X0"),U,5) ;poa ;abm*2.6*10 ICD10 002F
W:$P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y"&(($E(ABMP("BTYP"),1,2)=11)!($E(ABMP("BTYP"),1,2)="12")) ?19,$P(ABM("X0"),U,5) ;poa ;abm*2.6*10 ICD10 002F
;I $G(ABMEFLG)=0,$P($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2)["E" D ECODE ;CSV-c ;abm*2.6*14 ICD10 002F
I $G(ABMEFLG)=0,$P($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2)["E",(ABMP("ICD10")>ABMP("VDT")) D ECODE ;CSV-c ;abm*2.6*14 ICD10 002F
S (ABMU("TXT"),ABMUTXT)="" ;abm*2.6*6 HEAT29426
I $D(^ICD9(ABM("X"),1)),$P(^ABMDPARM(DUZ(2),1,0),U,14)="Y" D ;if there's a desc and site wants long desc
.S ABMU("TXT")=""
.K ABMZCPTD
.;D ICDDX^ABMCVAPI($P($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2),"ABMZCPTD","",ABMP("VDT")) ;desc array
.;S ABMU("TXT")=$$ICDDX^ABMCVAPI(+ABM("X"),$P($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2),"ABMZCPTD","",ABMP("VDT")) ;desc array ;abm*2.6*4 HEAT19688
.S ABMUTXT=$$ICDDX^ABMCVAPI(+ABM("X"),$P($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2),"ABMZCPTD","",ABMP("VDT")) ;desc array ;abm*2.6*4 HEAT19688
.S ABM("CP")=0
.F S ABM("CP")=$O(ABMZCPTD(ABM("CP"))) Q:(+ABM("CP")=0) D
..Q:($G(ABMZCPTD(ABM("CP")))="")
..S ABMU("TXT")=ABMU("TXT")_ABMZCPTD(ABM("CP"))_" "
;E S ABMU("TXT")=$P($$DX^ABMCVAPI(ABM("X"),ABMP("VDT")),U,4) ;CSV-c ;abm*2.6*6 HEAT29426
I $P($G(^ABMDPARM(DUZ(2),1,0)),U,14)'="Y"!(ABMU("TXT")="") S ABMU("TXT")=$P($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,4) ;abm*2.6*6 HEAT29426
I $P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y"&(($E(ABMP("BTYP"),1,2)=11)!($E(ABMP("BTYP"),1,2)="12")) D
.;S ABMU("LM")=17,ABMU("RM")=42,ABMU("TAB")=-3 ;abm*2.6*10 ICD10 002F
.S ABMU("LM")=22,ABMU("RM")=42,ABMU("TAB")=-3 ;abm*2.6*10 ICD10 002F
.;S ABMU("2LM")=44,ABMU("2RM")=80,ABMU("2TAB")=-3 ;abm*2.6*10 ICD10 002F
.S ABMU("2LM")=49,ABMU("2RM")=80,ABMU("2TAB")=-3 ;abm*2.6*10 ICD10 002F
E D
.;S ABMU("LM")=13,ABMU("RM")=38,ABMU("TAB")=-3 ;abm*2.6*10 ICD10 002F
.;S ABMU("LM")=18,ABMU("RM")=38,ABMU("TAB")=-3 ;abm*2.6*10 ICD10 002F ;abm*2.6*14 ICD10 002F
.S ABMU("LM")=18,ABMU("RM")=43,ABMU("TAB")=-2 ;abm*2.6*14 ICD10 002F
.;S ABMU("2LM")=40,ABMU("2RM")=80,ABMU("2TAB")=-3 ;abm*2.6*10 ICD10 002F
.S ABMU("2LM")=45,ABMU("2RM")=80,ABMU("2TAB")=-3 ;abm*2.6*10 ICD10 002F
;S ABMU("2TXT")=$S($P(ABM("X0"),U,3)]"":$P($G(^AUTNPOV($P(ABM("X0"),U,3),0)),U),1:"") ;abm*2.6*14 HEAT161263
S IENS=ABM("X")_","_ABMP("CDFN")_"," ;abm*2.6*14 HEAT161263
S ABMU("2TXT")=$S($P(ABM("X0"),U,3)]"":$$GET1^DIQ(9002274.3017,IENS,".03","E"),1:"") ;abm*2.6*14 HEAT161263
I ABMU("2TXT")["*ICD*" S ABMU("2TXT")=$P(ABMU("2TXT")," ")
I ABMU("2TXT")]"",$D(^ICD9("BA",ABMU("2TXT"))) S ABMU("2TXT")=$P($$DX^ABMCVAPI($O(^(ABMU("2TXT"),"")),ABMP("VDT")),U,4) ;CSV-c
D ^ABMDWRAP
I $P($G(ABM("X0")),U,4)'="" D
.W !,?7,"CAUSE(E-CODE): "_$P($$DX^ABMCVAPI(+$P(ABM("X0"),U,4),ABMP("VDT")),U,2) ;CSV-c
;start new abm*2.6*16 IHS/SD/SDR HEAT217211
;I $P($G(ABM("X0")),U,9)'="" D ;abm*2.6*18 IHS/SD/SDR HEAT239392
I (ABMP("VDT")'<ABMP("ICD10"))&($P($G(ABM("X0")),U,9)'="") D ;abm*2.6*18 IHS/SD/SDR HEAT239392
.W !,?7,"PLACE OF OCCURRENCE: "_$P($$DX^ABMCVAPI(+$P(ABM("X0"),U,9),ABMP("VDT")),U,2) ;CSV-c
;end new abm*2.6*16 IHS/SD/SDR HEAT217211
;start new abm*2.6*18 IHS/SD/SDR HEAT239392
I (ABMP("VDT")<ABMP("ICD10"))&(+$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABM("X"),2)),U,6)'=0) D ;abm*2.6*18 IHS/SD/SDR HEAT239392
.W !,?7,"PLACE OF OCCURRENCE: "_$P($$DX^ABMCVAPI($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABM("X"),2)),U,6),ABMP("VDT")),U,2) ;CSV-c
;end new abm*2.6*18 IHS/SD/SDR HEAT239392
Q
;
XIT K ABM,ABMZ,ABME
Q
ECODE ;
N DIE,DA,DR
S DIE="^ABMDCLM(DUZ(2),"
S DA=ABMP("CDFN")
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,12)="" S DR=".857////"_ABM("X")
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,12)'="" D
.I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,19)="",ABM("X")'=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,12) S DR=".858////"_ABM("X")
.I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,19)'="",(ABM("X")'=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,12)),(ABM("X")'=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,19)) S DR=".859////"_ABM("X")
Q:($G(DR)="")
D ^DIE
S ABMEFLG=1
Q
ABMDE5 ; IHS/SD/SDR - Edit Page 5 - DIAGNOSIS ;
+1 ;;2.6;IHS Third Party Billing;**1,3,4,6,10,14,16,18**;NOV 12, 2009;Build 289
+2 ;
+3 ; IHS/SD/SDR - 11/4/02 - V2.5 P2 - NDA-0500-180002
+4 ; Modified to display E-codes
+5 ; IHS/SD/SDR - v2.5 p9 - IM19297
+6 ; 8 Dxs for 837 formats
+7 ; IHS/SD/SDR - v2.5 p11 - Added two more E-Codes for FL72 on
+8 ; the new UB-04 format
+9 ; IHS/SD/SDR - v2.5 p13 - POA changes
+10 ; Changed display to include POA
+11 ;
+12 ;IHS/SD/SDR - v2.6 CSV
+13 ;IHS/SD/SDR - abm*2.6*1 - HEAT7045 - Display page5B if procedure exists
+14 ;IHS/SD/SDR - abm*2.6*3 - NOHEAT - Fix display of 5B; wasn't displaying if no procs existed
+15 ;IHS/SD/SDR - abm*2.6*6 - HEAT29426 - <UNDEF>PRTTXT+3^ABMDWRAP error if ICD long desc missing; defaulted to short desc.
+16 ;IHS/SD/SDR - 2.6*14 ICD10 changes; also added refresh option for page 5A. Will allow user to basically do RBCL option
+17 ; for 17 multiple within claim editor.
+18 ;IHS/SD/SDR - 2.6*14 - dual coding - added screen so only ICD9 or ICD10 can be added based on ICD Indicator
+19 ;IHS/SD/SDR - 2.6*16 - HEAT217211 - Added PLACE OF OCCURRENCE to display
+20 ;IHS/SD/SDR - 2.6*18 - HEAT239392 - There are two PLACE OF OCCURRENCEs. It should display the appropriate one based on ICD9 vs ICD10.
+21 ;
OPT KILL ABM,ABME,ABMZ,ABMU
+1 DO DISP
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIRUT)
QUIT
+2 ;W !! S ABMP("OPT")="ADESVNJBQ" S:$G(ABMZ("NUM"))=0 ABMP("DFLT")="A" D SEL^ABMDEOPT K ABMP("ED") I "ADESVN"'[$E(Y) G XIT ;abm*2.6*14 ICD10 Refresh page 5A
+3 ;abm*2.6*14 ICD10 Refresh page 5A
WRITE !!
SET ABMP("OPT")="ADESVNRIJBQ"
IF $GET(ABMZ("NUM"))=0
SET ABMP("DFLT")="A"
DO SEL^ABMDEOPT
KILL ABMP("ED")
IF "ADESVNRI"'[$EXTRACT(Y)
GOTO XIT
+4 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
+5 ;I ABMP("PX")'="I"&($E(Y)="N") G XIT ;abm*2.6*1 HEAT7045
+6 ;I '$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,0))&($E(Y)="N") G XIT ;abm*2.6*1 HEAT7045 ;abm*2.6*3 NOHEAT
+7 ;abm*2.6*3 NOHEAT
IF (((ABMP("PX")'="I")&($EXTRACT(Y)="N"))&'$DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,0)))
GOTO XIT
+8 IF $PIECE(^ABMDEXP(ABMP("EXP"),0),U)'["UB"&($EXTRACT(Y)="N")
GOTO XIT
+9 ;more than 8 dxs for 837s
IF $EXTRACT(Y)="A"
IF ($GET(ABMP("EXP"))=21)!($GET(ABMP("EXP"))=22)!($GET(ABMP("EXP"))=23)
IF ($GET(ABMZ("NUM"))>7)
Begin DoDot:1
+10 SET ABMBFY=Y
+11 SET DIR(0)="Y"
+12 SET DIR("A",1)="THE MODE OF EXPORT YOU ARE SUBMITTING FOR ONLY ALLOWS 8 DIAGNOSIS CODES."
+13 SET DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE ENTERING ADDITIONAL CODES?"
+14 SET DIR("B")="Y"
+15 DO ^DIR
+16 KILL DIR
+17 IF +Y<1
QUIT
+18 SET Y=ABMBFY
End DoDot:1
+19 IF $EXTRACT(Y)="N"
GOTO OPT2
+20 ;S ABM("DO")=$S($E(Y)="A":"A1^ABMDEML",$E(Y)="D":"D1^ABMDEMLB",$E(Y)="E":"E1^ABMDEMLE",$E(Y)="V":"^ABMDE5A",1:"S1^ABMDEMLA") D @ABM("DO") ;abm*2.6*14 ICD10 Refresh page 5A
+21 ;abm*2.6*14 ICD10 Refresh page 5A
SET ABM("DO")=$SELECT($EXTRACT(Y)="A":"A1^ABMDEML",$EXTRACT(Y)="D":"D1^ABMDEMLB",$EXTRACT(Y)="E":"E1^ABMDEMLE",$EXTRACT(Y)="V":"^ABMDE5A",$EXTRACT(Y)="R":"REFRESH^ABMDE5A",$EXTRACT(Y)="I":"IND^ABMDE5A",1:"S1^ABMDEMLA")
DO @ABM("DO")
+22 DO RES^ABMDEMLA(17)
+23 GOTO OPT
+24 ;
OPT2 KILL ABM,ABME,ABMZ
+1 DO DISP2^ABMDE5D
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIRUT)
QUIT
+2 ;W !! S ABMP("OPT")="ADESVNJBQ" D SEL^ABMDEOPT I "AVEVSDB"'[$E(Y) S:$D(ABMP("DDL"))&($E(ABMP("PAGE"),$L(ABMP("PAGE")))=5) ABMP("QUIT")="" G XIT ;abm*2.6*14 ICD10 ICD Indicator
+3 ;abm*2.6*14 ICD10 ICD Indicator
WRITE !!
SET ABMP("OPT")="ADESVNRIJBQ"
DO SEL^ABMDEOPT
IF "AVEVSDBRI"'[$EXTRACT(Y)
IF $DATA(ABMP("DDL"))&($EXTRACT(ABMP("PAGE"),$LENGTH(ABMP("PAGE")))=5)
SET ABMP("QUIT")=""
GOTO XIT
+4 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
IF $EXTRACT(Y)="B"
GOTO OPT
+5 ;S ABM("DO")=$S($E(Y)="A":"A1^ABMDEML",$E(Y)="E":"E1^ABMDEMLE",$E(Y)="D":"D1^ABMDEMLB",$E(Y)="V":"^ABMDE5B",1:"S1^ABMDEMLA") D @ABM("DO") ;abm*2.6*14 ICD10 ICD Indicator
+6 ;abm*2.6*14 ICD10 ICD Indicator
SET ABM("DO")=$SELECT($EXTRACT(Y)="A":"A1^ABMDEML",$EXTRACT(Y)="E":"E1^ABMDEMLE",$EXTRACT(Y)="D":"D1^ABMDEMLB",$EXTRACT(Y)="V":"^ABMDE5B",$EXTRACT(Y)="R":"REFRESH^ABMDE5A",$EXTRACT(Y)="I":"IND^ABMDE5A",1:"S1^ABMDEMLA")
DO @ABM("DO")
+7 GOTO OPT2
+8 ;
DISP SET ABMZ("TITL")="DIAGNOSIS"
SET ABMZ("PG")="5A"
+1 DO A^ABMDE5X
+2 IF $DATA(ABMP("DDL"))
IF $Y>(IOSL-9)
DO PAUSE^ABMDE1
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
QUIT
IF 1
+3 IF '$TEST
DO SUM^ABMDE1
+4 ;
DIAG ; Diagnosis Info
+1 SET ABMZ("SUB")=17
SET ABMZ("ITEM")="Diagnosis"
SET ABMZ("DIC")="^ICD9("
SET ABMZ("X")="DINUM"
SET ABMZ("DR")=""
SET ABMZ("NARR")=";.03////"_U_3_U_4
+2 ;start new abm*2.6*14 dual coding
+3 ;screens ICD dx entries based on ICD Indicator
+4 IF ABMP("ICD10")>ABMP("VDT")
SET ABMZ("DICS")="I $P($$DX^ABMCVAPI(+Y,ABMP(""VDT"")),U,20)'=30"
+5 IF '$TEST
SET ABMZ("DICS")="I $P($$DX^ABMCVAPI(+Y,ABMP(""VDT"")),U,20)=30"
+6 ;end new dual coding
+7 DO HD
GOTO LOOP
HD ;
+1 ;I ABMP("ICD10")>ABMP("VDT") W !,"ICD INDICATOR: ICD-9",! ;abm*2.6*10 ICD10 002G ;abm*2.6*14 ICD10 002G
+2 ;abm*2.6*14 ICD10 002G
WRITE !,"ICD Indicator for "_$$GET1^DIQ(9999999.18,ABMP("INS"),".01","E")_" : "
+3 ;abm*2.6*14 ICD10 002G
WRITE $SELECT(ABMP("ICD10")>ABMP("VDT"):"ICD-9",1:"ICD-10"),!
+4 ;W !,"BIL",?6,"ICD9" ;abm*2.6*10 ICD10 002F
+5 ;abm*2.6*10 ICD10 002F
WRITE !,"BIL",?7,"ICD"
+6 ;W !,"SEQ",?6," CODE " ;abm*2.6*10 ICD10 002F
+7 ;abm*2.6*10 ICD10 002F
WRITE !,"SEQ",?6," CODE ",?14,"IND"
+8 IF $PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y"&(($EXTRACT(ABMP("BTYP"),1,2)=11)!($EXTRACT(ABMP("BTYP"),1,2)="12"))
Begin DoDot:1
+9 ;W ?13,"POA",?23,"Dx DESCRIPTION",?51,"PROVIDER'S NARRATIVE" ;abm*2.6*10 ICD10 002F
+10 ;abm*2.6*10 ICD10 002F
WRITE ?18,"POA",?28,"Dx DESCRIPTION",?54,"PROVIDER'S NARRATIVE"
End DoDot:1
+11 ;E W ?19,"Dx DESCRIPTION",?51,"PROVIDER'S NARRATIVE" ;abm*2.6*10 ICD10 002F
+12 ;abm*2.6*10 ICD10 002F
IF '$TEST
WRITE ?20,"Dx DESCRIPTION",?50,"PROVIDER'S NARRATIVE"
+13 ;W !,"===",?5,"=======" ;abm*2.6*10 ICD10 002F
+14 ;abm*2.6*10 ICD10 002F
WRITE !,"===",?5,"========",?14,"==="
+15 IF $PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y"&(($EXTRACT(ABMP("BTYP"),1,2)=11)!($EXTRACT(ABMP("BTYP"),1,2)="12"))
Begin DoDot:1
+16 ;W ?13,"===",?17,"==========================",?44,"====================================" ;abm*2.6*10 ICD10 002F
+17 ;abm*2.6*10 ICD10 002F
WRITE ?18,"===",?22,"==========================",?49,"==============================="
End DoDot:1
+18 ;E W ?13,"==========================",?40,"=======================================" ;abm*2.6*10 ICD10 002F
+19 ;abm*2.6*10 ICD10 002F
IF '$TEST
WRITE ?18,"==========================",?45,"==================================="
+20 QUIT
LOOP ;
+1 SET ABMEFLG=0
+2 SET (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1))=0
+3 ;start new code abm*2.6*14 ICD10 002F
+4 ;this will remove codes from page 5A if the code set on the sequenced codes doesn't match the code set for the insurer
+5 ;manual claims will be a problem (because it will delete everything), but for a PCC claim all POVs will be viewable on
+6 ;the View option of page5A
+7 SET ABMI=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",0))
+8 IF +ABMI'=0
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMI,0))
+9 IF (+$GET(ABM)'=0)
Begin DoDot:1
+10 SET ABMICDI=+$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABM,0)),U,6)
+11 IF (ABMICDI=1&(ABMP("ICD10")>ABMP("VDT")))!((ABMICDI=0)&(ABMP("ICD10")<ABMP("VDT")))
Begin DoDot:2
+12 ;remove all entries
+13 KILL ^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"))
SET ^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),0)="^9002274.30"_ABMZ("SUB")_"P^^"
+14 DO A^ABMDE5X
End DoDot:2
End DoDot:1
+15 ;end new code 002F
+16 SET ABM=""
+17 FOR ABM("I")=1:1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABM))
IF 'ABM
QUIT
SET ABM("X")=$ORDER(^(ABM,""))
SET ABMZ("NUM")=ABM("I")
DO DX
+18 SET ABM("L")=ABMZ("LNUM")+1
SET ABMZ("DR2")=";.02////"_ABM("L")
+19 IF +$ORDER(ABME(0))
SET ABME("CONT")=""
DO ^ABMDERR
KILL ABME("CONT")
+20 QUIT
DX ;
+1 SET ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABM("X"),0)
IF ABMZ("LNUM")<$PIECE(^(0),U,2)
SET ABMZ("LNUM")=$PIECE(^(0),U,2)
+2 IF $Y>(IOSL-5)
DO PAUSE^ABMDE1
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
QUIT
DO HD
+3 ;ABMZ(ABM("I"))=code^multiple ien^code ien^provider narr^e-code^poa
+4 ;S ABMZ(ABM("I"))=$P($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2)_U_ABM("X")_U_$P(ABM("X0"),U)_U_$P(ABM("X0"),U,3)_U_$P(ABM("X0"),U,4)_U_$P(ABM("X0"),U,5) ;CSV-c ;abm*2.6*14 ICD10 002F
+5 ;CSV-c ;abm*2.6*14 ICD10 002F
SET ABMZ(ABM("I"))=$PIECE($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2)_U_ABM("X")_U_$PIECE(ABM("X0"),U)_U_$PIECE(ABM("X0"),U,3)_U_$PIECE(ABM("X0"),U,4)_U_$PIECE(ABM("X0"),U,5)_U_$PIECE(ABM("X0"),U,6)
+6 ;CSV-c ;code
WRITE !,$JUSTIFY(ABM("I"),2),?5,$PIECE($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2)
+7 ;W ?15,$S($P(+ABM("X"),U,6)=1:"10",1:"9") ;abm*2.6*10 ICD10 002F ;abm*2.6*14 ICD10 002F
+8 ;abm*2.6*14 ICD10 002F
WRITE ?15,$SELECT(+$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,+ABM("X"),0)),U,6)=1:"10",1:"9")
+9 ;W:$P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y"&(($E(ABMP("BTYP"),1,2)=11)!($E(ABMP("BTYP"),1,2)="12")) ?14,$P(ABM("X0"),U,5) ;poa ;abm*2.6*10 ICD10 002F
+10 ;poa ;abm*2.6*10 ICD10 002F
IF $PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y"&(($EXTRACT(ABMP("BTYP"),1,2)=11)!($EXTRACT(ABMP("BTYP"),1,2)="12"))
WRITE ?19,$PIECE(ABM("X0"),U,5)
+11 ;I $G(ABMEFLG)=0,$P($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2)["E" D ECODE ;CSV-c ;abm*2.6*14 ICD10 002F
+12 ;CSV-c ;abm*2.6*14 ICD10 002F
IF $GET(ABMEFLG)=0
IF $PIECE($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2)["E"
IF (ABMP("ICD10")>ABMP("VDT"))
DO ECODE
+13 ;abm*2.6*6 HEAT29426
SET (ABMU("TXT"),ABMUTXT)=""
+14 ;if there's a desc and site wants long desc
IF $DATA(^ICD9(ABM("X"),1))
IF $PIECE(^ABMDPARM(DUZ(2),1,0),U,14)="Y"
Begin DoDot:1
+15 SET ABMU("TXT")=""
+16 KILL ABMZCPTD
+17 ;D ICDDX^ABMCVAPI($P($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2),"ABMZCPTD","",ABMP("VDT")) ;desc array
+18 ;S ABMU("TXT")=$$ICDDX^ABMCVAPI(+ABM("X"),$P($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2),"ABMZCPTD","",ABMP("VDT")) ;desc array ;abm*2.6*4 HEAT19688
+19 ;desc array ;abm*2.6*4 HEAT19688
SET ABMUTXT=$$ICDDX^ABMCVAPI(+ABM("X"),$PIECE($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,2),"ABMZCPTD","",ABMP("VDT"))
+20 SET ABM("CP")=0
+21 FOR
SET ABM("CP")=$ORDER(ABMZCPTD(ABM("CP")))
IF (+ABM("CP")=0)
QUIT
Begin DoDot:2
+22 IF ($GET(ABMZCPTD(ABM("CP")))="")
QUIT
+23 SET ABMU("TXT")=ABMU("TXT")_ABMZCPTD(ABM("CP"))_" "
End DoDot:2
End DoDot:1
+24 ;E S ABMU("TXT")=$P($$DX^ABMCVAPI(ABM("X"),ABMP("VDT")),U,4) ;CSV-c ;abm*2.6*6 HEAT29426
+25 ;abm*2.6*6 HEAT29426
IF $PIECE($GET(^ABMDPARM(DUZ(2),1,0)),U,14)'="Y"!(ABMU("TXT")="")
SET ABMU("TXT")=$PIECE($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,4)
+26 IF $PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),U,13)="Y"&(($EXTRACT(ABMP("BTYP"),1,2)=11)!($EXTRACT(ABMP("BTYP"),1,2)="12"))
Begin DoDot:1
+27 ;S ABMU("LM")=17,ABMU("RM")=42,ABMU("TAB")=-3 ;abm*2.6*10 ICD10 002F
+28 ;abm*2.6*10 ICD10 002F
SET ABMU("LM")=22
SET ABMU("RM")=42
SET ABMU("TAB")=-3
+29 ;S ABMU("2LM")=44,ABMU("2RM")=80,ABMU("2TAB")=-3 ;abm*2.6*10 ICD10 002F
+30 ;abm*2.6*10 ICD10 002F
SET ABMU("2LM")=49
SET ABMU("2RM")=80
SET ABMU("2TAB")=-3
End DoDot:1
+31 IF '$TEST
Begin DoDot:1
+32 ;S ABMU("LM")=13,ABMU("RM")=38,ABMU("TAB")=-3 ;abm*2.6*10 ICD10 002F
+33 ;S ABMU("LM")=18,ABMU("RM")=38,ABMU("TAB")=-3 ;abm*2.6*10 ICD10 002F ;abm*2.6*14 ICD10 002F
+34 ;abm*2.6*14 ICD10 002F
SET ABMU("LM")=18
SET ABMU("RM")=43
SET ABMU("TAB")=-2
+35 ;S ABMU("2LM")=40,ABMU("2RM")=80,ABMU("2TAB")=-3 ;abm*2.6*10 ICD10 002F
+36 ;abm*2.6*10 ICD10 002F
SET ABMU("2LM")=45
SET ABMU("2RM")=80
SET ABMU("2TAB")=-3
End DoDot:1
+37 ;S ABMU("2TXT")=$S($P(ABM("X0"),U,3)]"":$P($G(^AUTNPOV($P(ABM("X0"),U,3),0)),U),1:"") ;abm*2.6*14 HEAT161263
+38 ;abm*2.6*14 HEAT161263
SET IENS=ABM("X")_","_ABMP("CDFN")_","
+39 ;abm*2.6*14 HEAT161263
SET ABMU("2TXT")=$SELECT($PIECE(ABM("X0"),U,3)]"":$$GET1^DIQ(9002274.3017,IENS,".03","E"),1:"")
+40 IF ABMU("2TXT")["*ICD*"
SET ABMU("2TXT")=$PIECE(ABMU("2TXT")," ")
+41 ;CSV-c
IF ABMU("2TXT")]""
IF $DATA(^ICD9("BA",ABMU("2TXT")))
SET ABMU("2TXT")=$PIECE($$DX^ABMCVAPI($ORDER(^(ABMU("2TXT"),"")),ABMP("VDT")),U,4)
+42 DO ^ABMDWRAP
+43 IF $PIECE($GET(ABM("X0")),U,4)'=""
Begin DoDot:1
+44 ;CSV-c
WRITE !,?7,"CAUSE(E-CODE): "_$PIECE($$DX^ABMCVAPI(+$PIECE(ABM("X0"),U,4),ABMP("VDT")),U,2)
End DoDot:1
+45 ;start new abm*2.6*16 IHS/SD/SDR HEAT217211
+46 ;I $P($G(ABM("X0")),U,9)'="" D ;abm*2.6*18 IHS/SD/SDR HEAT239392
+47 ;abm*2.6*18 IHS/SD/SDR HEAT239392
IF (ABMP("VDT")'<ABMP("ICD10"))&($PIECE($GET(ABM("X0")),U,9)'="")
Begin DoDot:1
+48 ;CSV-c
WRITE !,?7,"PLACE OF OCCURRENCE: "_$PIECE($$DX^ABMCVAPI(+$PIECE(ABM("X0"),U,9),ABMP("VDT")),U,2)
End DoDot:1
+49 ;end new abm*2.6*16 IHS/SD/SDR HEAT217211
+50 ;start new abm*2.6*18 IHS/SD/SDR HEAT239392
+51 ;abm*2.6*18 IHS/SD/SDR HEAT239392
IF (ABMP("VDT")<ABMP("ICD10"))&(+$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABM("X"),2)),U,6)'=0)
Begin DoDot:1
+52 ;CSV-c
WRITE !,?7,"PLACE OF OCCURRENCE: "_$PIECE($$DX^ABMCVAPI($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABM("X"),2)),U,6),ABMP("VDT")),U,2)
End DoDot:1
+53 ;end new abm*2.6*18 IHS/SD/SDR HEAT239392
+54 QUIT
+55 ;
XIT KILL ABM,ABMZ,ABME
+1 QUIT
ECODE ;
+1 NEW DIE,DA,DR
+2 SET DIE="^ABMDCLM(DUZ(2),"
+3 SET DA=ABMP("CDFN")
+4 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,12)=""
SET DR=".857////"_ABM("X")
+5 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,12)'=""
Begin DoDot:1
+6 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,19)=""
IF ABM("X")'=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,12)
SET DR=".858////"_ABM("X")
+7 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,19)'=""
IF (ABM("X")'=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,12))
IF (ABM("X")'=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,19))
SET DR=".859////"_ABM("X")
End DoDot:1
+8 IF ($GET(DR)="")
QUIT
+9 DO ^DIE
+10 SET ABMEFLG=1
+11 QUIT
