source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCARFD.m@ 738

Last change on this file since 738 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.4 KB
RevLine 
[613]1PRCARFD ;WASH-ISC@ALTOONA,PA/CMS-REFUND REVIEW AND APPROVE ;10/31/96 10:19 AM
2V ;;4.5;Accounts Receivable;**55,169,198**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;Review Prepayment and Sign Elec Sig
5 N DA,DIC,DIE,DIR,DN,DR,D0,OP,PRCA,PRCABN,PRCAIO,PRCASUP,PRCAT,RR,X,Y
6 N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
7EN1 S OP=+$O(^PRCA(430.3,"AC",112,0)),OP(1)=$P(^PRCA(430.3,+OP,0),U)
8 S RR=+$O(^PRCA(430.3,"AC",113,0)),RR(1)=$P($G(^PRCA(430.3,+RR,0)),U)
9 S D0=+$O(^PRCA(430.2,"AC",33,0)),D0(1)=$P(^PRCA(430.2,+D0,0),U)
10 I $D(^XUSEC("PRCAY PAYMENT SUP",DUZ)) S PRCASUP=DUZ
11 S DIC="^PRCA(430,",DIC("S")="I $P(^(0),U,2)="_D0_",($P(^(0),U,8)="_RR_"!($P(^(0),U,8)="_OP_"))",DIC(0)="AEQMZ" D ^DIC G:$G(Y)<1 EN1Q S PRCABN=+Y
12 I $P(^PRCA(430,PRCABN,9),U,2)]"",$$GSTAT^RCFMFN02("B"_+PRCABN)<0 W !!,"This bill has been APPROVED" D W !! G EN1
13 .S Y=$P($G(^PRCA(430,+PRCABN,9)),U,3) W " but an FMS document was NOT created " D
14 ..I Y D DD^%DT W !,"on ",Y," by ",$P($G(^VA(200,+$P(^PRCA(430,PRCABN,9),U),0)),U)
15 .S DIR(0)="Y",DIR("A")="Do you want to CREATE the document now" D ^DIR K DIR D:Y FMSDOC^PRCARFD1
16 I $P(^PRCA(430,PRCABN,7),U,21) W !!,*7,"This bill is ready for the Certifying Official's approval.",! D
17 .W !,"It has been reviewed by ",$P($G(^VA(200,+$P(^PRCA(430,PRCABN,7),U,21),0)),U),!
18 E W !!,"This bill has not been reviewed for approval yet.",!,"It must be signed by a refunder to be ",!,"ready for the Certifying Official's approval.",!
19 I $P(^PRCA(430,PRCABN,0),U,8)'=RR,'$G(PRCASUP) W !!,"AUTHORIZED FISCAL USER MUST CHANGE STATUS OF BILL TO 'REFUND REVIEW'",! G EN1
20 S DIR(0)="Y",DIR("A")="Do you want to review the prepayment bill at this time" D ^DIR K DIR G:$D(DIRUT) EN1Q
21 I Y D:$G(IO)']"" HOME^%ZIS S D0=PRCABN,PRCAIO=IO,PRCAIO(0)=IO(0) D PROC^PRCAPRO
22 I $P(^PRCA(430,PRCABN,0),U,8)'=RR S DIR(0)="Y",DIR("A")="Do you want to change the status to 'REFUND REVIEW' at this time" D ^DIR K DIR G:$D(DIRUT) EN1Q G:Y'=1 EN1 D RR(PRCABN) W !!,"Status Changed to 'REFUND REVIEW'",!
23 I $P(^PRCA(430,PRCABN,9),U,2)']"" K DIRUT S DIR(0)="Y",DIR("A")="Do you want to make any adjustments to the refund amount now" D ^DIR K DIR G:$D(DIRUT) EN1Q
24 I $P(^PRCA(430,PRCABN,9),U,2)']"",Y D G:$D(DIRUT) EN1Q
25 .K DIRUT S DIR(0)="S^I:INCREASE;D:DECREASE" D ^DIR K DIR Q:$D(DIRUT)
26 . I Y'="I",Y'="D" Q
27 . D ADJBILL^RCBEADJ($S(Y="I":"INCREASE",1:"DECREASE"),PRCABN)
28 . ; set refund fills and clear esigs
29 . ; 79.18 = refunded amount 90 = approved by
30 . ; 79.21 = refunded by 91 = ar elecronic signature
31 . ; 111 = approving official 112 = electronic signature
32 . N %,BALANCE,DATA7
33 . S DATA7=$G(^PRCA(430,PRCABN,7))
34 . S BALANCE=$P(DATA7,"^")+$P(DATA7,"^",2)+$P(DATA7,"^",3)+$P(DATA7,"^",4)+$P(DATA7,"^",5)
35 . S %=$$EDIT430^RCBEUBIL(PRCABN,"79.18////"_BALANCE_";90///@;79.21///@;91///@;111///@;112///@")
36 ;
37 ; bill is no longer in refund review (i.e. cancelled with a decrease)
38 I $P(^PRCA(430,PRCABN,0),"^",8)'=44 W !!,"Bill status is no longer REFUND REVIEW. It has changed to ",$P($G(^PRCA(430.3,+$P(^PRCA(430,PRCABN,0),"^",8),0)),"^"),".",! G EN1
39 ;
40 I $P($G(^PRCA(430,PRCABN,104)),U,2)="" S DIR(0)="Y",DIR("A")="Do you want to send the refund to the certifying official for approval now" D ^DIR K DIR G:$D(DIRUT) EN1Q G:Y'=1 EN1
41 I ($P($G(^(7)),U,21)=DUZ) W !!,"DUPLICATE AUTHORIZER!" G EN1
42 I '$G(PRCASUP),$P($G(^PRCA(430,PRCABN,104)),U,2)]"" W !!,"UNAUTHORIZED TO SIGN AS CERTIFYING OFFICER" G EN1
43 I '$G(PRCASUP) D EDTR G EN1
44 I $G(PRCASUP),$P($G(^PRCA(430,PRCABN,104)),U,2)="" D G:$D(DIRUT) EN1Q D:Y=1 EDTR G EN1
45 .S DIR("A")="Sign as the 'REFUNDED BY' person",DIR("A",1)="This refund must first be approved by the refunder.",DIR("A",2)="If you sign as the 'Refunded By' person, you CANNOT",DIR(0)="Y"
46 .S DIR("A",3)="sign as the Certifying Officer.",DIR("A",4)=" "
47 .D ^DIR K DIR
48 .Q
49 I $G(PRCASUP),$P($G(^PRCA(430,PRCABN,7)),U,21)]"" D APPRV^PRCARFD1 G EN1
50EN1Q Q
51 ;
52 ;
53EDTR ;Enter Elec sig for refunder
54 N DA,PRCANM,RA,X,Y
55 F X=1:1:5 S RA=+$G(RA)+$P($G(^PRCA(430,PRCABN,7)),U,X)
56 I +$G(RA)'=$P($G(^PRCA(430,PRCABN,7)),U,18) W !!,"REFUND AMOUNT OUT-OF-BALANCE!",! Q
57 S DA=+PRCABN D SIG^PRCASIG I $G(PRCANM)']"" W !!,"DID NOT APPROVE REFUND" Q
58 L +^PRCA(430,PRCABN):1 Q:'$T S $P(^PRCA(430,PRCABN,104),U,2)=PRCANM,$P(^PRCA(430,PRCABN,7),U,21)=DUZ,$P(^(7),U,19)=$G(DT) L -^PRCA(430,PRCABN) W !," <APPROVED BY REFUNDER>"
59 Q
60CANC(BN) ;Change status of prepay bill to CANCELLATION
61 N DA,DIE,DR
62 I $P(^PRCA(430,BN,7),U,1)>0 Q
63 S DA=BN,BN=+$O(^PRCA(430.3,"AC",111,0)),DIE="^PRCA(430,",DR="8////"_BN D ^DIE
64 Q
65RR(BN) ;Change status of prepay bill to REFUND REVIEW
66 N DA,DIE,DR,RA,X
67 F X=1:1:5 S RA=+$G(RA)+$P($G(^PRCA(430,BN,7)),U,X)
68 S DA=BN,BN=+$O(^PRCA(430.3,"AC",113,0)),DIE="^PRCA(430,",DR="8////"_BN_";79.18////"_RA_";90///@;79.21///@;91///@;111///@;112///@" D ^DIE
69 Q
70 ;
71DISP(PRCABN) ;Display refund approvals
72 N X,X1,X2,RA,Y
73 Q:$P(^PRCA(430,PRCABN,0),U,2)'=$O(^PRCA(430.2,"AC",33,0))
74 W !,"REFUND APPROVAL SIGNATURES"
75 S RA=+$P($G(^PRCA(430,PRCABN,7)),U,18) I 'RA F X=1:1:5 S RA=+$G(RA)+$P($G(^PRCA(430,PRCABN,7)),U,X)
76 S X=$P($G(^PRCA(430,PRCABN,9)),U,2) I X]"" S X1=+$P(^(9),U,1),X2=PRCABN_RA D DE^PRCASIG(.X,X1,X2) W !!,"Certifying Officer: ",X," Signed on: " S Y=+$P(^PRCA(430,PRCABN,9),U,3) I +$G(Y) X ^DD("DD") W Y,!
77 S X=$P($G(^PRCA(430,PRCABN,104)),U,2) I X]"" S X1=+$P(^(7),U,21),X2=PRCABN_RA D DE^PRCASIG(.X,X1,X2) W !!,"Reviewed By: ",X," Signed on: " S Y=+$P(^PRCA(430,PRCABN,7),U,19) I +$G(Y) X ^DD("DD") W Y,!
78 Q
Note: See TracBrowser for help on using the repository browser.