PRCPUDUE.m

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 ---PRCPUDUE   1002     printed  Apr 09, 2024@21:17:20                                                                                                                                                                                                    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