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

PRCEBL.m

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