PRCEOB1 ;WISC/CTB/CLH-SUBROUTINES FOR PRCEOB ;2/10/92  10:58 AM
V ;;5.1;IFCAP;;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
SCREEN D HILO^PRCFQ,SW,SC Q
 Q
SW ;SWITCH BOCS IF NECESSARY
 F I=6:1:9 S @("S"_I)=$P(TRNODE(3),"^",I)
 I S8=0!(S9=0) S S8="",S9=""
 I S6=0!(S7=0) S S6=S8,S7=S9,S8="",S9=""
 S $P(TRNODE(3),"^",6,9)=S6_"^"_S7_"^"_S8_"^"_S9 K S6,S7,S8,S9 Q
 ;
SC ;DISPLAY SCREEN
 W @IOF,!?15,"1358 TRANSACTION - ",IOINHI,$P(TRNODE(0),"^"),IOINLOW
 W !!,"  COST CENTER: ",IOINHI,+$P(TRNODE(3),"^",3),IOINLOW,?IOM-4\2,"AMOUNT: ",IOINHI,"$ ",$J($P(TRNODE(4),"^"),0,2)
 W !!,IOINLOW,"BOC #1: ",IOINHI,+$P(TRNODE(3),"^",6),IOINLOW,?IOM-10\2,"AMOUNT #1: ",IOINHI,"$ "_$J($P(TRNODE(3),"^",7),0,2)
 I $P(TRNODE(3),"^",8,9)'="^" W !!,IOINLOW,"BOC #2: ",IOINHI,+$P(TRNODE(3),"^",8),?IOM-10\2,IOINLOW,"AMOUNT #2: ",IOINHI,"$ "_$J($P(TRNODE(3),"^",9),0,2)
 W IOINORM Q:'$D(^PRCS(410,PRCFA("TRDA"),8,0))#2  W !!,IOINHI K ^UTILITY($J,"W") S DIWF="W",DIWL=1,DIWR=IOM*.75\1,N=0 F I=1:1 S N=$O(^PRCS(410,PRCFA("TRDA"),8,N)) Q:'N  S X=^(N,0) D DIWP^PRCUTL($G(DA))
 D ^DIWW,DIWKILL^PRCFQ W IOINORM Q
 S $P(^PRC(424,DA,0),"^",2,14)=X,DIK="^PRC(424," D IX1^DIK K DIK S %=1 Q