| 1 | PRCEBL ;WISC/LDB-BULLETIN FOR REMAINING OBLIGATION BALANCE NOTIFICATION ; 07/08/93 11:55 AM
|
|---|
| 2 | ;;5.1;IFCAP;**23**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN ;Called from PRCEAU0 (called by PRCEAU,PRCEDRE/DRE2),PRCEAU1 to alert CP concerning remaining obligation balance
|
|---|
| 5 | Q:+$P(BAL,U,6)
|
|---|
| 6 | I '$D(PODA) D Q:$G(PODA)=""
|
|---|
| 7 | . Q:$P($G(TRNODE(4)),U,5)=""
|
|---|
| 8 | . S ZX=$G(X),DIC="^PRC(442,",DIC(0)="MN",X=PRC("SITE")_"-"_$P($G(TRNODE(4)),U,5) D ^DIC K DIC S X=ZX S:+Y>0 PODA=+Y
|
|---|
| 9 | D BUL^PRCH58(PODA)
|
|---|
| 10 | N TIME1,LN S TIME1=$P(TIME,"."),TIME1=+$E(TIME1,4,5)_"/"_+$E(TIME1,6,7)_"/"_$E(TIME1,2,3)
|
|---|
| 11 | S PRBL(1)=" ATTENTION!!"
|
|---|
| 12 | S PRBL(2)=" "
|
|---|
| 13 | S PRBL(3)="As of "_TIME1_" on 1358 obligation number: "_PRC("SITE")_"-"_$P($G(TRNODE(4)),U,5)
|
|---|
| 14 | S PRBL(4)="the obligated balance is $"_$FN(+BAL,"P,",2)_"."
|
|---|
| 15 | S PRBL(5)="Total authorized amount is $"_$FN($P(BAL,U,3),"P,",2)_"."
|
|---|
| 16 | S LN=6 I $P(BAL,U,3)'=$P(^PRC(424,AUDA,0),"^",12) D
|
|---|
| 17 | . S PRBL(LN)="Amount for this authorization is"_$FN($P(^PRC(424,AUDA,0),"^",12),"P,",2)_"."
|
|---|
| 18 | . S LN=LN+1
|
|---|
| 19 | S PRBL(LN)="Balance remaining on this authorization is $"
|
|---|
| 20 | S PRBL(LN)=PRBL(LN)_$FN($P(^PRC(424,AUDA,0),"^",5)-$S($G(IN)="EDIT":0,1:Y),"P,",2)_"."
|
|---|
| 21 | S PRBL(LN+1)="Please review and determine if an adjustment is necessary for future"
|
|---|
| 22 | S PRBL(LN+2)="payments, if not, mark the 1358 as complete."
|
|---|
| 23 | S XMTEXT="PRBL(",XMSUB="1358 NOTICE TO CONTROL POINT "_$P($P($G(TRNODE(3)),"^",1)," ",1)
|
|---|
| 24 | K XMY N X S X=0 F S X=$O(^PRC(420,PRC("SITE"),1,+$P($G(TRNODE(3))," "),1,X)) Q:'X I $P($G(^(X,0)),U,2)<3 S XMY(X,1)="I"
|
|---|
| 25 | D:$O(XMY(0)) ^XMD K PRBL,XMDUZ,XMSUB,XMTEXT,XMY Q
|
|---|
