Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMDE9

ABMDE9.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p10 - IM20337 - Added code for BACK if ADA
  1.  ; IHS/SD/SDR - abm*2.6*1 - HEAT6439 - Added page9G for clm attchments
  1.  ; IHS/SD/SDR - abm*2.6*6 - NOHEAT - Can't jump to page 5
  1.  ;IHS/SD/SDR - 2*6*13 - Updated paging for exp mode 35; should go to page 9A, then 9E
  1.  ;IHS/SD/SDR - 2.6*14 - HEAT163711 - Made change to check for exp mode 35, from HCFA to CMS
  1.  ;IHS/SD/SDR - 2.6*14 - CR3165 - Correction to page9F to go to page9G for exp mode 35
  1.  ;
  1.  I $D(ABMP("WORKSHEET")) S ABMP("QUIT")="" Q
  1. OPT ; Page 9A Occurrence Description
  1.  K ABM,ABME
  1.  I $D(ABMP("DDL")),'+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),51,0)) G OPT2
  1.  D A^ABMDE9X
  1.  D DISP^ABMDE9C W !! S ABM="",ABMP("OPT")="ADEVNJBQ" D SEL^ABMDEOPT I "ADVEN"'[$E(Y) G XIT
  1.  ;G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT),OPT2:$E(Y)="N"  ;abm*2.6*13 exp mode 35
  1.  ;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
  1.  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
  1.  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")
  1.  G OPT
  1.  ;
  1. OPT2 ;Page 9B Occurrence Span
  1.  K ABM,ABME
  1.  I $D(ABMP("DDL")),'+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),57,0)) G OPT3
  1.  D B^ABMDE9X
  1.  D DISP2^ABMDE9C W !! S ABM="",ABMP("OPT")="ADEVNJBQ" D SEL^ABMDEOPT I "AVNDEB"'[$E(Y) G XIT
  1.  G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT),OPT:$E(Y)="B",OPT3:$E(Y)="N"
  1.  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")
  1.  G OPT2
  1.  ;
  1. OPT3 ; Page 9C Condition Codes
  1.  K ABM,ABME
  1.  I $D(ABMP("DDL")),'+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),53,0)) G OPT4
  1.  D C^ABMDE9X
  1.  D DISP3^ABMDE9A W !! S ABM="",ABMP("OPT")="ADNJBQ" D SEL^ABMDEOPT I "ANDB"'[$E(Y) G XIT
  1.  G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT),OPT2:$E(Y)="B",OPT4:$E(Y)="N"
  1.  S ABM("DO")=$S($E(Y)="A":"A1^ABMDEML",1:"D1^ABMDEMLB") D @ABM("DO")
  1.  G OPT3
  1.  ;
  1. OPT4 ; Page 9D Value Codes
  1.  K ABM,ABME
  1.  I $D(ABMP("DDL")),'+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),55,0)) G OPT5
  1.  D D^ABMDE9X
  1.  D DISP4^ABMDE9A W !! S ABM="",ABMP("OPT")="ADEVNJBQ" D SEL^ABMDEOPT I "ANEVDB"'[$E(Y) G XIT
  1.  G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT),OPT3:$E(Y)="B",OPT5:$E(Y)="N"
  1.  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")
  1.  G OPT4
  1.  ;
  1. OPT5 ; Page 9E Special Program Codes
  1.  K ABM,ABME
  1.  I $D(ABMP("DDL")),'+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,0)) G OPT6
  1.  D E^ABMDE9X
  1.  D DISP5^ABMDE9B W !! S ABM="",ABMP("OPT")="ADNJBQ" D SEL^ABMDEOPT I "ANDB"'[$E(Y) G XIT
  1.  ;G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT),OPT4:$E(Y)="B",OPT6:$E(Y)="N"  ;abm*2.6*13 exp mode 35
  1.  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
  1.  S ABM("DO")=$S($E(Y)="A":"A1^ABMDEML",1:"D1^ABMDEMLB") D @ABM("DO")
  1.  G OPT5
  1.  ;
  1. OPT6 ; Page 9F Remarks
  1.  K ABM,ABME
  1.  ;I $D(ABMP("DDL")),'+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),61,0)) S ABMP("QUIT")="" G XIT  ;abm*2.6*1 HEAT6439
  1.  I $D(ABMP("DDL")),'+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),61,0)) S ABMP("QUIT")="" G OPT7  ;abm*2.6*1 HEAT6439
  1.  D F^ABMDE9X
  1.  ;if unbillable/complete don't allow editing of remarks
  1.  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
  1.  D DISP6^ABMDE9B
  1.  W !!
  1.  S ABM="",ABMP("OPT")="NJBQ"
  1.  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"
  1.  D SEL^ABMDEOPT
  1.  ;I "EB"'[$E(Y) S:$D(ABMP("DDL")) ABMP("QUIT")="" G XIT  ;abm*2.6*1 HEAT6439
  1.  ;I "EB"'[$E(Y) S:$D(ABMP("DDL")) ABMP("QUIT")="" G OPT7  ;abm*2.6*1 HEAT6439  ;abm*2.6*6 NOHEAT
  1.  I "ANDB"'[$E(Y) G XIT  ;abm*2.6*6 NOHEAT
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) G XIT
  1.  ;G OPT5:$E(Y)="B",OPT7:$E(Y)="N"  ;abm*2.6*6 NOHEAT  ;abm*2.6*9 NOHEAT
  1.  G OPT5:$E(Y)="B"
  1.  ;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
  1.  I $E(Y)="N",(($P($G(^ABMDEXP(ABMP("EXP"),0)),U)'["837")&(ABMP("EXP")'=35)) G XIT  ;abm*2.6*14 CR3165
  1.  ;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
  1.  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
  1.  ;I $E(Y)="B",($P($G(^ABMDEXP(ABMP("EXP"),0)),U)["ADA") S ABMP("SCRN")=9 G XIT  ;abm*2.6*1 HEAT6439
  1.  I $E(Y)="B",($P($G(^ABMDEXP(ABMP("EXP"),0)),U)["ADA") S ABMP("SCRN")=9 G OPT7  ;abm*2.6*1 HEAT6439
  1.  I $E(Y)="B" G OPT5
  1.  D:$E(Y)'="E" D1^ABMDEMLB
  1.  G OPT6
  1.  ;start new code abm*2.6*1 HEAT6439
  1. OPT7 ; Page 9G Claim Attachments
  1.  K ABM,ABME
  1.  I $D(ABMP("DDL")),'+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),71,0)) S ABMP("QUIT")="" G XIT
  1.  D G^ABMDE9X
  1.  D DISP7^ABMDE9B W !! S ABM="",ABMP("OPT")="ADENJBQ" D SEL^ABMDEOPT I "ANEDB"'[$E(Y) G XIT
  1.  G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!($E(Y)="N"),OPT6:$E(Y)="B"
  1.  S ABM("DO")=$S($E(Y)="A":"A1^ABMDEML",$E(Y)="E":"E1^ABMDEMLE",1:"D1^ABMDEMLB") D @ABM("DO")
  1.  G OPT7
  1.  ;end new code HEAT6439
  1.  ;
  1. XIT K ABM,ABMZ
  1.  Q