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

ABMDPAY1.m

Go to the documentation of this file. 
  1. ABMDPAY1 ; IHS/ASDST/DMJ - Payment of Bill - Part 2 ;  
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;
  1.  ; IHS/ASDS/SDH - 08/14/01 - V2.4 Patch 9 - NOIS NDA-1199-180065
  1.  ;     Modified to accept negative numbers and take out range
  1.  ;
  1.  ; *********************************************************************
  1.  ;
  1. V ;EP for Viewing Payments
  1.  G ^ABMDPAYV
  1.  ;
  1. D ;EP for Deleting a Payment
  1.  I +$E(Y,2,3)>0&(+$E(Y,2,3)<(ABM("I")+1)) S Y=+$E(Y,2,3) G D2
  1.  I ABM("I")=1 S Y=1 G D2
  1.  K DIR S DIR(0)="NO^1:"_ABM("I")_":0"
  1.  S DIR("?")="Enter the Sequence Number of the PAYMENT to DELETE",DIR("A")="Sequence Number to DELETE"
  1.  D ^DIR K DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(Y'>0)
  1. D2 W ! S ABM("ANS")=+Y K DIR S DIR(0)="YO",DIR("A")="Do you wish PAYMENT Number "_ABM("ANS")_" DELETED" D ^DIR K DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1. D3 I Y=1 S DA(1)=ABMP("BDFN"),DA=ABM("I",ABM("ANS")),DIK="^ABMDBILL(DUZ(2),"_DA(1)_",3," D ^DIK
  1.  Q
  1.  ;
  1. A ;EP for Adding a Payment
  1.  K DIR S DIR(0)="DAO^"_ABMP("VDT")_":"_DT,DIR("A")="Enter NEW PAYMENT Date: " D ^DIR
  1.  K DIR Q:$D(DIRUT)!$D(DIROUT)
  1.  ;
  1. ADT ;EP for Adding Payment with known Payment Date (Y)
  1.  I '$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),3,0)) S ^ABMDBILL(DUZ(2),ABMP("BDFN"),3,0)="^9002274.403D^^"
  1.  S ABM("PDT")=+Y,X=+Y
  1.  K DIC,DD,DO,DINUM
  1.  S DA(1)=ABMP("BDFN"),DIC="^ABMDBILL(DUZ(2),"_DA(1)_",3,",DIC(0)="LE"
  1.  D FILE^DICN K DIC
  1.  Q:+Y<1!$D(DTOUT)!$D(DUOUT)  S ABM("PAYM")=+Y
  1.  I $P(Y,U,3)=1,"ABT"[$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,4) S DIE="^ABMDBILL(DUZ(2),",DA=ABMP("BDFN"),DR=".04////P" D ^DIE
  1.  G EDIT
  1.  ;
  1. E ;EP for Editing a Payment
  1.  I ABM("I")=0 W *7,!!,"There are no entries to edit, you must first ADD an entry.",! K DIR S DIR(0)="E" D ^DIR K DIR Q
  1.  I $E(Y,2)>0&($E(Y,2)<(ABM("I")+1)) S Y=$E(Y,2) G E2
  1.  I ABM("I")=1 S Y=1 G E2
  1.  K DIR S DIR(0)="NO^1:"_ABM("I")_":0"
  1.  S DIR("?")="Enter the Sequence Number of the PAYMENT to Edit",DIR("A")="Sequence Number to EDIT"
  1.  D ^DIR K DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(+Y'>0)
  1. E2 S ABM("PAYM")=+Y W !!,"[",+Y,"]  ",$$HDT^ABMDUTL($P(ABM(+Y),U)),!,"==================="
  1.  S ABM("PAYM")=ABM("I",ABM("PAYM"))
  1.  ;
  1.  ; var def: ABM(TOT) = paid amt ^ deductible amt ^ write-off amt
  1.  ;
  1. EDIT S ABM("P0")=^ABMDBILL(DUZ(2),ABMP("BDFN"),3,ABM("PAYM"),0)
  1.  S ABM("OB")=ABM("OB")+$P(ABM("P0"),U,2)+$P(ABM("P0"),U,3)+$P(ABM("P0"),U,4)
  1.  S $P(ABM("TOT"),U)=$P(ABM("TOT"),U)-$P(ABM("P0"),U,2)
  1.  S $P(ABM("TOT"),U,2)=$P(ABM("TOT"),U,2)-$P(ABM("P0"),U,3)-$P(ABM("P0"),U,4)
  1.  S DA(1)=ABMP("BDFN"),DIE="^ABMDBILL(DUZ(2),"_DA(1)_",3,",DA=ABM("PAYM"),DR=".02R~Payment Amount.....: ;.03Deductible Amount..: ;S:X Y=""@1"";.04Co-Insurance Amount: ;@1" D ^DIE K DR Q:$D(Y)
  1.  S ABM("P0")=^ABMDBILL(DUZ(2),DA(1),3,DA,0)
  1.  S $P(ABM("TOT"),U)=$P(ABM("TOT"),U)+$P(ABM("P0"),U,2)
  1.  S $P(ABM("TOT"),U,2)=$P(ABM("TOT"),U,2)+$P(ABM("P0"),U,3)+$P(ABM("P0"),U,4)
  1.  S ABM("OB")=ABM("OB")-$P(ABM("P0"),U,2)-$P(ABM("P0"),U,3)-$P(ABM("P0"),U,4)
  1.  I $P(ABM("P0"),U,6)<0,ABM("OB") D
  1.  .S $P(ABM("P0"),U,6)=ABM("OB")+$P(ABM("P0"),U,6),ABM("OB")=0
  1.  .S DA(1)=ABMP("BDFN"),DIE="^ABMDBILL(DUZ(2),"_DA(1)_",3,",DA=ABM("PAYM")
  1.  .S DR=".06////"_$P(ABM("P0"),U,6) D ^DIE
  1.  I ABM("OB")<0,$P($G(^AUTNINS(ABMP("INS"),2)),U,2)="Y" D  G E3
  1.  .S DA(1)=ABMP("BDFN"),DIE="^ABMDBILL(DUZ(2),"_DA(1)_",3,",DA=ABM("PAYM")
  1.  .S DR=".06////"_($P(^ABMDBILL(DUZ(2),DA(1),3,DA,0),U,6)+ABM("OB")) D ^DIE
  1.  .S ABM("OB")=0
  1.  W !!?16,"(Unobligated Balance: ",$FN(ABM("OB"),",",2),")",!
  1.  I ABM("OB")<1,'$P(ABM("P0"),U,6) G E3
  1.  G E3:$P(ABM("P0"),U,6)<0
  1.  K DIR S (ABM("WO"),DIR("B"))=$P(ABM("P0"),U,6)
  1.  S ABM("WW")=ABM("OB")+ABM("WO") S:ABM("WW")<ABM("WO") ABM("WW")=ABM("WO")
  1.  S ABM="-99999:99999:3"
  1.  K:DIR("B")="" DIR("B")
  1.  S DIR(0)="NOA^"_ABM
  1.  S:ABM("WW")<50 DIR("B")=ABM("WW")
  1.  S DIR("A")="Write-off Amount: " D ^DIR
  1.  S ABM("OB")=ABM("OB")+ABM("WO")-Y,$P(ABM("TOT"),U,3)=+Y
  1.  S DA(1)=ABMP("BDFN"),DIE="^ABMDBILL(DUZ(2),"_DA(1)_",3,",DA=ABM("PAYM"),DR=".06////"_+Y D ^DIE
  1.  ;
  1. E3 S DIE="^ABMDBILL(DUZ(2),",DA=ABMP("BDFN"),DR=".25////"_ABM("OB") D ^DIE
  1.  Q:$D(ABMP("PRE-PAY"))
  1.  G CHK^ABMDPAY2