PRCFWCAP ;WISC/RFJ-enter supply fund cap into file 420 ;3/18/93 1:52 PM
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
ENTERCAP(DATA) ;enter supply fund cap into file 420
;%=inventoryvalue^dueinvalue ;if piece="" do nothing to value in piece
;if $d(error), unable to enter cap
K ERROR N DIC,DIE,DR,D0,DA,OLDATA,X,Y
I '$D(^PRC(420,+$G(PRC("SITE")),0)) S ERROR=1 Q
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
I '$D(Y) S %=$G(^PRC(420,+DA,0)),%=$P(%,"^",3)-$P(%,"^",4)-$P(%,"^",5),DR="7///"_%_";" D ^DIE
I $D(Y) S DR="5////"_$P(OLDATA,"^")_";6////"_$P(OLDATA,"^",2)_";7////"_$P(OLDATA,"^",3)_";" D ^DIE S ERROR=1
Q
;
ADDCAP(DATA) ;add cap to current values
;%=inventoryvalue^dueinvalue ;if piece="" do nothing to value in piece
;add inv value or due-in and update cap available ;$d(error) if unable to add/enter cap
K ERROR N %,X,Y I '$D(^PRC(420,+$G(PRC("SITE")),0)) Q
L +^PRC(420,+$G(PRC("SITE")),0):10 I '$T S ERROR="UNABLE TO UPDATE SUPPLY FUND CAP" Q
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)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFWCAP 1391 printed Dec 13, 2024@02:04:33 Page 2
PRCFWCAP ;WISC/RFJ-enter supply fund cap into file 420 ;3/18/93 1:52 PM
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
ENTERCAP(DATA) ;enter supply fund cap into file 420
+1 ;%=inventoryvalue^dueinvalue ;if piece="" do nothing to value in piece
+2 ;if $d(error), unable to enter cap
+3 KILL ERROR
NEW DIC,DIE,DR,D0,DA,OLDATA,X,Y
+4 IF '$DATA(^PRC(420,+$GET(PRC("SITE")),0))
SET ERROR=1
QUIT
+5 SET OLDATA=$PIECE(^PRC(420,+$GET(PRC("SITE")),0),"^",4,6)
SET (DIC,DIE)="^PRC(420,"
SET DA=PRC("SITE")
SET DR=$SELECT($PIECE(DATA,"^")'="":"5///"_$JUSTIFY($PIECE(DATA,"^"),0,2)_";",1:"")_$SELECT($PIECE(DATA,"^",2)'="":"6///"_$JUSTIFY($PIECE(DATA,"^",2),0,2)_";",1:"")
DO ^DIE
+6 IF '$DATA(Y)
SET %=$GET(^PRC(420,+DA,0))
SET %=$PIECE(%,"^",3)-$PIECE(%,"^",4)-$PIECE(%,"^",5)
SET DR="7///"_%_";"
DO ^DIE
+7 IF $DATA(Y)
SET DR="5////"_$PIECE(OLDATA,"^")_";6////"_$PIECE(OLDATA,"^",2)_";7////"_$PIECE(OLDATA,"^",3)_";"
DO ^DIE
SET ERROR=1
+8 QUIT
+9 ;
ADDCAP(DATA) ;add cap to current values
+1 ;%=inventoryvalue^dueinvalue ;if piece="" do nothing to value in piece
+2 ;add inv value or due-in and update cap available ;$d(error) if unable to add/enter cap
+3 KILL ERROR
NEW %,X,Y
IF '$DATA(^PRC(420,+$GET(PRC("SITE")),0))
QUIT
+4 LOCK +^PRC(420,+$GET(PRC("SITE")),0):10
IF '$TEST
SET ERROR="UNABLE TO UPDATE SUPPLY FUND CAP"
QUIT
+5 SET %=$PIECE(^PRC(420,+$GET(PRC("SITE")),0),"^",4,5)
SET X=$PIECE(%,"^")+$PIECE(DATA,"^")
SET Y=$PIECE(%,"^",2)+$PIECE(DATA,"^",2)
if X<0
SET X=0
if Y<0
SET Y=0
DO ENTERCAP(X_"^"_Y)
LOCK -^PRC(420,+$GET(PRC("SITE")),0)
+6 QUIT
