PRCARFD ;WASH-ISC@ALTOONA,PA/CMS-REFUND REVIEW AND APPROVE ;10/31/96 10:19 AM
V ;;4.5;Accounts Receivable;**55,169,198**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;Review Prepayment and Sign Elec Sig
N DA,DIC,DIE,DIR,DN,DR,D0,OP,PRCA,PRCABN,PRCAIO,PRCASUP,PRCAT,RR,X,Y
N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
EN1 S OP=+$O(^PRCA(430.3,"AC",112,0)),OP(1)=$P(^PRCA(430.3,+OP,0),U)
S RR=+$O(^PRCA(430.3,"AC",113,0)),RR(1)=$P($G(^PRCA(430.3,+RR,0)),U)
S D0=+$O(^PRCA(430.2,"AC",33,0)),D0(1)=$P(^PRCA(430.2,+D0,0),U)
I $D(^XUSEC("PRCAY PAYMENT SUP",DUZ)) S PRCASUP=DUZ
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
I $P(^PRCA(430,PRCABN,9),U,2)]"",$$GSTAT^RCFMFN02("B"_+PRCABN)<0 W !!,"This bill has been APPROVED" D W !! G EN1
.S Y=$P($G(^PRCA(430,+PRCABN,9)),U,3) W " but an FMS document was NOT created " D
..I Y D DD^%DT W !,"on ",Y," by ",$P($G(^VA(200,+$P(^PRCA(430,PRCABN,9),U),0)),U)
.S DIR(0)="Y",DIR("A")="Do you want to CREATE the document now" D ^DIR K DIR D:Y FMSDOC^PRCARFD1
I $P(^PRCA(430,PRCABN,7),U,21) W !!,*7,"This bill is ready for the Certifying Official's approval.",! D
.W !,"It has been reviewed by ",$P($G(^VA(200,+$P(^PRCA(430,PRCABN,7),U,21),0)),U),!
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.",!
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
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
I Y D:$G(IO)']"" HOME^%ZIS S D0=PRCABN,PRCAIO=IO,PRCAIO(0)=IO(0) D PROC^PRCAPRO
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'",!
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
I $P(^PRCA(430,PRCABN,9),U,2)']"",Y D G:$D(DIRUT) EN1Q
.K DIRUT S DIR(0)="S^I:INCREASE;D:DECREASE" D ^DIR K DIR Q:$D(DIRUT)
. I Y'="I",Y'="D" Q
. D ADJBILL^RCBEADJ($S(Y="I":"INCREASE",1:"DECREASE"),PRCABN)
. ; set refund fills and clear esigs
. ; 79.18 = refunded amount 90 = approved by
. ; 79.21 = refunded by 91 = ar elecronic signature
. ; 111 = approving official 112 = electronic signature
. N %,BALANCE,DATA7
. S DATA7=$G(^PRCA(430,PRCABN,7))
. S BALANCE=$P(DATA7,"^")+$P(DATA7,"^",2)+$P(DATA7,"^",3)+$P(DATA7,"^",4)+$P(DATA7,"^",5)
. S %=$$EDIT430^RCBEUBIL(PRCABN,"79.18////"_BALANCE_";90///@;79.21///@;91///@;111///@;112///@")
;
; bill is no longer in refund review (i.e. cancelled with a decrease)
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
;
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
I ($P($G(^(7)),U,21)=DUZ) W !!,"DUPLICATE AUTHORIZER!" G EN1
I '$G(PRCASUP),$P($G(^PRCA(430,PRCABN,104)),U,2)]"" W !!,"UNAUTHORIZED TO SIGN AS CERTIFYING OFFICER" G EN1
I '$G(PRCASUP) D EDTR G EN1
I $G(PRCASUP),$P($G(^PRCA(430,PRCABN,104)),U,2)="" D G:$D(DIRUT) EN1Q D:Y=1 EDTR G EN1
.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"
.S DIR("A",3)="sign as the Certifying Officer.",DIR("A",4)=" "
.D ^DIR K DIR
.Q
I $G(PRCASUP),$P($G(^PRCA(430,PRCABN,7)),U,21)]"" D APPRV^PRCARFD1 G EN1
EN1Q Q
;
;
EDTR ;Enter Elec sig for refunder
N DA,PRCANM,RA,X,Y
F X=1:1:5 S RA=+$G(RA)+$P($G(^PRCA(430,PRCABN,7)),U,X)
I +$G(RA)'=$P($G(^PRCA(430,PRCABN,7)),U,18) W !!,"REFUND AMOUNT OUT-OF-BALANCE!",! Q
S DA=+PRCABN D SIG^PRCASIG I $G(PRCANM)']"" W !!,"DID NOT APPROVE REFUND" Q
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>"
Q
CANC(BN) ;Change status of prepay bill to CANCELLATION
N DA,DIE,DR
I $P(^PRCA(430,BN,7),U,1)>0 Q
S DA=BN,BN=+$O(^PRCA(430.3,"AC",111,0)),DIE="^PRCA(430,",DR="8////"_BN D ^DIE
Q
RR(BN) ;Change status of prepay bill to REFUND REVIEW
N DA,DIE,DR,RA,X
F X=1:1:5 S RA=+$G(RA)+$P($G(^PRCA(430,BN,7)),U,X)
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
Q
;
DISP(PRCABN) ;Display refund approvals
N X,X1,X2,RA,Y
Q:$P(^PRCA(430,PRCABN,0),U,2)'=$O(^PRCA(430.2,"AC",33,0))
W !,"REFUND APPROVAL SIGNATURES"
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)
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,!
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,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCARFD 5605 printed Oct 16, 2024@17:42 Page 2
PRCARFD ;WASH-ISC@ALTOONA,PA/CMS-REFUND REVIEW AND APPROVE ;10/31/96 10:19 AM
V ;;4.5;Accounts Receivable;**55,169,198**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;Review Prepayment and Sign Elec Sig
+3 NEW DA,DIC,DIE,DIR,DN,DR,D0,OP,PRCA,PRCABN,PRCAIO,PRCASUP,PRCAT,RR,X,Y
+4 NEW DPTNOFZY,DPTNOFZK
SET (DPTNOFZY,DPTNOFZK)=1
EN1 SET OP=+$ORDER(^PRCA(430.3,"AC",112,0))
SET OP(1)=$PIECE(^PRCA(430.3,+OP,0),U)
+1 SET RR=+$ORDER(^PRCA(430.3,"AC",113,0))
SET RR(1)=$PIECE($GET(^PRCA(430.3,+RR,0)),U)
+2 SET D0=+$ORDER(^PRCA(430.2,"AC",33,0))
SET D0(1)=$PIECE(^PRCA(430.2,+D0,0),U)
+3 IF $DATA(^XUSEC("PRCAY PAYMENT SUP",DUZ))
SET PRCASUP=DUZ
+4 SET DIC="^PRCA(430,"
SET DIC("S")="I $P(^(0),U,2)="_D0_",($P(^(0),U,8)="_RR_"!($P(^(0),U,8)="_OP_"))"
SET DIC(0)="AEQMZ"
DO ^DIC
if $GET(Y)<1
GOTO EN1Q
SET PRCABN=+Y
+5 IF $PIECE(^PRCA(430,PRCABN,9),U,2)]""
IF $$GSTAT^RCFMFN02("B"_+PRCABN)<0
WRITE !!,"This bill has been APPROVED"
Begin DoDot:1
+6 SET Y=$PIECE($GET(^PRCA(430,+PRCABN,9)),U,3)
WRITE " but an FMS document was NOT created "
Begin DoDot:2
+7 IF Y
DO DD^%DT
WRITE !,"on ",Y," by ",$PIECE($GET(^VA(200,+$PIECE(^PRCA(430,PRCABN,9),U),0)),U)
End DoDot:2
+8 SET DIR(0)="Y"
SET DIR("A")="Do you want to CREATE the document now"
DO ^DIR
KILL DIR
if Y
DO FMSDOC^PRCARFD1
End DoDot:1
WRITE !!
GOTO EN1
+9 IF $PIECE(^PRCA(430,PRCABN,7),U,21)
WRITE !!,*7,"This bill is ready for the Certifying Official's approval.",!
Begin DoDot:1
+10 WRITE !,"It has been reviewed by ",$PIECE($GET(^VA(200,+$PIECE(^PRCA(430,PRCABN,7),U,21),0)),U),!
End DoDot:1
+11 IF '$TEST
WRITE !!,"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.",!
+12 IF $PIECE(^PRCA(430,PRCABN,0),U,8)'=RR
IF '$GET(PRCASUP)
WRITE !!,"AUTHORIZED FISCAL USER MUST CHANGE STATUS OF BILL TO 'REFUND REVIEW'",!
GOTO EN1
+13 SET DIR(0)="Y"
SET DIR("A")="Do you want to review the prepayment bill at this time"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EN1Q
+14 IF Y
if $GET(IO)']""
DO HOME^%ZIS
SET D0=PRCABN
SET PRCAIO=IO
SET PRCAIO(0)=IO(0)
DO PROC^PRCAPRO
+15 IF $PIECE(^PRCA(430,PRCABN,0),U,8)'=RR
SET DIR(0)="Y"
SET DIR("A")="Do you want to change the status to 'REFUND REVIEW' at this time"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EN1Q
if Y'=1
GOTO EN1
DO RR(PRCABN)
WRITE !!,"Status Changed to 'REFUND REVIEW'",!
+16 IF $PIECE(^PRCA(430,PRCABN,9),U,2)']""
KILL DIRUT
SET DIR(0)="Y"
SET DIR("A")="Do you want to make any adjustments to the refund amount now"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EN1Q
+17 IF $PIECE(^PRCA(430,PRCABN,9),U,2)']""
IF Y
Begin DoDot:1
+18 KILL DIRUT
SET DIR(0)="S^I:INCREASE;D:DECREASE"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+19 IF Y'="I"
IF Y'="D"
QUIT
+20 DO ADJBILL^RCBEADJ($SELECT(Y="I":"INCREASE",1:"DECREASE"),PRCABN)
+21 ; set refund fills and clear esigs
+22 ; 79.18 = refunded amount 90 = approved by
+23 ; 79.21 = refunded by 91 = ar elecronic signature
+24 ; 111 = approving official 112 = electronic signature
+25 NEW %,BALANCE,DATA7
+26 SET DATA7=$GET(^PRCA(430,PRCABN,7))
+27 SET BALANCE=$PIECE(DATA7,"^")+$PIECE(DATA7,"^",2)+$PIECE(DATA7,"^",3)+$PIECE(DATA7,"^",4)+$PIECE(DATA7,"^",5)
+28 SET %=$$EDIT430^RCBEUBIL(PRCABN,"79.18////"_BALANCE_";90///@;79.21///@;91///@;111///@;112///@")
End DoDot:1
if $DATA(DIRUT)
GOTO EN1Q
+29 ;
+30 ; bill is no longer in refund review (i.e. cancelled with a decrease)
+31 IF $PIECE(^PRCA(430,PRCABN,0),"^",8)'=44
WRITE !!,"Bill status is no longer REFUND REVIEW. It has changed to ",$PIECE($GET(^PRCA(430.3,+$PIECE(^PRCA(430,PRCABN,0),"^",8),0)),"^"),".",!
GOTO EN1
+32 ;
+33 IF $PIECE($GET(^PRCA(430,PRCABN,104)),U,2)=""
SET DIR(0)="Y"
SET DIR("A")="Do you want to send the refund to the certifying official for approval now"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EN1Q
if Y'=1
GOTO EN1
+34 IF ($PIECE($GET(^(7)),U,21)=DUZ)
WRITE !!,"DUPLICATE AUTHORIZER!"
GOTO EN1
+35 IF '$GET(PRCASUP)
IF $PIECE($GET(^PRCA(430,PRCABN,104)),U,2)]""
WRITE !!,"UNAUTHORIZED TO SIGN AS CERTIFYING OFFICER"
GOTO EN1
+36 IF '$GET(PRCASUP)
DO EDTR
GOTO EN1
+37 IF $GET(PRCASUP)
IF $PIECE($GET(^PRCA(430,PRCABN,104)),U,2)=""
Begin DoDot:1
+38 SET DIR("A")="Sign as the 'REFUNDED BY' person"
SET DIR("A",1)="This refund must first be approved by the refunder."
SET DIR("A",2)="If you sign as the 'Refunded By' person, you CANNOT"
SET DIR(0)="Y"
+39 SET DIR("A",3)="sign as the Certifying Officer."
SET DIR("A",4)=" "
+40 DO ^DIR
KILL DIR
+41 QUIT
End DoDot:1
if $DATA(DIRUT)
GOTO EN1Q
if Y=1
DO EDTR
GOTO EN1
+42 IF $GET(PRCASUP)
IF $PIECE($GET(^PRCA(430,PRCABN,7)),U,21)]""
DO APPRV^PRCARFD1
GOTO EN1
EN1Q QUIT
+1 ;
+2 ;
EDTR ;Enter Elec sig for refunder
+1 NEW DA,PRCANM,RA,X,Y
+2 FOR X=1:1:5
SET RA=+$GET(RA)+$PIECE($GET(^PRCA(430,PRCABN,7)),U,X)
+3 IF +$GET(RA)'=$PIECE($GET(^PRCA(430,PRCABN,7)),U,18)
WRITE !!,"REFUND AMOUNT OUT-OF-BALANCE!",!
QUIT
+4 SET DA=+PRCABN
DO SIG^PRCASIG
IF $GET(PRCANM)']""
WRITE !!,"DID NOT APPROVE REFUND"
QUIT
+5 LOCK +^PRCA(430,PRCABN):1
if '$TEST
QUIT
SET $PIECE(^PRCA(430,PRCABN,104),U,2)=PRCANM
SET $PIECE(^PRCA(430,PRCABN,7),U,21)=DUZ
SET $PIECE(^(7),U,19)=$GET(DT)
LOCK -^PRCA(430,PRCABN)
WRITE !," <APPROVED BY REFUNDER>"
+6 QUIT
CANC(BN) ;Change status of prepay bill to CANCELLATION
+1 NEW DA,DIE,DR
+2 IF $PIECE(^PRCA(430,BN,7),U,1)>0
QUIT
+3 SET DA=BN
SET BN=+$ORDER(^PRCA(430.3,"AC",111,0))
SET DIE="^PRCA(430,"
SET DR="8////"_BN
DO ^DIE
+4 QUIT
RR(BN) ;Change status of prepay bill to REFUND REVIEW
+1 NEW DA,DIE,DR,RA,X
+2 FOR X=1:1:5
SET RA=+$GET(RA)+$PIECE($GET(^PRCA(430,BN,7)),U,X)
+3 SET DA=BN
SET BN=+$ORDER(^PRCA(430.3,"AC",113,0))
SET DIE="^PRCA(430,"
SET DR="8////"_BN_";79.18////"_RA_";90///@;79.21///@;91///@;111///@;112///@"
DO ^DIE
+4 QUIT
+5 ;
DISP(PRCABN) ;Display refund approvals
+1 NEW X,X1,X2,RA,Y
+2 if $PIECE(^PRCA(430,PRCABN,0),U,2)'=$ORDER(^PRCA(430.2,"AC",33,0))
QUIT
+3 WRITE !,"REFUND APPROVAL SIGNATURES"
+4 SET RA=+$PIECE($GET(^PRCA(430,PRCABN,7)),U,18)
IF 'RA
FOR X=1:1:5
SET RA=+$GET(RA)+$PIECE($GET(^PRCA(430,PRCABN,7)),U,X)
+5 SET X=$PIECE($GET(^PRCA(430,PRCABN,9)),U,2)
IF X]""
SET X1=+$PIECE(^(9),U,1)
SET X2=PRCABN_RA
DO DE^PRCASIG(.X,X1,X2)
WRITE !!,"Certifying Officer: ",X," Signed on: "
SET Y=+$PIECE(^PRCA(430,PRCABN,9),U,3)
IF +$GET(Y)
XECUTE ^DD("DD")
WRITE Y,!
+6 SET X=$PIECE($GET(^PRCA(430,PRCABN,104)),U,2)
IF X]""
SET X1=+$PIECE(^(7),U,21)
SET X2=PRCABN_RA
DO DE^PRCASIG(.X,X1,X2)
WRITE !!,"Reviewed By: ",X," Signed on: "
SET Y=+$PIECE(^PRCA(430,PRCABN,7),U,19)
IF +$GET(Y)
XECUTE ^DD("DD")
WRITE Y,!
+7 QUIT
