ABMDE9 ; IHS/ASDST/DMJ - Edit Page 9 - UB-82 CODES ;
;;2.6;IHS Third Party Billing;**1,6,9,13,14**;NOV 12, 2009;Build 238
;
; IHS/SD/SDR - v2.5 p10 - IM20337 - Added code for BACK if ADA
; IHS/SD/SDR - abm*2.6*1 - HEAT6439 - Added page9G for clm attchments
; IHS/SD/SDR - abm*2.6*6 - NOHEAT - Can't jump to page 5
;IHS/SD/SDR - 2*6*13 - Updated paging for exp mode 35; should go to page 9A, then 9E
;IHS/SD/SDR - 2.6*14 - HEAT163711 - Made change to check for exp mode 35, from HCFA to CMS
;IHS/SD/SDR - 2.6*14 - CR3165 - Correction to page9F to go to page9G for exp mode 35
;
I $D(ABMP("WORKSHEET")) S ABMP("QUIT")="" Q
OPT ; Page 9A Occurrence Description
K ABM,ABME
I $D(ABMP("DDL")),'+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),51,0)) G OPT2
D A^ABMDE9X
D DISP^ABMDE9C W !! S ABM="",ABMP("OPT")="ADEVNJBQ" D SEL^ABMDEOPT I "ADVEN"'[$E(Y) G XIT
;G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT),OPT2:$E(Y)="N" ;abm*2.6*13 exp mode 35
;G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT),OPT5:(($E(Y)="N")&($P(^ABMDEXP(ABMP("EXP"),0),U)["HCFA")),OPT2:$E(Y)="N" ;abm*2.6*13 exp mode 35 ;abm*2.6*14 HEAT163711
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT),OPT5:(($E(Y)="N")&($P(^ABMDEXP(ABMP("EXP"),0),U)["CMS")),OPT2:$E(Y)="N" ;abm*2.6*13 exp mode 35 ;abm*2.6*14 HEAT163711
S ABM("DO")=$S($E(Y)="A":"A1^ABMDEML",$E(Y)="V":"V1^ABMDE9B",$E(Y)="E":"E1^ABMDEMLE",1:"D1^ABMDEMLB") D @ABM("DO")
G OPT
;
OPT2 ;Page 9B Occurrence Span
K ABM,ABME
I $D(ABMP("DDL")),'+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),57,0)) G OPT3
D B^ABMDE9X
D DISP2^ABMDE9C W !! S ABM="",ABMP("OPT")="ADEVNJBQ" D SEL^ABMDEOPT I "AVNDEB"'[$E(Y) G XIT
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT),OPT:$E(Y)="B",OPT3:$E(Y)="N"
S ABM("DO")=$S($E(Y)="A":"A1^ABMDEML",$E(Y)="V":"V1^ABMDE9B",$E(Y)="E":"E1^ABMDEMLE",1:"D1^ABMDEMLB") D @ABM("DO")
G OPT2
;
OPT3 ; Page 9C Condition Codes
K ABM,ABME
I $D(ABMP("DDL")),'+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),53,0)) G OPT4
D C^ABMDE9X
D DISP3^ABMDE9A W !! S ABM="",ABMP("OPT")="ADNJBQ" D SEL^ABMDEOPT I "ANDB"'[$E(Y) G XIT
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT),OPT2:$E(Y)="B",OPT4:$E(Y)="N"
S ABM("DO")=$S($E(Y)="A":"A1^ABMDEML",1:"D1^ABMDEMLB") D @ABM("DO")
G OPT3
;
OPT4 ; Page 9D Value Codes
K ABM,ABME
I $D(ABMP("DDL")),'+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),55,0)) G OPT5
D D^ABMDE9X
D DISP4^ABMDE9A W !! S ABM="",ABMP("OPT")="ADEVNJBQ" D SEL^ABMDEOPT I "ANEVDB"'[$E(Y) G XIT
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT),OPT3:$E(Y)="B",OPT5:$E(Y)="N"
S ABM("DO")=$S($E(Y)="A":"A1^ABMDEML",$E(Y)="V":"V1^ABMDE9B",$E(Y)="E":"E1^ABMDEMLE",1:"D1^ABMDEMLB") D @ABM("DO")
G OPT4
;
OPT5 ; Page 9E Special Program Codes
K ABM,ABME
I $D(ABMP("DDL")),'+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,0)) G OPT6
D E^ABMDE9X
D DISP5^ABMDE9B W !! S ABM="",ABMP("OPT")="ADNJBQ" D SEL^ABMDEOPT I "ANDB"'[$E(Y) G XIT
;G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT),OPT4:$E(Y)="B",OPT6:$E(Y)="N" ;abm*2.6*13 exp mode 35
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT),OPT:(($E(Y)="B")&($P(^ABMDEXP(ABMP("EXP"),0),U)["HCFA")),OPT4:$E(Y)="B",OPT6:$E(Y)="N" ;abm*2.6*13 exp mode 35
S ABM("DO")=$S($E(Y)="A":"A1^ABMDEML",1:"D1^ABMDEMLB") D @ABM("DO")
G OPT5
;
OPT6 ; Page 9F Remarks
K ABM,ABME
;I $D(ABMP("DDL")),'+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),61,0)) S ABMP("QUIT")="" G XIT ;abm*2.6*1 HEAT6439
I $D(ABMP("DDL")),'+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),61,0)) S ABMP("QUIT")="" G OPT7 ;abm*2.6*1 HEAT6439
D F^ABMDE9X
;if unbillable/complete don't allow editing of remarks
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)="U"!($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)="C") S ABMQUIET=1
D DISP6^ABMDE9B
W !!
S ABM="",ABMP("OPT")="NJBQ"
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)'="U",($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)'="C") S ABMP("OPT")=ABMP("OPT")_"E"
D SEL^ABMDEOPT
;I "EB"'[$E(Y) S:$D(ABMP("DDL")) ABMP("QUIT")="" G XIT ;abm*2.6*1 HEAT6439
;I "EB"'[$E(Y) S:$D(ABMP("DDL")) ABMP("QUIT")="" G OPT7 ;abm*2.6*1 HEAT6439 ;abm*2.6*6 NOHEAT
I "ANDB"'[$E(Y) G XIT ;abm*2.6*6 NOHEAT
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) G XIT
;G OPT5:$E(Y)="B",OPT7:$E(Y)="N" ;abm*2.6*6 NOHEAT ;abm*2.6*9 NOHEAT
G OPT5:$E(Y)="B"
;I $E(Y)="N",($P($G(^ABMDEXP(ABMP("EXP"),0)),U)'["837") G XIT ;abm*2.6*6 NOHEAT ;abm*2.6*9 NOHEAT ;abm*2.6*14 CR3165
I $E(Y)="N",(($P($G(^ABMDEXP(ABMP("EXP"),0)),U)'["837")&(ABMP("EXP")'=35)) G XIT ;abm*2.6*14 CR3165
;I $E(Y)="N",($P($G(^ABMDEXP(ABMP("EXP"),0)),U)["837") G OPT7 ;abm*2.6*6 NOHEAT ;abm*2.6*9 NOHEAT ;abm*2.6*14 HEAT163711
I $E(Y)="N",(($P($G(^ABMDEXP(ABMP("EXP"),0)),U)["837")!(ABMP("EXP")=35)) G OPT7 ;abm*2.6*6 NOHEAT ;abm*2.6*9 NOHEAT ;abm*2.6*14 HEAT163711
;I $E(Y)="B",($P($G(^ABMDEXP(ABMP("EXP"),0)),U)["ADA") S ABMP("SCRN")=9 G XIT ;abm*2.6*1 HEAT6439
I $E(Y)="B",($P($G(^ABMDEXP(ABMP("EXP"),0)),U)["ADA") S ABMP("SCRN")=9 G OPT7 ;abm*2.6*1 HEAT6439
I $E(Y)="B" G OPT5
D:$E(Y)'="E" D1^ABMDEMLB
G OPT6
;start new code abm*2.6*1 HEAT6439
OPT7 ; Page 9G Claim Attachments
K ABM,ABME
I $D(ABMP("DDL")),'+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),71,0)) S ABMP("QUIT")="" G XIT
D G^ABMDE9X
D DISP7^ABMDE9B W !! S ABM="",ABMP("OPT")="ADENJBQ" D SEL^ABMDEOPT I "ANEDB"'[$E(Y) G XIT
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!($E(Y)="N"),OPT6:$E(Y)="B"
S ABM("DO")=$S($E(Y)="A":"A1^ABMDEML",$E(Y)="E":"E1^ABMDEMLE",1:"D1^ABMDEMLB") D @ABM("DO")
G OPT7
;end new code HEAT6439
;
XIT K ABM,ABMZ
Q
ABMDE9 ; IHS/ASDST/DMJ - Edit Page 9 - UB-82 CODES ;
+1 ;;2.6;IHS Third Party Billing;**1,6,9,13,14**;NOV 12, 2009;Build 238
+2 ;
+3 ; IHS/SD/SDR - v2.5 p10 - IM20337 - Added code for BACK if ADA
+4 ; IHS/SD/SDR - abm*2.6*1 - HEAT6439 - Added page9G for clm attchments
+5 ; IHS/SD/SDR - abm*2.6*6 - NOHEAT - Can't jump to page 5
+6 ;IHS/SD/SDR - 2*6*13 - Updated paging for exp mode 35; should go to page 9A, then 9E
+7 ;IHS/SD/SDR - 2.6*14 - HEAT163711 - Made change to check for exp mode 35, from HCFA to CMS
+8 ;IHS/SD/SDR - 2.6*14 - CR3165 - Correction to page9F to go to page9G for exp mode 35
+9 ;
+10 IF $DATA(ABMP("WORKSHEET"))
SET ABMP("QUIT")=""
QUIT
OPT ; Page 9A Occurrence Description
+1 KILL ABM,ABME
+2 IF $DATA(ABMP("DDL"))
IF '+$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),51,0))
GOTO OPT2
+3 DO A^ABMDE9X
+4 DO DISP^ABMDE9C
WRITE !!
SET ABM=""
SET ABMP("OPT")="ADEVNJBQ"
DO SEL^ABMDEOPT
IF "ADVEN"'[$EXTRACT(Y)
GOTO XIT
+5 ;G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT),OPT2:$E(Y)="N" ;abm*2.6*13 exp mode 35
+6 ;G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT),OPT5:(($E(Y)="N")&($P(^ABMDEXP(ABMP("EXP"),0),U)["HCFA")),OPT2:$E(Y)="N" ;abm*2.6*13 exp mode 35 ;abm*2.6*14 HEAT163711
+7 ;abm*2.6*13 exp mode 35 ;abm*2.6*14 HEAT163711
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
IF (($EXTRACT(Y)="N")&($PIECE(^ABMDEXP(ABMP("EXP"),0),U)["CMS"))
GOTO OPT5
IF $EXTRACT(Y)="N"
GOTO OPT2
+8 SET ABM("DO")=$SELECT($EXTRACT(Y)="A":"A1^ABMDEML",$EXTRACT(Y)="V":"V1^ABMDE9B",$EXTRACT(Y)="E":"E1^ABMDEMLE",1:"D1^ABMDEMLB")
DO @ABM("DO")
+9 GOTO OPT
+10 ;
OPT2 ;Page 9B Occurrence Span
+1 KILL ABM,ABME
+2 IF $DATA(ABMP("DDL"))
IF '+$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),57,0))
GOTO OPT3
+3 DO B^ABMDE9X
+4 DO DISP2^ABMDE9C
WRITE !!
SET ABM=""
SET ABMP("OPT")="ADEVNJBQ"
DO SEL^ABMDEOPT
IF "AVNDEB"'[$EXTRACT(Y)
GOTO XIT
+5 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
IF $EXTRACT(Y)="B"
GOTO OPT
IF $EXTRACT(Y)="N"
GOTO OPT3
+6 SET ABM("DO")=$SELECT($EXTRACT(Y)="A":"A1^ABMDEML",$EXTRACT(Y)="V":"V1^ABMDE9B",$EXTRACT(Y)="E":"E1^ABMDEMLE",1:"D1^ABMDEMLB")
DO @ABM("DO")
+7 GOTO OPT2
+8 ;
OPT3 ; Page 9C Condition Codes
+1 KILL ABM,ABME
+2 IF $DATA(ABMP("DDL"))
IF '+$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),53,0))
GOTO OPT4
+3 DO C^ABMDE9X
+4 DO DISP3^ABMDE9A
WRITE !!
SET ABM=""
SET ABMP("OPT")="ADNJBQ"
DO SEL^ABMDEOPT
IF "ANDB"'[$EXTRACT(Y)
GOTO XIT
+5 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
IF $EXTRACT(Y)="B"
GOTO OPT2
IF $EXTRACT(Y)="N"
GOTO OPT4
+6 SET ABM("DO")=$SELECT($EXTRACT(Y)="A":"A1^ABMDEML",1:"D1^ABMDEMLB")
DO @ABM("DO")
+7 GOTO OPT3
+8 ;
OPT4 ; Page 9D Value Codes
+1 KILL ABM,ABME
+2 IF $DATA(ABMP("DDL"))
IF '+$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),55,0))
GOTO OPT5
+3 DO D^ABMDE9X
+4 DO DISP4^ABMDE9A
WRITE !!
SET ABM=""
SET ABMP("OPT")="ADEVNJBQ"
DO SEL^ABMDEOPT
IF "ANEVDB"'[$EXTRACT(Y)
GOTO XIT
+5 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
IF $EXTRACT(Y)="B"
GOTO OPT3
IF $EXTRACT(Y)="N"
GOTO OPT5
+6 SET ABM("DO")=$SELECT($EXTRACT(Y)="A":"A1^ABMDEML",$EXTRACT(Y)="V":"V1^ABMDE9B",$EXTRACT(Y)="E":"E1^ABMDEMLE",1:"D1^ABMDEMLB")
DO @ABM("DO")
+7 GOTO OPT4
+8 ;
OPT5 ; Page 9E Special Program Codes
+1 KILL ABM,ABME
+2 IF $DATA(ABMP("DDL"))
IF '+$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,0))
GOTO OPT6
+3 DO E^ABMDE9X
+4 DO DISP5^ABMDE9B
WRITE !!
SET ABM=""
SET ABMP("OPT")="ADNJBQ"
DO SEL^ABMDEOPT
IF "ANDB"'[$EXTRACT(Y)
GOTO XIT
+5 ;G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT),OPT4:$E(Y)="B",OPT6:$E(Y)="N" ;abm*2.6*13 exp mode 35
+6 ;abm*2.6*13 exp mode 35
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
IF (($EXTRACT(Y)="B")&($PIECE(^ABMDEXP(ABMP("EXP"),0),U)["HCFA"))
GOTO OPT
IF $EXTRACT(Y)="B"
GOTO OPT4
IF $EXTRACT(Y)="N"
GOTO OPT6
+7 SET ABM("DO")=$SELECT($EXTRACT(Y)="A":"A1^ABMDEML",1:"D1^ABMDEMLB")
DO @ABM("DO")
+8 GOTO OPT5
+9 ;
OPT6 ; Page 9F Remarks
+1 KILL ABM,ABME
+2 ;I $D(ABMP("DDL")),'+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),61,0)) S ABMP("QUIT")="" G XIT ;abm*2.6*1 HEAT6439
+3 ;abm*2.6*1 HEAT6439
IF $DATA(ABMP("DDL"))
IF '+$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),61,0))
SET ABMP("QUIT")=""
GOTO OPT7
+4 DO F^ABMDE9X
+5 ;if unbillable/complete don't allow editing of remarks
+6 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)="U"!($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)="C")
SET ABMQUIET=1
+7 DO DISP6^ABMDE9B
+8 WRITE !!
+9 SET ABM=""
SET ABMP("OPT")="NJBQ"
+10 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)'="U"
IF ($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)'="C")
SET ABMP("OPT")=ABMP("OPT")_"E"
+11 DO SEL^ABMDEOPT
+12 ;I "EB"'[$E(Y) S:$D(ABMP("DDL")) ABMP("QUIT")="" G XIT ;abm*2.6*1 HEAT6439
+13 ;I "EB"'[$E(Y) S:$D(ABMP("DDL")) ABMP("QUIT")="" G OPT7 ;abm*2.6*1 HEAT6439 ;abm*2.6*6 NOHEAT
+14 ;abm*2.6*6 NOHEAT
IF "ANDB"'[$EXTRACT(Y)
GOTO XIT
+15 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
+16 ;G OPT5:$E(Y)="B",OPT7:$E(Y)="N" ;abm*2.6*6 NOHEAT ;abm*2.6*9 NOHEAT
+17 IF $EXTRACT(Y)="B"
GOTO OPT5
+18 ;I $E(Y)="N",($P($G(^ABMDEXP(ABMP("EXP"),0)),U)'["837") G XIT ;abm*2.6*6 NOHEAT ;abm*2.6*9 NOHEAT ;abm*2.6*14 CR3165
+19 ;abm*2.6*14 CR3165
IF $EXTRACT(Y)="N"
IF (($PIECE($GET(^ABMDEXP(ABMP("EXP"),0)),U)'["837")&(ABMP("EXP")'=35))
GOTO XIT
+20 ;I $E(Y)="N",($P($G(^ABMDEXP(ABMP("EXP"),0)),U)["837") G OPT7 ;abm*2.6*6 NOHEAT ;abm*2.6*9 NOHEAT ;abm*2.6*14 HEAT163711
+21 ;abm*2.6*6 NOHEAT ;abm*2.6*9 NOHEAT ;abm*2.6*14 HEAT163711
IF $EXTRACT(Y)="N"
IF (($PIECE($GET(^ABMDEXP(ABMP("EXP"),0)),U)["837")!(ABMP("EXP")=35))
GOTO OPT7
+22 ;I $E(Y)="B",($P($G(^ABMDEXP(ABMP("EXP"),0)),U)["ADA") S ABMP("SCRN")=9 G XIT ;abm*2.6*1 HEAT6439
+23 ;abm*2.6*1 HEAT6439
IF $EXTRACT(Y)="B"
IF ($PIECE($GET(^ABMDEXP(ABMP("EXP"),0)),U)["ADA")
SET ABMP("SCRN")=9
GOTO OPT7
+24 IF $EXTRACT(Y)="B"
GOTO OPT5
+25 IF $EXTRACT(Y)'="E"
DO D1^ABMDEMLB
+26 GOTO OPT6
+27 ;start new code abm*2.6*1 HEAT6439
OPT7 ; Page 9G Claim Attachments
+1 KILL ABM,ABME
+2 IF $DATA(ABMP("DDL"))
IF '+$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),71,0))
SET ABMP("QUIT")=""
GOTO XIT
+3 DO G^ABMDE9X
+4 DO DISP7^ABMDE9B
WRITE !!
SET ABM=""
SET ABMP("OPT")="ADENJBQ"
DO SEL^ABMDEOPT
IF "ANEDB"'[$EXTRACT(Y)
GOTO XIT
+5 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!($EXTRACT(Y)="N")
GOTO XIT
IF $EXTRACT(Y)="B"
GOTO OPT6
+6 SET ABM("DO")=$SELECT($EXTRACT(Y)="A":"A1^ABMDEML",$EXTRACT(Y)="E":"E1^ABMDEMLE",1:"D1^ABMDEMLB")
DO @ABM("DO")
+7 GOTO OPT7
+8 ;end new code HEAT6439
+9 ;
XIT KILL ABM,ABMZ
+1 QUIT
