source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCEOB1.m@ 1365

Last change on this file since 1365 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1PRCEOB1 ;WISC/CTB/CLH-SUBROUTINES FOR PRCEOB ;2/10/92 10:58 AM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4SCREEN D HILO^PRCFQ,SW,SC Q
5 Q
6SW ;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 ;
12SC ;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
Note: See TracBrowser for help on using the repository browser.