source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCEBL.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1PRCEBL ;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.
4EN ;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
Note: See TracBrowser for help on using the repository browser.