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

PRCAWREA.m

Go to the documentation of this file.
  1. PRCAWREA ;WASH-ISC@ALTOONA,PA/TJK-RE-ESTABLISH BILL ;7/24/96 2:35 PM
  1. V ;;4.5;Accounts Receivable;**16,49,153,315,377,371**;Mar 20, 1995;Build 29
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Select bill to make active, cancellation, suspended, coll/clos or write-off
  1. N DA,DIC,DIE,I,PRCABN,PRCATAMT,PRCAEN,PRCA,PRCAWO,PRCAPB,PRCATYPE,PRCATY,X,Y,FMSNUM,FMSAMT,PRCASTAT
  1. D CKSITE^PRCAUDT I '$D(PRCA("CKSITE")) W !,"Your site is not defined." G EXIT
  1. K DIC,DA S PRCAWO="," F I=109,240,111,108 S PRCAWO=$G(PRCAWO)_$O(^PRCA(430.3,"AC",I,0))_","
  1. I $G(PRCAWO)']"" W !,"Transaction Types not defined, please contact IRM." G EXIT
  1. S DIC("S")="I $P(^(0),U,2)'=26,"""_PRCAWO_"""[("",""_$P(^(0),U,8)_"","")" D BILLN^PRCAUTL G:$G(PRCABN)="" EXIT
  1. ;
  1. APJ ; Entry point from the ENAP entry point (below) for the Account Profile screen *315
  1. ;
  1. L +^PRCA(430,PRCABN):1 I '$T W !!,*7,"ANOTHER USER IS EDITING THIS BILL" G EXIT
  1. S PRCAPB=$G(^PRCA(430,PRCABN,7)),PRCASTAT=$P(^PRCA(430,PRCABN,0),U,8)
  1. S PRCATAMT=0 F I=1:1:5 S PRCATAMT=PRCATAMT+$P(PRCAPB,U,I)
  1. I PRCATAMT=0&('$$ACCK^PRCAACC(PRCABN)) D G EXIT
  1. .W !!,*7,"A bill with ZERO dollars CANNOT BE RE-ESTABLISHED."
  1. .W !!,"Create a new bill."
  1. .L -^PRCA(430,PRCABN) ; *315 bug fix - unlock the bill before exit
  1. .Q
  1. S FMSAMT=PRCATAMT
  1. I PRCATAMT=0 D AMT I PRCATAMT'>0 W !!,"Sorry, no bill amount entered!" L -^PRCA(430,PRCABN) G EXIT ; *315 unlock bill
  1. D SETTR^PRCAUTL,UPCALM^PRCAWO,PATTR^PRCAUTL
  1. S PRCATYPE=$S($P(^PRCA(430,PRCABN,0),"^",8)=$O(^PRCA(430.3,"AC",240,0)):$O(^PRCA(430.3,"AC",18,0)),1:$O(^PRCA(430.3,"AC",250,0)))
  1. K DIC,DIE,DR,DA S (DIC,DIE)="^PRCA(433,",DA=PRCAEN,DR="[PRCA RE-ESTABLISH WRITE-OFF]" D ^DIE K DIC,DA,DIE,DR
  1. S PRCA("SDT")=DT,PRCA("STATUS")=$O(^PRCA(430.3,"AC",102,0)) D UPSTATS^PRCAUT2
  1. S $P(^PRCA(433,PRCAEN,4,$O(^PRCA(433,PRCAEN,4,0)),0),U,5)=PRCATAMT
  1. S $P(^PRCA(433,PRCAEN,0),U,4)=2 L -^PRCA(430,PRCABN)
  1. ;
  1. ;PRCA*4.5*377 - update Repayment Plan with re-establishment of the bill
  1. D UPDBAL^RCRPU1(PRCABN,PRCAEN)
  1. ;
  1. W !!,*7,?5,$P(^PRCA(430,PRCABN,0),U,1)," is in the ",$P(^PRCA(430.3,$P(^PRCA(430,PRCABN,0),U,8),0),U,1)," status for $",$P(^PRCA(433,PRCAEN,1),U,5)
  1. I $P(^PRCA(430,PRCABN,0),U,8)=$O(^PRCA(430.3,"AC",102,"")) D PREPAY^RCBEPAYP(PRCABN)
  1. I FMSAMT>0,PRCASTAT'=40,'$$ACCK^PRCAACC(PRCABN) D
  1. .S FMSNUM=$P($G(^PRCA(430,PRCABN,11)),U,22),MOD=1
  1. .I FMSNUM="" S FMSNUM=$$ENUM^RCMSNUM,MOD=0
  1. .D MODWR^PRCAFWO(PRCABN,FMSAMT,FMSNUM,PRCAEN,MOD)
  1. .Q
  1. EXIT Q
  1. AMT ;
  1. ;;Ask for amount to be re-established
  1. N Y
  1. AMTE R !!,"Enter Re-Establish Amount: ",Y:DTIME I '$T!(Y["^") S Y=0 G AMTQ
  1. I Y="" W !,*7,"The amount is required. Enter ""^"" to exit!",!
  1. I Y["?"!(Y'?.N.1".".2N)!(Y>999999.99)!(Y<.01) D AMTH G AMTE
  1. ; PRCA*4.5*371 - Replace direct global sets in 7 node with FileMan calls so indexes get updated
  1. AMTQ S PRCATAMT=+Y
  1. I Y>0 D
  1. . N PRCFDA
  1. . S PRCAPB=PRCATAMT_"^^^^^",PRCFDA(430,PRCABN_",",71)=Y
  1. . S $P(^PRCA(430,PRCABN,2,$O(^PRCA(430,PRCABN,2,0)),0),U,2)=PRCATAMT
  1. . D FILE^DIE(,"PRCFDA")
  1. Q
  1. AMTH W !,"Enter in an amount from .01 to 999999.99, 2 decimal digits"
  1. W !!,"The bill must have an amount inorder to be re-established."
  1. W !,"This amount will be the principal balance of the bill."
  1. Q
  1. ;
  1. ENAP(PRCABN) ; Entry point for Re-Establish bill from the Account Profile screen - *315
  1. ; originally called from REESTAB^RCDPAPL1. PRCABN is the internal bill# and is required.
  1. ;
  1. N PG,PRS,I,PRCAWO,PRCATY,PRCA,PRCATAMT,PRCAEN,PRCAPB,PRCATYPE,PRCASTAT,FMSNUM,FMSAMT,MOD
  1. N DA,DIC,DIE,DR,X,Y
  1. ;
  1. ; set other variables related to the bill
  1. S PG=$G(^PRCA(430,PRCABN,0))
  1. S PRCATY=$P(PG,U,2) ; ar category ien
  1. S PRCA("SEG")=$S(+$P(PG,U,21)>240:$P(PG,U,21),1:"") ; segment - used in the input template
  1. S PRCA("STATUS")=$P(PG,U,8) ; current status of the bill
  1. S PRCA("APPR")=$P(PG,U,18) ; appropriation symbol
  1. ;
  1. ; get site stuff
  1. S PRS=+$P($G(^RC(342,1,0)),U,1) ; main AR site
  1. S PRCA("SITE")=+$$GET1^DIQ(4,PRS,99) ; station#
  1. I PRCA("SITE") S PRCA("CKSITE")="" ; station# check flag
  1. ;
  1. ; build a string of valid internal status ien's (WRITE-OFF, SUSPENDED, CANCELLATION, COLLECTED/CLOSED)
  1. S PRCAWO="," F I=109,240,111,108 S PRCAWO=PRCAWO_$O(^PRCA(430.3,"AC",I,0))_","
  1. I '$F(PRCAWO,","_PRCA("STATUS")_",") D G ENAPX
  1. . W !,"The Re-Establish action is not available for this bill because the current"
  1. . W !,"AR status of this bill is "_$$GET1^DIQ(430,PRCABN,8)_"."
  1. . W !,"Valid statuses are WRITE-OFF, SUSPENDED, CANCELLATION, or COLLECTED/CLOSED."
  1. . Q
  1. ;
  1. I PRCATY=26 D G ENAPX
  1. . W !,"The Re-Establish action is not available for this bill because the current"
  1. . W !,"AR category of this bill is "_$$GET1^DIQ(430,PRCABN,2)_". This is the only one not allowed."
  1. . Q
  1. ;
  1. G APJ ; jump into the routine at the proper point
  1. ;
  1. ENAPX ;
  1. Q
  1. ;