- PRCAPTR ;WASH-ISC@ALTOONA,PA/RGY-Print PENDING TRANSACTION ;8/25/93 9:11 AM
- V ;;4.5;Accounts Receivable;;Mar 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- NEW PRCAE,X0,X1,CNT,TOTAL
- S (CNT,TOTAL)=0
- W:$E(IOST)="C" @IOF D HDR
- F PRCAE=0:0 S PRCAE=$O(^PRCA(433,"AE",1,PRCAE)),X="" Q:'PRCAE D TOP:$Y+5>IOSL Q:X="^" D:$P(^PRCA(433,PRCAE,0),"^",4)=2 PRNTL
- I X'="^" W:$Y+5>IOSL @IOF W !?69,"----------",!?60,"TOTAL:",?69,$J(TOTAL,10,2),!?60,"COUNT:",?69,$J(CNT,10,2) W:CNT !?60,"MEAN:",?69,$J(TOTAL/CNT,10,2)
- W:$E(IOST)="P" @IOF Q
- TOP ;
- I $E(IOST)="C" S X="" R !,"Press return to continue: ",X:DTIME S:'$T X="^" G:X="^" Q2
- W @IOF D HDR
- Q2 Q
- PRNTL ;
- S X0=$G(^PRCA(433,PRCAE,0)),X1=$G(^(1)) W !,+X0,?9,$P($G(^PRCA(430,+$P(X0,"^",2),0)),"^")
- W ?22 S Y=+X1 D DT W ?37,$E($P($G(^PRCA(430.2,+$P($G(^PRCA(430,+$P(X0,"^",2),0)),"^",2),0)),"^"),1,15),?55,$E($P($G(^PRCA(430.3,+$P(X1,"^",2),0)),"^"),1,10),?69,$J($P(X1,"^",5),10,2)
- S CNT=CNT+1,TOTAL=TOTAL+$P(X1,"^",5)
- Q
- HDR ;
- W !,"Pending Transaction List",!,"Date Printed: " S Y=DT D DT
- W !!,"Tran. #",?9,"Bill #",?22,"Tran. Date",?37,"Category",?55,"Type",?73,"Amount",!
- S X="",$P(X,"-",IOM)="" W X,!
- Q
- DT I Y W $P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,$E(Y,4,5))_" " W:Y#100 $J(Y#100\1,2)_"," W Y\10000+1700 W:Y#1 " "_$E(Y_0,9,10)_":"_$E(Y_"000",11,12) Q
- Q
- TSK ;
- NEW ZTSK
- S %ZIS="MQ" D ^%ZIS G:POP Q1
- I '$D(IO("Q")) U IO D PRCAPTR U IO(0) G Q1
- S ZTRTN="^PRCAPTR",ZTDESC="Print Pending Transaction List" D ^%ZTLOAD
- Q1 D ^%ZISC K POP Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAPTR 1571 printed Mar 13, 2025@20:45:43 Page 2
- PRCAPTR ;WASH-ISC@ALTOONA,PA/RGY-Print PENDING TRANSACTION ;8/25/93 9:11 AM
- V ;;4.5;Accounts Receivable;;Mar 20, 1995
- +1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 NEW PRCAE,X0,X1,CNT,TOTAL
- +3 SET (CNT,TOTAL)=0
- +4 if $EXTRACT(IOST)="C"
- WRITE @IOF
- DO HDR
- +5 FOR PRCAE=0:0
- SET PRCAE=$ORDER(^PRCA(433,"AE",1,PRCAE))
- SET X=""
- if 'PRCAE
- QUIT
- if $Y+5>IOSL
- DO TOP
- if X="^"
- QUIT
- if $PIECE(^PRCA(433,PRCAE,0),"^",4)=2
- DO PRNTL
- +6 IF X'="^"
- if $Y+5>IOSL
- WRITE @IOF
- WRITE !?69,"----------",!?60,"TOTAL:",?69,$JUSTIFY(TOTAL,10,2),!?60,"COUNT:",?69,$JUSTIFY(CNT,10,2)
- if CNT
- WRITE !?60,"MEAN:",?69,$JUSTIFY(TOTAL/CNT,10,2)
- +7 if $EXTRACT(IOST)="P"
- WRITE @IOF
- QUIT
- TOP ;
- +1 IF $EXTRACT(IOST)="C"
- SET X=""
- READ !,"Press return to continue: ",X:DTIME
- if '$TEST
- SET X="^"
- if X="^"
- GOTO Q2
- +2 WRITE @IOF
- DO HDR
- Q2 Press return to continue: QUIT
- PRNTL ;
- +1 SET X0=$GET(^PRCA(433,PRCAE,0))
- SET X1=$GET(^(1))
- WRITE !,+X0,?9,$PIECE($GET(^PRCA(430,+$PIECE(X0,"^",2),0)),"^")
- +2 WRITE ?22
- SET Y=+X1
- DO DT
- WRITE ?37,$EXTRACT($PIECE($GET(^PRCA(430.2,+$PIECE($GET(^PRCA(430,+$PIECE(X0,"^",2),0)),"^",2),0)),"^"),1,15),?55,$EXTRACT($PIECE($GET(^PRCA(430.3,+$PIECE(X1,"^",2),0)),"^"),1,10),?69,$JUSTIFY($PIECE(X1,"^",5),10,2)
- +3 SET CNT=CNT+1
- SET TOTAL=TOTAL+$PIECE(X1,"^",5)
- +4 QUIT
- HDR ;
- +1 WRITE !,"Pending Transaction List",!,"Date Printed: "
- SET Y=DT
- DO DT
- +2 WRITE !!,"Tran. #",?9,"Bill #",?22,"Tran. Date",?37,"Category",?55,"Type",?73,"Amount",!
- +3 SET X=""
- SET $PIECE(X,"-",IOM)=""
- WRITE X,!
- +4 QUIT
- DT IF Y
- WRITE $PIECE("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,$EXTRACT(Y,4,5))_" "
- if Y#100
- WRITE $JUSTIFY(Y#100\1,2)_","
- WRITE Y\10000+1700
- if Y#1
- WRITE " "_$EXTRACT(Y_0,9,10)_":"_$EXTRACT(Y_"000",11,12)
- QUIT
- +1 QUIT
- TSK ;
- +1 NEW ZTSK
- +2 SET %ZIS="MQ"
- DO ^%ZIS
- if POP
- GOTO Q1
- +3 IF '$DATA(IO("Q"))
- USE IO
- DO PRCAPTR
- USE IO(0)
- GOTO Q1
- +4 SET ZTRTN="^PRCAPTR"
- SET ZTDESC="Print Pending Transaction List"
- DO ^%ZTLOAD
- Q1 DO ^%ZISC
- KILL POP
- QUIT
