PRCARFD2 ;WASH-ISC@ALTOONA,PA/LDB-GENERATE FMS DOC ;10/19/94 3:36 PM
V ;;4.5;Accounts Receivable;**204,198**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;;
TRANS ;TRANSMIT A REFUND (OVERCOLLECTION) DOC
N DIC,PRCABN,PRCABN0,REF,U,REFMS
N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
S U="^",REF=$O(^PRCA(430.3,"AC",120,0))
S D0=+$O(^PRCA(430.2,"AC",33,0)),D0(1)=$P(^PRCA(430.2,+D0,0),U)
S DIC="^PRCA(430,",DIC("S")="I $P(^(0),U,2)="_D0_",$P(^(0),U,8)="_REF,DIC(0)="AEQMZ" D ^DIC Q:Y<0 S PRCABN=+Y
I $P(^PRCA(430,PRCABN,9),U,2)="" W !,"THIS BILL HAS NOT BEEN APPROVED!" Q
I '$D(^PRCA(430,+$G(PRCABN),0)) W !,"THIS BILL NUMBER ENTRY IN FILE 430 IS CORRUPTED",!,"NO PROCESSING CAN CONTINUE - SEE IRM" Q
S PRCABN0=^(0),PRCANM=$P($G(^PRCA(430,+PRCABN,0)),U)
S STAT=$$GSTAT^RCFMFN02("B"_PRCABN)
I STAT<0 W !,"THIS DOCUMENT IS EITHER NOT READY FOR FMS OR HAS ALREADY BEEN ACCEPTED." Q
I STAT'=3 W !!,*7,"THIS DOCUMENT SEEMS TO HAVE ALREADY BEEN SENT TO FMS-",!,"IT CANNOT BE RESENT UNLESS FMS REJECTS IT." Q
D DEL^RCFMFN02("B"_PRCABN) S REFMS=1 D FMS^PRCARFD1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCARFD2 1123 printed Dec 13, 2024@01:41:10 Page 2
PRCARFD2 ;WASH-ISC@ALTOONA,PA/LDB-GENERATE FMS DOC ;10/19/94 3:36 PM
V ;;4.5;Accounts Receivable;**204,198**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;;
TRANS ;TRANSMIT A REFUND (OVERCOLLECTION) DOC
+1 NEW DIC,PRCABN,PRCABN0,REF,U,REFMS
+2 NEW DPTNOFZY,DPTNOFZK
SET (DPTNOFZY,DPTNOFZK)=1
+3 SET U="^"
SET REF=$ORDER(^PRCA(430.3,"AC",120,0))
+4 SET D0=+$ORDER(^PRCA(430.2,"AC",33,0))
SET D0(1)=$PIECE(^PRCA(430.2,+D0,0),U)
+5 SET DIC="^PRCA(430,"
SET DIC("S")="I $P(^(0),U,2)="_D0_",$P(^(0),U,8)="_REF
SET DIC(0)="AEQMZ"
DO ^DIC
if Y<0
QUIT
SET PRCABN=+Y
+6 IF $PIECE(^PRCA(430,PRCABN,9),U,2)=""
WRITE !,"THIS BILL HAS NOT BEEN APPROVED!"
QUIT
+7 IF '$DATA(^PRCA(430,+$GET(PRCABN),0))
WRITE !,"THIS BILL NUMBER ENTRY IN FILE 430 IS CORRUPTED",!,"NO PROCESSING CAN CONTINUE - SEE IRM"
QUIT
+8 SET PRCABN0=^(0)
SET PRCANM=$PIECE($GET(^PRCA(430,+PRCABN,0)),U)
+9 SET STAT=$$GSTAT^RCFMFN02("B"_PRCABN)
+10 IF STAT<0
WRITE !,"THIS DOCUMENT IS EITHER NOT READY FOR FMS OR HAS ALREADY BEEN ACCEPTED."
QUIT
+11 IF STAT'=3
WRITE !!,*7,"THIS DOCUMENT SEEMS TO HAVE ALREADY BEEN SENT TO FMS-",!,"IT CANNOT BE RESENT UNLESS FMS REJECTS IT."
QUIT
+12 DO DEL^RCFMFN02("B"_PRCABN)
SET REFMS=1
DO FMS^PRCARFD1
+13 QUIT
