PRCFA924.m

PRCFA924 ;WISC@ALTOONA/CTB-ROUTINE TO DISPLAY 924.00 RECEIVING REPORT TRANSACTION ;10 Sep 89/3:08 PM

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(^PRCF(423,DA))  S X=^PRCF(423,DA,0),X1=^(1)

 S C(1)=$P(X,U,4),C(2)=$P(X,U,5),C(3)=$P(X,U,6)

 S C(4)=$P(X1,U,12),C(5)=$P(X1,U,8),C(6)=$P(X1,U,9),C(7)=$P(X1,U,13),C(8)=$P(X1,U,10),C(9)=$P(X1,U,11),C(10)=$P(X1,U,14)

 K X,X1

SE S $P(SP," ",80)=""

 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 AMT OF RECEIVING REPORT: ",IOINHI,$J(XX,0,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),!,IOINLOW,"   BOC 1: ",IOINHI,C(5),IOINLOW,$E(SP,1,3),"AMOUNT 1: ",IOINHI,$E(C(6)_$E(SP,1,13),1,13),IOINLOW,"  LIQ. AMOUNT 1: ",IOINHI,C(7)

 W !,IOINLOW,"   BOC 2: ",IOINHI,$E(C(8)_"    ",1,4),IOINLOW,"   AMOUNT 2: ",IOINHI,$E(C(9)_$E(SP,1,13),1,13),IOINLOW,"  LIQ. AMOUNT 2: ",IOINHI,C(10)

 K SP I IOST'["C-Q" W IOINLOW K C,IOINLOW,IOINHI

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCFA924   1285     printed  Feb 18, 2025@23:28:08                                                                                                                                                                                                    Page 2

PRCFA924  ;WISC@ALTOONA/CTB-ROUTINE TO DISPLAY 924.00 RECEIVING REPORT TRANSACTION ;10 Sep 89/3:08 PM

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(^PRCF(423,DA))

               QUIT 

           SET X=^PRCF(423,DA,0)

           SET X1=^(1)

 +1        SET C(1)=$PIECE(X,U,4)

           SET C(2)=$PIECE(X,U,5)

           SET C(3)=$PIECE(X,U,6)

 +2        SET C(4)=$PIECE(X1,U,12)

           SET C(5)=$PIECE(X1,U,8)

           SET C(6)=$PIECE(X1,U,9)

           SET C(7)=$PIECE(X1,U,13)

           SET C(8)=$PIECE(X1,U,10)

           SET C(9)=$PIECE(X1,U,11)

           SET C(10)=$PIECE(X1,U,14)

 +3        KILL X,X1

SE         SET $PIECE(SP," ",80)=""

 +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 AMT OF RECEIVING REPORT: ",IOINHI,$JUSTIFY(XX,0,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),!,IOINLOW,"   BOC 1: ",IOINHI,C(5),IOINLOW,$EXTRACT(SP,1,3),"AMOUNT 1: ",IOINHI,$EXTRACT(C(6)_$EXTRACT(SP,1,13),1,13),IOINLOW,"  LIQ. AMOUNT 1: ",IOINHI,C(7)

 +5        WRITE !,IOINLOW,"   BOC 2: ",IOINHI,$EXTRACT(C(8)_"    ",1,4),IOINLOW,"   AMOUNT 2: ",IOINHI,$EXTRACT(C(9)_$EXTRACT(SP,1,13),1,13),IOINLOW,"  LIQ. AMOUNT 2: ",IOINHI,C(10)

 +6        KILL SP

           IF IOST'["C-Q"

               WRITE IOINLOW

               KILL C,IOINLOW,IOINHI