PRCPUDUE ;WISC/RFJ-duein,duout utilities ;20 Sep 91
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
GETOUT(INVPT,ITEMDA) ; return dueout quantity for invpt item
Q +$P($G(^PRCP(445,INVPT,1,ITEMDA,"DUE")),"^",2)
;
;
GETIN(INVPT,ITEMDA) ; return duein quantity for invpt item
Q +$P($G(^PRCP(445,INVPT,1,ITEMDA,"DUE")),"^")
;
;
SETOUT(INVPT,ITEMDA,QTY) ; add qty to dueout qty
I '$D(^PRCP(445,INVPT,1,ITEMDA,0)) Q
I 'QTY Q
L +^PRCP(445,INVPT,1,ITEMDA,"DUE")
S QTY=QTY+$$GETOUT(INVPT,ITEMDA) I QTY<0 S QTY=0
S $P(^PRCP(445,INVPT,1,ITEMDA,"DUE"),"^",2)=QTY
L -^PRCP(445,INVPT,1,ITEMDA,"DUE")
Q
;
;
SETIN(INVPT,ITEMDA,QTY) ; add qty to duein qty
I '$D(^PRCP(445,INVPT,1,ITEMDA,0)) Q
I 'QTY Q
L +^PRCP(445,INVPT,1,ITEMDA,"DUE")
S QTY=QTY+$$GETIN(INVPT,ITEMDA) I QTY<0 S QTY=0
S $P(^PRCP(445,INVPT,1,ITEMDA,"DUE"),"^")=QTY
L -^PRCP(445,INVPT,1,ITEMDA,"DUE")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPUDUE 1002 printed Dec 13, 2024@02:16:08 Page 2
PRCPUDUE ;WISC/RFJ-duein,duout utilities ;20 Sep 91
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
GETOUT(INVPT,ITEMDA) ; return dueout quantity for invpt item
+1 QUIT +$PIECE($GET(^PRCP(445,INVPT,1,ITEMDA,"DUE")),"^",2)
+2 ;
+3 ;
GETIN(INVPT,ITEMDA) ; return duein quantity for invpt item
+1 QUIT +$PIECE($GET(^PRCP(445,INVPT,1,ITEMDA,"DUE")),"^")
+2 ;
+3 ;
SETOUT(INVPT,ITEMDA,QTY) ; add qty to dueout qty
+1 IF '$DATA(^PRCP(445,INVPT,1,ITEMDA,0))
QUIT
+2 IF 'QTY
QUIT
+3 LOCK +^PRCP(445,INVPT,1,ITEMDA,"DUE")
+4 SET QTY=QTY+$$GETOUT(INVPT,ITEMDA)
IF QTY<0
SET QTY=0
+5 SET $PIECE(^PRCP(445,INVPT,1,ITEMDA,"DUE"),"^",2)=QTY
+6 LOCK -^PRCP(445,INVPT,1,ITEMDA,"DUE")
+7 QUIT
+8 ;
+9 ;
SETIN(INVPT,ITEMDA,QTY) ; add qty to duein qty
+1 IF '$DATA(^PRCP(445,INVPT,1,ITEMDA,0))
QUIT
+2 IF 'QTY
QUIT
+3 LOCK +^PRCP(445,INVPT,1,ITEMDA,"DUE")
+4 SET QTY=QTY+$$GETIN(INVPT,ITEMDA)
IF QTY<0
SET QTY=0
+5 SET $PIECE(^PRCP(445,INVPT,1,ITEMDA,"DUE"),"^")=QTY
+6 LOCK -^PRCP(445,INVPT,1,ITEMDA,"DUE")
+7 QUIT
