PRCEBL ;WISC/LDB-BULLETIN FOR REMAINING OBLIGATION BALANCE NOTIFICATION ; 07/08/93 11:55 AM
;;5.1;IFCAP;**23**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
EN ;Called from PRCEAU0 (called by PRCEAU,PRCEDRE/DRE2),PRCEAU1 to alert CP concerning remaining obligation balance
Q:+$P(BAL,U,6)
I '$D(PODA) D Q:$G(PODA)=""
. Q:$P($G(TRNODE(4)),U,5)=""
. 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
D BUL^PRCH58(PODA)
N TIME1,LN S TIME1=$P(TIME,"."),TIME1=+$E(TIME1,4,5)_"/"_+$E(TIME1,6,7)_"/"_$E(TIME1,2,3)
S PRBL(1)=" ATTENTION!!"
S PRBL(2)=" "
S PRBL(3)="As of "_TIME1_" on 1358 obligation number: "_PRC("SITE")_"-"_$P($G(TRNODE(4)),U,5)
S PRBL(4)="the obligated balance is $"_$FN(+BAL,"P,",2)_"."
S PRBL(5)="Total authorized amount is $"_$FN($P(BAL,U,3),"P,",2)_"."
S LN=6 I $P(BAL,U,3)'=$P(^PRC(424,AUDA,0),"^",12) D
. S PRBL(LN)="Amount for this authorization is"_$FN($P(^PRC(424,AUDA,0),"^",12),"P,",2)_"."
. S LN=LN+1
S PRBL(LN)="Balance remaining on this authorization is $"
S PRBL(LN)=PRBL(LN)_$FN($P(^PRC(424,AUDA,0),"^",5)-$S($G(IN)="EDIT":0,1:Y),"P,",2)_"."
S PRBL(LN+1)="Please review and determine if an adjustment is necessary for future"
S PRBL(LN+2)="payments, if not, mark the 1358 as complete."
S XMTEXT="PRBL(",XMSUB="1358 NOTICE TO CONTROL POINT "_$P($P($G(TRNODE(3)),"^",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"
D:$O(XMY(0)) ^XMD K PRBL,XMDUZ,XMSUB,XMTEXT,XMY Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCEBL 1628 printed Apr 09, 2024@21:05 Page 2
PRCEBL ;WISC/LDB-BULLETIN FOR REMAINING OBLIGATION BALANCE NOTIFICATION ; 07/08/93 11:55 AM
+1 ;;5.1;IFCAP;**23**;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
EN ;Called from PRCEAU0 (called by PRCEAU,PRCEDRE/DRE2),PRCEAU1 to alert CP concerning remaining obligation balance
+1 if +$PIECE(BAL,U,6)
QUIT
+2 IF '$DATA(PODA)
Begin DoDot:1
+3 if $PIECE($GET(TRNODE(4)),U,5)=""
QUIT
+4 SET ZX=$GET(X)
SET DIC="^PRC(442,"
SET DIC(0)="MN"
SET X=PRC("SITE")_"-"_$PIECE($GET(TRNODE(4)),U,5)
DO ^DIC
KILL DIC
SET X=ZX
if +Y>0
SET PODA=+Y
End DoDot:1
if $GET(PODA)=""
QUIT
+5 DO BUL^PRCH58(PODA)
+6 NEW TIME1,LN
SET TIME1=$PIECE(TIME,".")
SET TIME1=+$EXTRACT(TIME1,4,5)_"/"_+$EXTRACT(TIME1,6,7)_"/"_$EXTRACT(TIME1,2,3)
+7 SET PRBL(1)=" ATTENTION!!"
+8 SET PRBL(2)=" "
+9 SET PRBL(3)="As of "_TIME1_" on 1358 obligation number: "_PRC("SITE")_"-"_$PIECE($GET(TRNODE(4)),U,5)
+10 SET PRBL(4)="the obligated balance is $"_$FNUMBER(+BAL,"P,",2)_"."
+11 SET PRBL(5)="Total authorized amount is $"_$FNUMBER($PIECE(BAL,U,3),"P,",2)_"."
+12 SET LN=6
IF $PIECE(BAL,U,3)'=$PIECE(^PRC(424,AUDA,0),"^",12)
Begin DoDot:1
+13 SET PRBL(LN)="Amount for this authorization is"_$FNUMBER($PIECE(^PRC(424,AUDA,0),"^",12),"P,",2)_"."
+14 SET LN=LN+1
End DoDot:1
+15 SET PRBL(LN)="Balance remaining on this authorization is $"
+16 SET PRBL(LN)=PRBL(LN)_$FNUMBER($PIECE(^PRC(424,AUDA,0),"^",5)-$SELECT($GET(IN)="EDIT":0,1:Y),"P,",2)_"."
+17 SET PRBL(LN+1)="Please review and determine if an adjustment is necessary for future"
+18 SET PRBL(LN+2)="payments, if not, mark the 1358 as complete."
+19 SET XMTEXT="PRBL("
SET XMSUB="1358 NOTICE TO CONTROL POINT "_$PIECE($PIECE($GET(TRNODE(3)),"^",1)," ",1)
+20 KILL XMY
NEW X
SET X=0
FOR
SET X=$ORDER(^PRC(420,PRC("SITE"),1,+$PIECE($GET(TRNODE(3))," "),1,X))
if 'X
QUIT
IF $PIECE($GET(^(X,0)),U,2)<3
SET XMY(X,1)="I"
+21 if $ORDER(XMY(0))
DO ^XMD
KILL PRBL,XMDUZ,XMSUB,XMTEXT,XMY
QUIT
