- 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 Jan 18, 2025@03:17:48 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