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

ABMRSUBN.m

Go to the documentation of this file.
  1. ABMRSUBN ; IHS/SD/SDR - Resubmission Number Entry ;
  1. ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1. ;
  1. ; For data entry of resubmission number for claims. Claim doesn't
  1. ; need to be cancelled but number will be entered and then claim
  1. ; reprinted in order for it to show up.
  1. ;
  1. ; IHS/SD/SDR - v2.5 p13 - IM25920
  1. ; Changed field to free-text with length of 29
  1. ;
  1. ;pick bill/patient; display info and confirm selection
  1. K DIR,DIE,DIC
  1. K ABMP
  1. D BILL^ABMDBDIC ;returns ABMP("BDFN") and ABMP("PDFN")
  1. Q:$G(ABMP("BDFN"))=""
  1. S DIR(0)="YO"
  1. S DIR("A")="Bill "_$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U)
  1. S DIR("B")="Y"
  1. D ^DIR
  1. Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
  1. ;
  1. ;prompt for changes
  1. K DIR,DIE,DIC,X,Y
  1. S DIR(0)="NOA^111:999"
  1. S DIR("A")="Bill type: "
  1. S DIR("B")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,2)
  1. D ^DIR
  1. Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
  1. S ABMP(".02")=Y
  1. ;
  1. K DIR,DIE,DIC,X,Y
  1. S DIR(0)="FAO^1:29"
  1. S DIR("A")="Resubmission (Control) Number: "
  1. S DIR("B")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,9)
  1. D ^DIR
  1. Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
  1. S ABMP(".49")=Y
  1. ;
  1. K DIR,DIE,DIC,X,Y
  1. S DIR(0)="FAO^3:80"
  1. S DIR("A")="Resubmission (Control) note: "
  1. S DIR("B")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,11)
  1. D ^DIR
  1. Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
  1. S ABMP("411")=Y
  1. ;
  1. ;display bill info
  1. W !!
  1. S ABM("STATUS")=$P(^DD(9002274.4,.04,0),"^",3)
  1. S ABM("CNT")=0
  1. S ABMP("PDFN")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U)
  1. S ABM("ZERO")=^ABMDBILL(DUZ(2),ABMP("BDFN"),0)
  1. N J F J=1:1:12 S ABM(J)=$P(ABM("ZERO"),U,J)
  1. S ABM(7,1)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U)
  1. S ABM(2,1)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U)
  1. S ABM(4)=$P(ABM("STATUS"),ABM(4)_":",2),ABM(4)=$P(ABM(4),";",1)
  1. W ?5,"Bill# ",ABM(1)
  1. W ?20,$$SDT^ABMDUTL(ABM(7,1))
  1. W ?30,$P($G(^ABMDVTYP(+ABM(7),0)),U)
  1. W ?51,$P($G(^DIC(40.7,+ABM(10),0)),U)
  1. W ?67,$P($G(^AUTTLOC(+ABM(3),0)),U,2)
  1. W !,?6,$P($G(^ABMDEXP(+ABM(6),0)),U)
  1. W ?18,$E(ABM(4),1,15)
  1. W ?37,$P($G(^AUTNINS(+ABM(8),0)),U)
  1. W ?70,$J($FN(ABM(2,1),",",2),10)
  1. ;
  1. ;display would be changes before filing on bill
  1. W !!
  1. W ?5,"Bill Type: ",ABMP(".02")
  1. W ?40,"User: ",$P($G(^VA(200,DUZ,0)),U)
  1. W !?5,"Resubmission Number: ",ABMP(".49")
  1. W ?40,"Date: ",$$SDT^ABMDUTL(DT)
  1. W !?5,"Notes: ",ABMP("411")
  1. ;
  1. ;confirm changes before filing on bill
  1. W !!
  1. K DIR,DIE,DIC,X,Y
  1. S DIR(0)="YA"
  1. S DIR("A")="Correct? "
  1. S DIR("B")="Y"
  1. D ^DIR
  1. Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
  1. Q:Y'=1
  1. ;
  1. ;
  1. ;file changes if YES
  1. K DIC,DIE,X,Y,DA
  1. S DIE="^ABMDBILL(DUZ(2),"
  1. S DA=ABMP("BDFN")
  1. S DR=".02////"_ABMP(".02")
  1. S DR=DR_";.49////"_ABMP(".49")
  1. S DR=DR_";411////"_ABMP("411")
  1. D ^DIE
  1. ;
  1. ;reprint bill?
  1. W !
  1. K DIR,DIE,DIC,X,Y
  1. S DIR(0)="YA"
  1. S DIR("A")="Reprint bill? "
  1. S DIR("B")="Y"
  1. D ^DIR
  1. Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
  1. Q:Y'=1
  1. ;
  1. S ABMY("FORM")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,6)
  1. S ABMY("FORM")=ABMY("FORM")_"^"_$P($G(^ABMDEXP(ABMY("FORM"),0)),U)
  1. S ABMY(ABMP("BDFN"))=""
  1. S ABMY("TOT")="0^0^0"
  1. S ABMP("XMIT")=0
  1. D ZIS^ABMDFRDO
  1. Q