PRCEAU0.m

PRCEAU0 ;WISC/LDB/BGJ-CREATE/EDIT AUTHORIZATION-CONTROL POINTS CONT. ; 07/08/93  12:03 PM

V ;;5.1;IFCAP;**23**;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

BUL ;called from PRCEAU,PRCEDRE/DRE1 to alert control about remaining balance

 Q:$P($G(^PRC(424,+$G(AUDA),0)),"^",5)=""

 ;  send bulletin, if remaining balance minus daily entry is 

 ;     smaller than 5% of the 1358 obligated balance.

 I $P(^PRC(424,+AUDA,0),U,5)-Y<($P(BAL,U)*.05) D EN^PRCEBL

 Q

DEL ;delete or retain when uparrow entered

 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

 I Y["^"!(Y=0) Q

 D WAIT^PRCFYN

 S DA=AUDA,DIK="^PRC(424," D ^DIK S X="--- Entry Deleted ---*" D MSG^PRCFQ

 S BAL1=-$G(BAL1) D BALUP^PRCH58(PODA,BAL1) S X="--- Obligation balances updated ---" D MSG^PRCFQ

 Q

HLP ;help response for the reader

 W !,"Enter the corresponding number for the action you want to take.",!,"You can select one or more items from the list provided."

 W !,"ZEROing out an authorization will mark the authorization as complete and return any monies left over to the obligation."

 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."

 Q

LREC ;Called from PRCEAU to enter 424.1 entry

 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

DREC S DIC="^PRC(424.1,",DIC(0)="LX",DLAYGO=424.1,X=AUDA0,X=""""_X_"-"_0_"""" D ^DIC

 I Y<0 S X="The daily record entry cannot be entered. Please see the Application Coordinator." D MSG^PRCFQ,AMTDEL^PRCEAU

 I '$P(Y,U,3) S X1=X1+100 G DREC

 L -^PRC(424,AUDA,0)

 F  L +^PRC(424.1,+Y,0):1 I  Q

 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

 L -^PRC(424.1,DA,0)

 D BALUP^PRCH58(PODA,BAL1)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCEAU0   2069     printed  Apr 09, 2024@21:20:39                                                                                                                                                                                                     Page 2

PRCEAU0   ;WISC/LDB/BGJ-CREATE/EDIT AUTHORIZATION-CONTROL POINTS CONT. ; 07/08/93  12:03 PM

V         ;;5.1;IFCAP;**23**;Oct 20, 2000

 +1       ;Per VHA Directive 10-93-142, this routine should not be modified.

BUL       ;called from PRCEAU,PRCEDRE/DRE1 to alert control about remaining balance

 +1        if $PIECE($GET(^PRC(424,+$GET(AUDA),0)),"^",5)=""

               QUIT 

 +2       ;  send bulletin, if remaining balance minus daily entry is 

 +3       ;     smaller than 5% of the 1358 obligated balance.

 +4        IF $PIECE(^PRC(424,+AUDA,0),U,5)-Y<($PIECE(BAL,U)*.05)

               DO EN^PRCEBL

 +5        QUIT 

DEL       ;delete or retain when uparrow entered

 +1        SET DIR(0)="YO"

           SET DIR("A")="Would you like to DELETE this authorization"

           SET DIR("B")="YES"

           SET DIR("?")="press <RETURN> to delete this entry, enter NO or '^' to retain entry"

           DO ^DIR

 +2        IF Y["^"!(Y=0)

               QUIT 

 +3        DO WAIT^PRCFYN

 +4        SET DA=AUDA

           SET DIK="^PRC(424,"

           DO ^DIK

           SET X="--- Entry Deleted ---*"

           DO MSG^PRCFQ

 +5        SET BAL1=-$GET(BAL1)

           DO BALUP^PRCH58(PODA,BAL1)

           SET X="--- Obligation balances updated ---"

           DO MSG^PRCFQ

 +6        QUIT 

HLP       ;help response for the reader

 +1        WRITE !,"Enter the corresponding number for the action you want to take.",!,"You can select one or more items from the list provided."

 +2        WRITE !,"ZEROing out an authorization will mark the authorization as complete and return any monies left over to the obligation."

 +3        WRITE !,"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."

 +4        QUIT 

LREC      ;Called from PRCEAU to enter 424.1 entry

 +1        LOCK +^PRC(424,AUDA,0):3

          IF '$TEST

               SET X(1)=X(1)+1

               if (X(1)<4)

                   GOTO LREC

               IF X(1)>3

                   SET X="Someone else is editing this authorization. Try later."

                   DO MSG^PRCFQ

                   DO AMTDEL^PRCEAU

                   QUIT 

DREC       SET DIC="^PRC(424.1,"

           SET DIC(0)="LX"

           SET DLAYGO=424.1

           SET X=AUDA0

           SET X=""""_X_"-"_0_""""

           DO ^DIC

 +1        IF Y<0

               SET X="The daily record entry cannot be entered. Please see the Application Coordinator."

               DO MSG^PRCFQ

               DO AMTDEL^PRCEAU

 +2        IF '$PIECE(Y,U,3)

               SET X1=X1+100

               GOTO DREC

 +3        LOCK -^PRC(424,AUDA,0)

 +4        FOR 

               LOCK +^PRC(424.1,+Y,0):1

              IF $TEST

                   QUIT 

 +5        SET DIE="^PRC(424.1,"

           SET DA=+Y

           SET 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"

           DO ^DIE

 +6        LOCK -^PRC(424.1,DA,0)

 +7        DO BALUP^PRCH58(PODA,BAL1)

 +8        QUIT