1 | PRCEOB1 ;WISC/CTB/CLH-SUBROUTINES FOR PRCEOB ;2/10/92 10:58 AM
|
---|
2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | SCREEN D HILO^PRCFQ,SW,SC Q
|
---|
5 | Q
|
---|
6 | SW ;SWITCH BOCS IF NECESSARY
|
---|
7 | F I=6:1:9 S @("S"_I)=$P(TRNODE(3),"^",I)
|
---|
8 | I S8=0!(S9=0) S S8="",S9=""
|
---|
9 | I S6=0!(S7=0) S S6=S8,S7=S9,S8="",S9=""
|
---|
10 | S $P(TRNODE(3),"^",6,9)=S6_"^"_S7_"^"_S8_"^"_S9 K S6,S7,S8,S9 Q
|
---|
11 | ;
|
---|
12 | SC ;DISPLAY SCREEN
|
---|
13 | W @IOF,!?15,"1358 TRANSACTION - ",IOINHI,$P(TRNODE(0),"^"),IOINLOW
|
---|
14 | W !!," COST CENTER: ",IOINHI,+$P(TRNODE(3),"^",3),IOINLOW,?IOM-4\2,"AMOUNT: ",IOINHI,"$ ",$J($P(TRNODE(4),"^"),0,2)
|
---|
15 | W !!,IOINLOW,"BOC #1: ",IOINHI,+$P(TRNODE(3),"^",6),IOINLOW,?IOM-10\2,"AMOUNT #1: ",IOINHI,"$ "_$J($P(TRNODE(3),"^",7),0,2)
|
---|
16 | 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)
|
---|
17 | 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))
|
---|
18 | D ^DIWW,DIWKILL^PRCFQ W IOINORM Q
|
---|
19 | S $P(^PRC(424,DA,0),"^",2,14)=X,DIK="^PRC(424," D IX1^DIK K DIK S %=1 Q
|
---|