PRCPWI ;WISC/RFJ-increment/decrement due-ins/due-outs for a 2237 ;09 Sep 91
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
EN2 ; increment due-ins/due-outs and outstanding transactions
; da=internal entry number to 410
N %,TRAN,FORM,INVPT,VENDOR,WHSE,PRCPLI,ITEMDA,QTY,PRCPDATA,V,VENDATA,CONV
S:'$D(DA) DA=0 S TRAN=$G(^PRCS(410,+DA,0)),FORM=$P(TRAN,"^",4) I FORM<3 Q
S INVPT=$P(TRAN,"^",6) Q:'$D(^PRCP(445,+INVPT,0)) S VENDOR=+$P($G(^PRCS(410,DA,3)),"^",4)_";PRC(440," Q:+VENDOR=0
; get whse inv point for issue books (due-outs)
K WHSE I $P(TRAN,"^",4)=5 S %=0 F S %=$O(^PRCP(445,"AC","W",%)) Q:'% I +$G(^PRCP(445,+%,0))=$P(TRAN,"^",5) S WHSE=% Q
; loop items in transaction
W !!?4,"incrementing due-ins in inventory point: ",$P($$INVNAME^PRCPUX1(INVPT),"-",2,99)
I $D(WHSE) W !?4,"incrementing due-outs in inventory point: ",$P($$INVNAME^PRCPUX1(WHSE),"-",2,99)
S PRCPLI=0 F S PRCPLI=$O(^PRCS(410,DA,"IT",PRCPLI)) Q:'PRCPLI S PRCPDATA=$G(^(PRCPLI,0)),ITEMDA=+$P(PRCPDATA,"^",5),QTY=+$P(PRCPDATA,"^",2) I QTY>0 D
. ; increment due-outs if issue book request and warehouse inv point
. I $D(WHSE),$D(^PRCP(445,WHSE,1,ITEMDA,0)) D SETOUT^PRCPUDUE(WHSE,ITEMDA,QTY)
. ; increment due-ins
. I '$D(^PRCP(445,INVPT,1,ITEMDA,0)) Q
. S VENDATA=$$GETVEN^PRCPUVEN(INVPT,ITEMDA,VENDOR,1),QTY=QTY*$P(VENDATA,"^",4)
. S:'+$P(VENDATA,"^",2) $P(VENDATA,"^",2)=$P(PRCPDATA,"^",3) S:'+$P(VENDATA,"^",3) $P(VENDATA,"^",3)=1
. ; add/update outstanding transaction and due-ins
. D ADDUPD^PRCPUTRA(INVPT,ITEMDA,DA,QTY_"^"_$P(VENDATA,"^",2,4))
Q
;
;
EN3 ; decrement due-ins/due-outs and outstanding transactions
; for return to service
; da=internal entry number to 410
N %,TRAN,FORM,INVPT,VENDOR,WHSE,PRCPLI,ITEMDA,QTY,PRCPDATA
S:'$D(DA) DA=0 S TRAN=$G(^PRCS(410,+DA,0)),FORM=$P(TRAN,"^",4) I FORM<3 Q
S INVPT=$P(TRAN,"^",6) Q:'$D(^PRCP(445,+INVPT,0)) S VENDOR=+$P($G(^PRCS(410,DA,3)),"^",4)_";PRC(440," Q:+VENDOR=0
; get whse inv point for issue books (due-outs)
K WHSE I $P(TRAN,"^",4)=5 S %=0 F S %=$O(^PRCP(445,"AC","W",%)) Q:'% I +$G(^PRCP(445,+%,0))=$P(TRAN,"^",5) S WHSE=% Q
; loop items in transaction
W !!?4,"decrementing due-ins in inventory point: ",$P($$INVNAME^PRCPUX1(INVPT),"-",2,99)
I $D(WHSE) W !?4,"decrementing due-outs in inventory point: ",$P($$INVNAME^PRCPUX1(WHSE),"-",2,99)
S PRCPLI=0 F S PRCPLI=$O(^PRCS(410,DA,"IT",PRCPLI)) Q:'PRCPLI S PRCPDATA=$G(^(PRCPLI,0)),ITEMDA=+$P(PRCPDATA,"^",5),QTY=+$P(PRCPDATA,"^",2) I QTY>0 D
. ; decrement due-outs if issue book request and warehouse inv point
. I $D(WHSE),$D(^PRCP(445,WHSE,1,ITEMDA,0)) D SETOUT^PRCPUDUE(WHSE,ITEMDA,-QTY)
. ; decrement due-ins and kill outstanding transaction
. D KILLTRAN^PRCPUTRA(INVPT,ITEMDA,DA)
Q
;
;
SPLIT(INVPT,ITEMDA,OLDTRAN,TRANDA) ; split request (called from prchsp)
; oldtran=old trans da, tranda=new trans da
I '$D(^PRCP(445,+INVPT,1,+ITEMDA,7,+OLDTRAN,0)) Q
S %=$P(^PRCP(445,INVPT,1,ITEMDA,7,OLDTRAN,0),"^",2,5) D ADDTRAN^PRCPUTRA(INVPT,ITEMDA,TRANDA,%),KILLTRAN^PRCPUTRA(INVPT,ITEMDA,OLDTRAN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPWI 3183 printed Oct 16, 2024@18:17:21 Page 2
PRCPWI ;WISC/RFJ-increment/decrement due-ins/due-outs for a 2237 ;09 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 ;
EN2 ; increment due-ins/due-outs and outstanding transactions
+1 ; da=internal entry number to 410
+2 NEW %,TRAN,FORM,INVPT,VENDOR,WHSE,PRCPLI,ITEMDA,QTY,PRCPDATA,V,VENDATA,CONV
+3 if '$DATA(DA)
SET DA=0
SET TRAN=$GET(^PRCS(410,+DA,0))
SET FORM=$PIECE(TRAN,"^",4)
IF FORM<3
QUIT
+4 SET INVPT=$PIECE(TRAN,"^",6)
if '$DATA(^PRCP(445,+INVPT,0))
QUIT
SET VENDOR=+$PIECE($GET(^PRCS(410,DA,3)),"^",4)_";PRC(440,"
if +VENDOR=0
QUIT
+5 ; get whse inv point for issue books (due-outs)
+6 KILL WHSE
IF $PIECE(TRAN,"^",4)=5
SET %=0
FOR
SET %=$ORDER(^PRCP(445,"AC","W",%))
if '%
QUIT
IF +$GET(^PRCP(445,+%,0))=$PIECE(TRAN,"^",5)
SET WHSE=%
QUIT
+7 ; loop items in transaction
+8 WRITE !!?4,"incrementing due-ins in inventory point: ",$PIECE($$INVNAME^PRCPUX1(INVPT),"-",2,99)
+9 IF $DATA(WHSE)
WRITE !?4,"incrementing due-outs in inventory point: ",$PIECE($$INVNAME^PRCPUX1(WHSE),"-",2,99)
+10 SET PRCPLI=0
FOR
SET PRCPLI=$ORDER(^PRCS(410,DA,"IT",PRCPLI))
if 'PRCPLI
QUIT
SET PRCPDATA=$GET(^(PRCPLI,0))
SET ITEMDA=+$PIECE(PRCPDATA,"^",5)
SET QTY=+$PIECE(PRCPDATA,"^",2)
IF QTY>0
Begin DoDot:1
+11 ; increment due-outs if issue book request and warehouse inv point
+12 IF $DATA(WHSE)
IF $DATA(^PRCP(445,WHSE,1,ITEMDA,0))
DO SETOUT^PRCPUDUE(WHSE,ITEMDA,QTY)
+13 ; increment due-ins
+14 IF '$DATA(^PRCP(445,INVPT,1,ITEMDA,0))
QUIT
+15 SET VENDATA=$$GETVEN^PRCPUVEN(INVPT,ITEMDA,VENDOR,1)
SET QTY=QTY*$PIECE(VENDATA,"^",4)
+16 if '+$PIECE(VENDATA,"^",2)
SET $PIECE(VENDATA,"^",2)=$PIECE(PRCPDATA,"^",3)
if '+$PIECE(VENDATA,"^",3)
SET $PIECE(VENDATA,"^",3)=1
+17 ; add/update outstanding transaction and due-ins
+18 DO ADDUPD^PRCPUTRA(INVPT,ITEMDA,DA,QTY_"^"_$PIECE(VENDATA,"^",2,4))
End DoDot:1
+19 QUIT
+20 ;
+21 ;
EN3 ; decrement due-ins/due-outs and outstanding transactions
+1 ; for return to service
+2 ; da=internal entry number to 410
+3 NEW %,TRAN,FORM,INVPT,VENDOR,WHSE,PRCPLI,ITEMDA,QTY,PRCPDATA
+4 if '$DATA(DA)
SET DA=0
SET TRAN=$GET(^PRCS(410,+DA,0))
SET FORM=$PIECE(TRAN,"^",4)
IF FORM<3
QUIT
+5 SET INVPT=$PIECE(TRAN,"^",6)
if '$DATA(^PRCP(445,+INVPT,0))
QUIT
SET VENDOR=+$PIECE($GET(^PRCS(410,DA,3)),"^",4)_";PRC(440,"
if +VENDOR=0
QUIT
+6 ; get whse inv point for issue books (due-outs)
+7 KILL WHSE
IF $PIECE(TRAN,"^",4)=5
SET %=0
FOR
SET %=$ORDER(^PRCP(445,"AC","W",%))
if '%
QUIT
IF +$GET(^PRCP(445,+%,0))=$PIECE(TRAN,"^",5)
SET WHSE=%
QUIT
+8 ; loop items in transaction
+9 WRITE !!?4,"decrementing due-ins in inventory point: ",$PIECE($$INVNAME^PRCPUX1(INVPT),"-",2,99)
+10 IF $DATA(WHSE)
WRITE !?4,"decrementing due-outs in inventory point: ",$PIECE($$INVNAME^PRCPUX1(WHSE),"-",2,99)
+11 SET PRCPLI=0
FOR
SET PRCPLI=$ORDER(^PRCS(410,DA,"IT",PRCPLI))
if 'PRCPLI
QUIT
SET PRCPDATA=$GET(^(PRCPLI,0))
SET ITEMDA=+$PIECE(PRCPDATA,"^",5)
SET QTY=+$PIECE(PRCPDATA,"^",2)
IF QTY>0
Begin DoDot:1
+12 ; decrement due-outs if issue book request and warehouse inv point
+13 IF $DATA(WHSE)
IF $DATA(^PRCP(445,WHSE,1,ITEMDA,0))
DO SETOUT^PRCPUDUE(WHSE,ITEMDA,-QTY)
+14 ; decrement due-ins and kill outstanding transaction
+15 DO KILLTRAN^PRCPUTRA(INVPT,ITEMDA,DA)
End DoDot:1
+16 QUIT
+17 ;
+18 ;
SPLIT(INVPT,ITEMDA,OLDTRAN,TRANDA) ; split request (called from prchsp)
+1 ; oldtran=old trans da, tranda=new trans da
+2 IF '$DATA(^PRCP(445,+INVPT,1,+ITEMDA,7,+OLDTRAN,0))
QUIT
+3 SET %=$PIECE(^PRCP(445,INVPT,1,ITEMDA,7,OLDTRAN,0),"^",2,5)
DO ADDTRAN^PRCPUTRA(INVPT,ITEMDA,TRANDA,%)
DO KILLTRAN^PRCPUTRA(INVPT,ITEMDA,OLDTRAN)
+4 QUIT
