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