| [628] | 1 | PRCEAU0 ;WISC/LDB/BGJ-CREATE/EDIT AUTHORIZATION-CONTROL POINTS CONT. ; 07/08/93 12:03 PM
|
|---|
| 2 | V ;;5.1;IFCAP;**23**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | BUL ;called from PRCEAU,PRCEDRE/DRE1 to alert control about remaining balance
|
|---|
| 5 | Q:$P($G(^PRC(424,+$G(AUDA),0)),"^",5)=""
|
|---|
| 6 | ; send bulletin, if remaining balance minus daily entry is
|
|---|
| 7 | ; smaller than 5% of the 1358 obligated balance.
|
|---|
| 8 | I $P(^PRC(424,+AUDA,0),U,5)-Y<($P(BAL,U)*.05) D EN^PRCEBL
|
|---|
| 9 | Q
|
|---|
| 10 | DEL ;delete or retain when uparrow entered
|
|---|
| 11 | S DIR(0)="YO",DIR("A")="Would you like to DELETE this authorization",DIR("B")="YES",DIR("?")="press <RETURN> to delete this entry, enter NO or '^' to retain entry" D ^DIR
|
|---|
| 12 | I Y["^"!(Y=0) Q
|
|---|
| 13 | D WAIT^PRCFYN
|
|---|
| 14 | S DA=AUDA,DIK="^PRC(424," D ^DIK S X="--- Entry Deleted ---*" D MSG^PRCFQ
|
|---|
| 15 | S BAL1=-$G(BAL1) D BALUP^PRCH58(PODA,BAL1) S X="--- Obligation balances updated ---" D MSG^PRCFQ
|
|---|
| 16 | Q
|
|---|
| 17 | HLP ;help response for the reader
|
|---|
| 18 | W !,"Enter the corresponding number for the action you want to take.",!,"You can select one or more items from the list provided."
|
|---|
| 19 | W !,"ZEROing out an authorization will mark the authorization as complete and return any monies left over to the obligation."
|
|---|
| 20 | W !,"The numbers can be seperated by commas, dashes or combination of",!,"both. i.e. 1,2,3,4 or 1-4 or 1-3,4."
|
|---|
| 21 | Q
|
|---|
| 22 | LREC ;Called from PRCEAU to enter 424.1 entry
|
|---|
| 23 | L +^PRC(424,AUDA,0):3 E S X(1)=X(1)+1 G:(X(1)<4) LREC I X(1)>3 S X="Someone else is editing this authorization. Try later." D MSG^PRCFQ,AMTDEL^PRCEAU Q
|
|---|
| 24 | DREC S DIC="^PRC(424.1,",DIC(0)="LX",DLAYGO=424.1,X=AUDA0,X=""""_X_"-"_0_"""" D ^DIC
|
|---|
| 25 | I Y<0 S X="The daily record entry cannot be entered. Please see the Application Coordinator." D MSG^PRCFQ,AMTDEL^PRCEAU
|
|---|
| 26 | I '$P(Y,U,3) S X1=X1+100 G DREC
|
|---|
| 27 | L -^PRC(424,AUDA,0)
|
|---|
| 28 | F L +^PRC(424.1,+Y,0):1 I Q
|
|---|
| 29 | S DIE="^PRC(424.1,",DA=+Y,DR=".011////^S X=""AU"";.02////^S X=AUDA;.03////^S X=BAL1;.04////^S X=TIME;.05////^S X=DUZ;.08////^S X=""ORIGINAL AMOUNT"";.1////^S X=DUZ" D ^DIE
|
|---|
| 30 | L -^PRC(424.1,DA,0)
|
|---|
| 31 | D BALUP^PRCH58(PODA,BAL1)
|
|---|
| 32 | Q
|
|---|
