source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPUDUE.m@ 619

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

initial load of WorldVistAEHR

File size: 970 bytes
Line 
1PRCPUDUE ;WISC/RFJ-duein,duout utilities ;20 Sep 91
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7GETOUT(INVPT,ITEMDA) ; return dueout quantity for invpt item
8 Q +$P($G(^PRCP(445,INVPT,1,ITEMDA,"DUE")),"^",2)
9 ;
10 ;
11GETIN(INVPT,ITEMDA) ; return duein quantity for invpt item
12 Q +$P($G(^PRCP(445,INVPT,1,ITEMDA,"DUE")),"^")
13 ;
14 ;
15SETOUT(INVPT,ITEMDA,QTY) ; add qty to dueout qty
16 I '$D(^PRCP(445,INVPT,1,ITEMDA,0)) Q
17 I 'QTY Q
18 L +^PRCP(445,INVPT,1,ITEMDA,"DUE")
19 S QTY=QTY+$$GETOUT(INVPT,ITEMDA) I QTY<0 S QTY=0
20 S $P(^PRCP(445,INVPT,1,ITEMDA,"DUE"),"^",2)=QTY
21 L -^PRCP(445,INVPT,1,ITEMDA,"DUE")
22 Q
23 ;
24 ;
25SETIN(INVPT,ITEMDA,QTY) ; add qty to duein qty
26 I '$D(^PRCP(445,INVPT,1,ITEMDA,0)) Q
27 I 'QTY Q
28 L +^PRCP(445,INVPT,1,ITEMDA,"DUE")
29 S QTY=QTY+$$GETIN(INVPT,ITEMDA) I QTY<0 S QTY=0
30 S $P(^PRCP(445,INVPT,1,ITEMDA,"DUE"),"^")=QTY
31 L -^PRCP(445,INVPT,1,ITEMDA,"DUE")
32 Q
Note: See TracBrowser for help on using the repository browser.