- 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 Feb 18, 2025@23:28:57 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
