ABMDE5D ; IHS/ASDST/DMJ - Edit Page 5 - ICD PROCEDURE VIEW ;
;;2.6;IHS 3P BILLING SYSTEM;**10,14,19**;NOV 12, 2009;Build 300
;
;IHS/DED/DMJ - 5/12/1999 - NOIS HQW-0599-100027
; Changed mm/dd DOS display to full Charge Date
;
; IHS/SD/SDR - v2.6 CSV
;IHS/SD/SDR - 2.6*14 - ICD10 - ICD10 changes
;IHS/SD/SDR - 2.6*19 - HEAT239182 - Updated so only ICD9 or only ICD10 can be selected on a claim based on the DOS and the ICD10 effective date
;
DISP2 ;EP - Entry Point to Display Dx Info
K ABMZ S ABMZ("TITL")="ICD PROCEDURES",ABMZ("PG")="5B"
D B^ABMDE5X
I $D(ABMP("DDL")),$Y>(IOSL-9) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT I 1
E D SUM^ABMDE1
;
PROC ; ICD Procedure Info
S ABMZ("SUB")=19,ABMZ("ITEM")="Procedure",ABMZ("DIC")="^ICD0("
;start new abm*2.6*19 IHS/SD/SDR HEAT239182
I ABMP("ICD10")>ABMP("VDT") S ABMZ("DICS")="I $P($$ICDOP^ABMCVAPI(+Y,ABMP(""VDT"")),U,15)'=31"
E S ABMZ("DICS")="I $P($$ICDOP^ABMCVAPI(+Y,ABMP(""VDT"")),U,15)=31"
;end new abm*2.6*19 IHS/SD/SDR HEAT239182
S ABMZ("X")="DINUM"
S ABMZ("DR")=";W !;.03//"_ABMP("VISTDT")
S ABMZ("NARR")=";.04////"_U_4_U_5
D HD2 G LOOP2
HD2 ;
W !,"ICD Indicator for "_$$GET1^DIQ(9999999.18,ABMP("INS"),".01","E")_" : " ;abm*2.6*14 ICD10 002H
W $S(ABMP("ICD10")>ABMP("VDT"):"ICD-9",1:"ICD-10"),! ;abm*2.6*14 ICD10 002H
;W !,"BIL",?4,"SERV",?12,"ICD0" ;abm*2.6*10 ICD10 002H
W !,"BIL",?4,"SERV",?16,"ICD" ;abm*2.6*10 ICD10 002H
;W !,"SEQ",?4,"DATE",?12,"CODE -",?19,"PROCEDURE DESCRIPTION",?54,"PROVIDER'S NARRATIVE" ;abm*2.6*10 ICD10 002H
W !,"SEQ",?4,"DATE",?11,"IND",?16,"CODE -",?23,"PROCEDURE DESCRIPTION",?56,"PROVIDER'S NARRATIVE" ;abm*2.6*10 ICD10 002H
;W !,"===",?4,"=====",?11,"===================================",?48,"================================" ;abm*2.6*10 ICD10 002H
W !,"===",?4,"=====",?11,"===",?16,"===================================",?52,"============================" ;abm*2.6*10 ICD10 002H
Q
LOOP2 ;LOOP 2
;start old code abm*2.6*14 ICD10 002H
;S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1))=0,ABM=0
;F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",ABM)) Q:'ABM!($D(DIROUT))!($D(DTOUT))!($D(DUOUT)) D
;.S ABM("X")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",ABM,0))
;.S ABMZ("NUM")=ABM("I")
;.D PX
;G XIT:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
;S ABM("L")=ABMZ("LNUM")+1,ABMZ("DR2")=";.02////"_ABM("L")
;I +$O(ABME(0)) S ABME("CONT")="" D ^ABMDERR K ABME("CONT")
;end old start new code abm*2.6*14 ICD10 002H
;this will remove codes from page 5B 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 page5B
S ABMI=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",0))
I +ABMI'=0 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",ABMI,0))
I (+$G(ABM)'=0) D
.S ABMICDI=+$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,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 B^ABMDE5X
;end new code ICD10 002H
S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1))=0,ABM=0
S ABM=""
F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",ABM)) Q:'ABM S ABM("X")=$O(^(ABM,"")),ABMZ("NUM")=ABM("I") D PX
S ABM("L")=ABMZ("LNUM")+1,ABMZ("DR2")=";.02////"_ABM("L")
I +$O(ABME(0)) S ABME("CONT")="" D ^ABMDERR K ABME("CONT")
;end new code ICD10 002H
Q
PX ;
S ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABM("X"),0)
S ABM("ICD0IEN")=$P(ABM("X0"),U)
;Q:'$D(^ICD0(ABM("ICD0IEN"),0)) S ABMZ(ABM("I"))=$P($$ICDOP^ABMCVAPI(ABM("ICD0IEN"),ABMP("VDT")),U,2)_U_ABM("X")_U_$P(ABM("X0"),U)_U_$P(ABM("X0"),U,3)_U_$P(ABM("X0"),U,4) ;CSV-c ;abm*2.6*14 ICD10 002H
Q:'$D(^ICD0(ABM("ICD0IEN"),0)) S ABMZ(ABM("I"))=$P($$ICDOP^ABMCVAPI(ABM("ICD0IEN"),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_U_$P(ABM("X0"),U,6) ;CSV-c ;abm*2.6*14 ICD10 002H
I $Y>(IOSL-5) D PAUSE^ABMDE1 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) D HD2
;S ABM("Y")=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABM("X"),0),U,3) S:ABMZ("LNUM")<$P(^(0),U,2) ABMZ("LNUM")=$P(^(0),U,2) I $D(^(1)),$P(^ABMDPARM(DUZ(2),1,0),U,14)="Y" S ABMU("TXT")=$$ICDDX^ABMCVAPI(ABM("X"),ABMP("VDT")) ;CSV-c ;abm*2.6*14
S ABM("Y")=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABM("X"),0),U,3) S:ABMZ("LNUM")<$P(^(0),U,2) ABMZ("LNUM")=$P(^(0),U,2) I $D(^(1)),$P(^ABMDPARM(DUZ(2),1,0),U,14)="Y" S ABMU("TXT")=$$ICDDX^ABMCVAPI(+ABM("X"),ABMP("VDT")) ;CSV-c ;abm*2.6*14 +'d
E S ABMU("TXT")=$P($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,4) ;CSV-c
W !,$J(ABM("I"),2),?4,"CHARGE DATE: ",$$SDT^ABMDUTL(ABM("Y"))
W !,?12,$S($P(ABM("X0"),U,6)=1:"10",1:"9") ;abm*2.6*14 ICD10 002H
;W !,?11,$P($$ICDOP^ABMCVAPI(ABM("ICD0IEN"),ABMP("VDT")),U,2)," -" I $D(^(1)),$P(^ABMDPARM(DUZ(2),1,0),U,14)="Y" S ABMU("TXT")=$P($$ICDDOP^ABMCVAPI(ABM("ICD0IEN"),ABMP("VDT")),U) ;CSV-c ;abm*2.6*10 ICD10 002H
;W !,?16,$P($$ICDOP^ABMCVAPI(ABM("ICD0IEN"),ABMP("VDT")),U,2)," -" I $D(^(1)),$P(^ABMDPARM(DUZ(2),1,0),U,14)="Y" S ABMU("TXT")=$P($$ICDDOP^ABMCVAPI(ABM("ICD0IEN"),ABMP("VDT")),U) ;CSV-c ;abm*2.6*10 ICD10 002H ;abm*2.6*14 ICD10 002H
W ?16,$P($$ICDOP^ABMCVAPI(ABM("ICD0IEN"),ABMP("VDT")),U,2)," -" ;abm*2.6*14 ICD10 002H
;E S ABMU("TXT")=$P($$ICDOP^ABMCVAPI(ABM("ICD0IEN"),ABMP("VDT")),U,5) ;CSV-c ;ABM*2.6*14 ICD10 002H
S ABMU("TXT")=$P($$ICDOP^ABMCVAPI(ABM("ICD0IEN"),ABMP("VDT")),U,5) ;abm*2.6*14 ICD10 002H
;S ABMU("LM")=19,ABMU("RM")=46,ABMU("TAB")=5 ;abm*2.6*10 ICD10 002H
S ABMU("LM")=22,ABMU("RM")=50,ABMU("TAB")=5 ;abm*2.6*10 ICD10 002H
;S ABMU("2TXT")=$S($P(ABM("X0"),U,4)]"":$P($G(^AUTNPOV($P(ABM("X0"),U,4),0)),U),1:""),ABMU("2TAB")=-2,ABMU("2LM")=48,ABMU("2RM")=80 ;abm*2.6*10 ICD10 002H
S ABMU("2TXT")=$S($P(ABM("X0"),U,4)]"":$P($G(^AUTNPOV($P(ABM("X0"),U,4),0)),U),1:""),ABMU("2TAB")=-2,ABMU("2LM")=52,ABMU("2RM")=80 ;abm*2.6*10 ICD10 002H
D ^ABMDWRAP
Q
;
XIT K ABME
Q
ABMDE5D ; IHS/ASDST/DMJ - Edit Page 5 - ICD PROCEDURE VIEW ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**10,14,19**;NOV 12, 2009;Build 300
+2 ;
+3 ;IHS/DED/DMJ - 5/12/1999 - NOIS HQW-0599-100027
+4 ; Changed mm/dd DOS display to full Charge Date
+5 ;
+6 ; IHS/SD/SDR - v2.6 CSV
+7 ;IHS/SD/SDR - 2.6*14 - ICD10 - ICD10 changes
+8 ;IHS/SD/SDR - 2.6*19 - HEAT239182 - Updated so only ICD9 or only ICD10 can be selected on a claim based on the DOS and the ICD10 effective date
+9 ;
DISP2 ;EP - Entry Point to Display Dx Info
+1 KILL ABMZ
SET ABMZ("TITL")="ICD PROCEDURES"
SET ABMZ("PG")="5B"
+2 DO B^ABMDE5X
+3 IF $DATA(ABMP("DDL"))
IF $Y>(IOSL-9)
DO PAUSE^ABMDE1
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
GOTO XIT
IF 1
+4 IF '$TEST
DO SUM^ABMDE1
+5 ;
PROC ; ICD Procedure Info
+1 SET ABMZ("SUB")=19
SET ABMZ("ITEM")="Procedure"
SET ABMZ("DIC")="^ICD0("
+2 ;start new abm*2.6*19 IHS/SD/SDR HEAT239182
+3 IF ABMP("ICD10")>ABMP("VDT")
SET ABMZ("DICS")="I $P($$ICDOP^ABMCVAPI(+Y,ABMP(""VDT"")),U,15)'=31"
+4 IF '$TEST
SET ABMZ("DICS")="I $P($$ICDOP^ABMCVAPI(+Y,ABMP(""VDT"")),U,15)=31"
+5 ;end new abm*2.6*19 IHS/SD/SDR HEAT239182
+6 SET ABMZ("X")="DINUM"
+7 SET ABMZ("DR")=";W !;.03//"_ABMP("VISTDT")
+8 SET ABMZ("NARR")=";.04////"_U_4_U_5
+9 DO HD2
GOTO LOOP2
HD2 ;
+1 ;abm*2.6*14 ICD10 002H
WRITE !,"ICD Indicator for "_$$GET1^DIQ(9999999.18,ABMP("INS"),".01","E")_" : "
+2 ;abm*2.6*14 ICD10 002H
WRITE $SELECT(ABMP("ICD10")>ABMP("VDT"):"ICD-9",1:"ICD-10"),!
+3 ;W !,"BIL",?4,"SERV",?12,"ICD0" ;abm*2.6*10 ICD10 002H
+4 ;abm*2.6*10 ICD10 002H
WRITE !,"BIL",?4,"SERV",?16,"ICD"
+5 ;W !,"SEQ",?4,"DATE",?12,"CODE -",?19,"PROCEDURE DESCRIPTION",?54,"PROVIDER'S NARRATIVE" ;abm*2.6*10 ICD10 002H
+6 ;abm*2.6*10 ICD10 002H
WRITE !,"SEQ",?4,"DATE",?11,"IND",?16,"CODE -",?23,"PROCEDURE DESCRIPTION",?56,"PROVIDER'S NARRATIVE"
+7 ;W !,"===",?4,"=====",?11,"===================================",?48,"================================" ;abm*2.6*10 ICD10 002H
+8 ;abm*2.6*10 ICD10 002H
WRITE !,"===",?4,"=====",?11,"===",?16,"===================================",?52,"============================"
+9 QUIT
LOOP2 ;LOOP 2
+1 ;start old code abm*2.6*14 ICD10 002H
+2 ;S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1))=0,ABM=0
+3 ;F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",ABM)) Q:'ABM!($D(DIROUT))!($D(DTOUT))!($D(DUOUT)) D
+4 ;.S ABM("X")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",ABM,0))
+5 ;.S ABMZ("NUM")=ABM("I")
+6 ;.D PX
+7 ;G XIT:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
+8 ;S ABM("L")=ABMZ("LNUM")+1,ABMZ("DR2")=";.02////"_ABM("L")
+9 ;I +$O(ABME(0)) S ABME("CONT")="" D ^ABMDERR K ABME("CONT")
+10 ;end old start new code abm*2.6*14 ICD10 002H
+11 ;this will remove codes from page 5B if the code set on the sequenced codes doesn't match the code set for the insurer
+12 ;manual claims will be a problem (because it will delete everything), but for a PCC claim all POVs will be viewable on
+13 ;the View option of page5B
+14 SET ABMI=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",0))
+15 IF +ABMI'=0
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",ABMI,0))
+16 IF (+$GET(ABM)'=0)
Begin DoDot:1
+17 SET ABMICDI=+$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABM,0)),U,6)
+18 IF (ABMICDI=1&(ABMP("ICD10")>ABMP("VDT")))!((ABMICDI=0)&(ABMP("ICD10")<ABMP("VDT")))
Begin DoDot:2
+19 ;remove all entries
+20 KILL ^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"))
SET ^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),0)="^9002274.30"_ABMZ("SUB")_"P^^"
+21 DO B^ABMDE5X
End DoDot:2
End DoDot:1
+22 ;end new code ICD10 002H
+23 SET (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1))=0
SET ABM=0
+24 SET ABM=""
+25 FOR ABM("I")=1:1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",ABM))
IF 'ABM
QUIT
SET ABM("X")=$ORDER(^(ABM,""))
SET ABMZ("NUM")=ABM("I")
DO PX
+26 SET ABM("L")=ABMZ("LNUM")+1
SET ABMZ("DR2")=";.02////"_ABM("L")
+27 IF +$ORDER(ABME(0))
SET ABME("CONT")=""
DO ^ABMDERR
KILL ABME("CONT")
+28 ;end new code ICD10 002H
+29 QUIT
PX ;
+1 SET ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABM("X"),0)
+2 SET ABM("ICD0IEN")=$PIECE(ABM("X0"),U)
+3 ;Q:'$D(^ICD0(ABM("ICD0IEN"),0)) S ABMZ(ABM("I"))=$P($$ICDOP^ABMCVAPI(ABM("ICD0IEN"),ABMP("VDT")),U,2)_U_ABM("X")_U_$P(ABM("X0"),U)_U_$P(ABM("X0"),U,3)_U_$P(ABM("X0"),U,4) ;CSV-c ;abm*2.6*14 ICD10 002H
+4 ;CSV-c ;abm*2.6*14 ICD10 002H
IF '$DATA(^ICD0(ABM("ICD0IEN"),0))
QUIT
SET ABMZ(ABM("I"))=$PIECE($$ICDOP^ABMCVAPI(ABM("ICD0IEN"),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_U_$PIECE(ABM("X0"),U,6)
+5 IF $Y>(IOSL-5)
DO PAUSE^ABMDE1
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
QUIT
DO HD2
+6 ;S ABM("Y")=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABM("X"),0),U,3) S:ABMZ("LNUM")<$P(^(0),U,2) ABMZ("LNUM")=$P(^(0),U,2) I $D(^(1)),$P(^ABMDPARM(DUZ(2),1,0),U,14)="Y" S ABMU("TXT")=$$ICDDX^ABMCVAPI(ABM("X"),ABMP("VDT")) ;CSV-c ;abm*2.6*14
+7 ;CSV-c ;abm*2.6*14 +'d
SET ABM("Y")=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABM("X"),0),U,3)
IF ABMZ("LNUM")<$PIECE(^(0),U,2)
SET ABMZ("LNUM")=$PIECE(^(0),U,2)
IF $DATA(^(1))
IF $PIECE(^ABMDPARM(DUZ(2),1,0),U,14)="Y"
SET ABMU("TXT")=$$ICDDX^ABMCVAPI(+ABM("X"),ABMP("VDT"))
+8 ;CSV-c
IF '$TEST
SET ABMU("TXT")=$PIECE($$DX^ABMCVAPI(+ABM("X"),ABMP("VDT")),U,4)
+9 WRITE !,$JUSTIFY(ABM("I"),2),?4,"CHARGE DATE: ",$$SDT^ABMDUTL(ABM("Y"))
+10 ;abm*2.6*14 ICD10 002H
WRITE !,?12,$SELECT($PIECE(ABM("X0"),U,6)=1:"10",1:"9")
+11 ;W !,?11,$P($$ICDOP^ABMCVAPI(ABM("ICD0IEN"),ABMP("VDT")),U,2)," -" I $D(^(1)),$P(^ABMDPARM(DUZ(2),1,0),U,14)="Y" S ABMU("TXT")=$P($$ICDDOP^ABMCVAPI(ABM("ICD0IEN"),ABMP("VDT")),U) ;CSV-c ;abm*2.6*10 ICD10 002H
+12 ;W !,?16,$P($$ICDOP^ABMCVAPI(ABM("ICD0IEN"),ABMP("VDT")),U,2)," -" I $D(^(1)),$P(^ABMDPARM(DUZ(2),1,0),U,14)="Y" S ABMU("TXT")=$P($$ICDDOP^ABMCVAPI(ABM("ICD0IEN"),ABMP("VDT")),U) ;CSV-c ;abm*2.6*10 ICD10 002H ;abm*2.6*14 ICD10 002H
+13 ;abm*2.6*14 ICD10 002H
WRITE ?16,$PIECE($$ICDOP^ABMCVAPI(ABM("ICD0IEN"),ABMP("VDT")),U,2)," -"
+14 ;E S ABMU("TXT")=$P($$ICDOP^ABMCVAPI(ABM("ICD0IEN"),ABMP("VDT")),U,5) ;CSV-c ;ABM*2.6*14 ICD10 002H
+15 ;abm*2.6*14 ICD10 002H
SET ABMU("TXT")=$PIECE($$ICDOP^ABMCVAPI(ABM("ICD0IEN"),ABMP("VDT")),U,5)
+16 ;S ABMU("LM")=19,ABMU("RM")=46,ABMU("TAB")=5 ;abm*2.6*10 ICD10 002H
+17 ;abm*2.6*10 ICD10 002H
SET ABMU("LM")=22
SET ABMU("RM")=50
SET ABMU("TAB")=5
+18 ;S ABMU("2TXT")=$S($P(ABM("X0"),U,4)]"":$P($G(^AUTNPOV($P(ABM("X0"),U,4),0)),U),1:""),ABMU("2TAB")=-2,ABMU("2LM")=48,ABMU("2RM")=80 ;abm*2.6*10 ICD10 002H
+19 ;abm*2.6*10 ICD10 002H
SET ABMU("2TXT")=$SELECT($PIECE(ABM("X0"),U,4)]"":$PIECE($GET(^AUTNPOV($PIECE(ABM("X0"),U,4),0)),U),1:"")
SET ABMU("2TAB")=-2
SET ABMU("2LM")=52
SET ABMU("2RM")=80
+20 DO ^ABMDWRAP
+21 QUIT
+22 ;
XIT KILL ABME
+1 QUIT
