- 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 Feb 18, 2025@23:27:42 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