PRCFARRD ;WISC@ALTOONA/CTB-ROUTINE TO DISPLAY FMS RECEIVING REPORT TRANSACTION ;6/23/95 14:44
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
D HILO^PRCFQ
LOAD Q:'$D(^TMP("PRCFARR",$J)) N X,X5,X8 S X=$G(^TMP("PRCFARR",$J,1,0))
I '$D(PRCFPO) N PRCFPO S PRCFPO=$G(PRCFA("PODA"))
S X5=$G(^TMP("PRCFARR",$J,5,0))
S C(1)="RR" ; Transaction Type
S C(2)=$P(X,U,6) ; Transaction Date
S C(3)=$P(X,U,3)_"-"_$P(X,U,4)_"-"_$P(X,U,5) ; Obligation Number
S C(4)=$P(X5,U,11) ; Liquidation Code
N BOC,FMSLN,I,L,LNO I +$G(PRCFPO) D
. S I=0 F S I=$O(^PRC(442,PRCFPO,22,"B",I)) Q:I="" S LNO="" D
. . S LNO=$O(^PRC(442,PRCFPO,22,"B",I,LNO)) Q:LNO=""
. . S FMSLN=$P($G(^PRC(442,PRCFPO,22,LNO,0)),U,3)
. . S FMSLN="000"_FMSLN,L=$L(FMSLN),FMSLN=$E(FMSLN,L-2,L)
. . S BOC(FMSLN)=I
. . Q
. Q
I $D(BOC(991)),$D(PRCFPO) S BOC(991)=$P($G(^PRC(442,PRCFPO,23)),U,1)
SE S $P(SP," ",20)=""
W @IOF,!,IOINLOW,$E(SP,1,15),"OBLIGATION NUMBER: ",IOINHI,C(3),IOINLOW," PARTIAL #: ",IOINHI W:$D(PRCFA("PARTIAL")) PRCFA("PARTIAL")
I $D(PO(11)) S XX=$P(PO(11),"^",12) I XX]"" W !!,IOINLOW,$E(SP,1,10),"TOTAL AMOUNT OF RECEIVING REPORT: ",IOINHI,"$",$FN(XX,",",2) K XX
W !!,IOINLOW,"TRANSACTION TYPE: ",IOINHI,C(1),IOINLOW,$E(SP,1,5),"TRANSACTION DATE: ",IOINHI,C(2),IOINLOW," REF #: ",IOINHI,C(3)
W !,IOINLOW,$E(SP,1,7),"LIQ. CODE: ",IOINHI,$E(C(4)_" ",1,4),!
N J,K S J=7,K=8
F S J=$O(^TMP("PRCFARR",$J,J)) Q:+J'=J D G:K["^" EXIT
. S X8=$G(^TMP("PRCFARR",$J,J,0)) Q:$P(X8,U)'=8
. I K+3>IOSL R:$E(IOST,1,2)="C-" !," ** More ** Hit <Return> to Continue, Enter '^' to Exit ",K:DTIME Q:K["^" W @IOF S K=1
. W !,IOINLOW,"Item #: ",IOINHI,$J($P(X8,U,3),4)
. W IOINLOW," FMS Line #: ",IOINHI,$E($P(X8,U,2)_" ",1,3)
. W IOINLOW," BOC: ",IOINHI,$G(BOC($P(X8,U,2)))
. W IOINLOW," FMS Amount: ",IOINHI,$J($FN($P(X8,U,10)/100,",",2),14)
. ;W IOINLOW," Liq. Amount: ",IOINHI,$FN($P(X8,U,4)/100,"",2)
. S K=K+1
. Q
EXIT K SP W ! I IOST'["C-Q" W IOINLOW K C,IOINLOW,IOINHI
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFARRD 2069 printed Sep 23, 2025@19:38:38 Page 2
PRCFARRD ;WISC@ALTOONA/CTB-ROUTINE TO DISPLAY FMS RECEIVING REPORT TRANSACTION ;6/23/95 14:44
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 DO HILO^PRCFQ
LOAD if '$DATA(^TMP("PRCFARR",$JOB))
QUIT
NEW X,X5,X8
SET X=$GET(^TMP("PRCFARR",$JOB,1,0))
+1 IF '$DATA(PRCFPO)
NEW PRCFPO
SET PRCFPO=$GET(PRCFA("PODA"))
+2 SET X5=$GET(^TMP("PRCFARR",$JOB,5,0))
+3 ; Transaction Type
SET C(1)="RR"
+4 ; Transaction Date
SET C(2)=$PIECE(X,U,6)
+5 ; Obligation Number
SET C(3)=$PIECE(X,U,3)_"-"_$PIECE(X,U,4)_"-"_$PIECE(X,U,5)
+6 ; Liquidation Code
SET C(4)=$PIECE(X5,U,11)
+7 NEW BOC,FMSLN,I,L,LNO
IF +$GET(PRCFPO)
Begin DoDot:1
+8 SET I=0
FOR
SET I=$ORDER(^PRC(442,PRCFPO,22,"B",I))
if I=""
QUIT
SET LNO=""
Begin DoDot:2
+9 SET LNO=$ORDER(^PRC(442,PRCFPO,22,"B",I,LNO))
if LNO=""
QUIT
+10 SET FMSLN=$PIECE($GET(^PRC(442,PRCFPO,22,LNO,0)),U,3)
+11 SET FMSLN="000"_FMSLN
SET L=$LENGTH(FMSLN)
SET FMSLN=$EXTRACT(FMSLN,L-2,L)
+12 SET BOC(FMSLN)=I
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 IF $DATA(BOC(991))
IF $DATA(PRCFPO)
SET BOC(991)=$PIECE($GET(^PRC(442,PRCFPO,23)),U,1)
SE SET $PIECE(SP," ",20)=""
+1 WRITE @IOF,!,IOINLOW,$EXTRACT(SP,1,15),"OBLIGATION NUMBER: ",IOINHI,C(3),IOINLOW," PARTIAL #: ",IOINHI
if $DATA(PRCFA("PARTIAL"))
WRITE PRCFA("PARTIAL")
+2 IF $DATA(PO(11))
SET XX=$PIECE(PO(11),"^",12)
IF XX]""
WRITE !!,IOINLOW,$EXTRACT(SP,1,10),"TOTAL AMOUNT OF RECEIVING REPORT: ",IOINHI,"$",$FNUMBER(XX,",",2)
KILL XX
+3 WRITE !!,IOINLOW,"TRANSACTION TYPE: ",IOINHI,C(1),IOINLOW,$EXTRACT(SP,1,5),"TRANSACTION DATE: ",IOINHI,C(2),IOINLOW," REF #: ",IOINHI,C(3)
+4 WRITE !,IOINLOW,$EXTRACT(SP,1,7),"LIQ. CODE: ",IOINHI,$EXTRACT(C(4)_" ",1,4),!
+5 NEW J,K
SET J=7
SET K=8
+6 FOR
SET J=$ORDER(^TMP("PRCFARR",$JOB,J))
if +J'=J
QUIT
Begin DoDot:1
+7 SET X8=$GET(^TMP("PRCFARR",$JOB,J,0))
if $PIECE(X8,U)'=8
QUIT
+8 IF K+3>IOSL
if $EXTRACT(IOST,1,2)="C-"
READ !," ** More ** Hit <Return> to Continue, Enter '^' to Exit ",K:DTIME
if K["^"
QUIT
WRITE @IOF
SET K=1
+9 WRITE !,IOINLOW,"Item #: ",IOINHI,$JUSTIFY($PIECE(X8,U,3),4)
+10 WRITE IOINLOW," FMS Line #: ",IOINHI,$EXTRACT($PIECE(X8,U,2)_" ",1,3)
+11 WRITE IOINLOW," BOC: ",IOINHI,$GET(BOC($PIECE(X8,U,2)))
+12 WRITE IOINLOW," FMS Amount: ",IOINHI,$JUSTIFY($FNUMBER($PIECE(X8,U,10)/100,",",2),14)
+13 ;W IOINLOW," Liq. Amount: ",IOINHI,$FN($P(X8,U,4)/100,"",2)
+14 SET K=K+1
+15 QUIT
End DoDot:1
if K["^"
GOTO EXIT
EXIT KILL SP
WRITE !
IF IOST'["C-Q"
WRITE IOINLOW
KILL C,IOINLOW,IOINHI
+1 QUIT
