- 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
