source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFWCAP.m@ 1141

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

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1PRCFWCAP ;WISC/RFJ-enter supply fund cap into file 420 ;3/18/93 1:52 PM
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5ENTERCAP(DATA) ;enter supply fund cap into file 420
6 ;%=inventoryvalue^dueinvalue ;if piece="" do nothing to value in piece
7 ;if $d(error), unable to enter cap
8 K ERROR N DIC,DIE,DR,D0,DA,OLDATA,X,Y
9 I '$D(^PRC(420,+$G(PRC("SITE")),0)) S ERROR=1 Q
10 S OLDATA=$P(^PRC(420,+$G(PRC("SITE")),0),"^",4,6),(DIC,DIE)="^PRC(420,",DA=PRC("SITE"),DR=$S($P(DATA,"^")'="":"5///"_$J($P(DATA,"^"),0,2)_";",1:"")_$S($P(DATA,"^",2)'="":"6///"_$J($P(DATA,"^",2),0,2)_";",1:"") D ^DIE
11 I '$D(Y) S %=$G(^PRC(420,+DA,0)),%=$P(%,"^",3)-$P(%,"^",4)-$P(%,"^",5),DR="7///"_%_";" D ^DIE
12 I $D(Y) S DR="5////"_$P(OLDATA,"^")_";6////"_$P(OLDATA,"^",2)_";7////"_$P(OLDATA,"^",3)_";" D ^DIE S ERROR=1
13 Q
14 ;
15ADDCAP(DATA) ;add cap to current values
16 ;%=inventoryvalue^dueinvalue ;if piece="" do nothing to value in piece
17 ;add inv value or due-in and update cap available ;$d(error) if unable to add/enter cap
18 K ERROR N %,X,Y I '$D(^PRC(420,+$G(PRC("SITE")),0)) Q
19 L +^PRC(420,+$G(PRC("SITE")),0):10 I '$T S ERROR="UNABLE TO UPDATE SUPPLY FUND CAP" Q
20 S %=$P(^PRC(420,+$G(PRC("SITE")),0),"^",4,5),X=$P(%,"^")+$P(DATA,"^"),Y=$P(%,"^",2)+$P(DATA,"^",2) S:X<0 X=0 S:Y<0 Y=0 D ENTERCAP(X_"^"_Y) L -^PRC(420,+$G(PRC("SITE")),0)
21 Q
Note: See TracBrowser for help on using the repository browser.