- PRCPOPEE ;WISC/RFJ-edit distribution order items ;27 Sep 93
- ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;
- ;
- EDIT ; edit distribution order
- D FULL^VALM1
- S VALMBCK="R"
- D ITEMS(ORDERDA)
- D INIT^PRCPOPL
- Q
- ;
- ;
- ITEMS(ORDERDA) ; edit items on distribution order orderda
- I '$D(^PRCP(445.3,ORDERDA,0)) Q
- N AFTERQTY,BEFORQTY,CONV,ITEMDA,PRIMITEM,PRCPORD,SECOITEM,UNITCOST,UNITR,VDATA
- D VARIABLE^PRCPOPU
- ;
- F S ITEMDA=+$$ITEMSEL^PRCPOPUS(ORDERDA,PRCPPRIM,1) Q:'ITEMDA D
- . ;
- . ; show inventory data
- . S PRIMITEM=^PRCP(445,PRCPPRIM,1,ITEMDA,0)
- . S UNITCOST=+$P(PRIMITEM,"^",22) I $P(PRIMITEM,"^",15)>UNITCOST S UNITCOST=+$P(PRIMITEM,"^",15)
- . ;
- . W !!,"Data for PRIMARY inventory point: ",$P(PRCPORD(0),"^",2)
- . W !?5,"Quantity On-Hand: ",+$P(PRIMITEM,"^",7),?40,"Unit per Issue: ",$$UNIT^PRCPUX1(PRCPPRIM,ITEMDA," per ")
- . W !?5,"Quantity Due-Out: ",$$GETOUT^PRCPUDUE(PRCPPRIM,ITEMDA),!?5,"Quantity Due-In : ",$$GETIN^PRCPUDUE(PRCPPRIM,ITEMDA),!?12,"Unit Cost: ",UNITCOST
- . I $P(PRIMITEM,"^",25) W !?2,"Required Issue Mult: ",$P(PRIMITEM,"^",25)
- . I $P(PRIMITEM,"^",17) W !?4,"Minimum Issue Qty: ",$P(PRIMITEM,"^",17)
- . ;
- . S SECOITEM=$G(^PRCP(445,PRCPSECO,1,ITEMDA,0))
- . W !!,"Data for SECONDARY inventory point: ",$P(PRCPORD(0),"^",3)
- . I SECOITEM="" S CONV=1 W !?5,"ITEM NOT STORED IN SECONDARY INVENTORY POINT",!
- . ;
- . I SECOITEM'="" D
- . . W !?5,"Quantity On-Hand: ",+$P(SECOITEM,"^",7),?40,"Unit per Issue: ",$$UNIT^PRCPUX1(PRCPSECO,ITEMDA," per ")
- . . S VDATA=$$GETVEN^PRCPUVEN(PRCPSECO,ITEMDA,PRCPPRIM_";PRCP(445,",1),UNITR=$$UNITVAL^PRCPUX1(+$P(VDATA,"^",3),$P(VDATA,"^",2)," per "),CONV=$P(VDATA,"^",4)
- . . W !?5,"Quantity Due-In : ",$$GETIN^PRCPUDUE(PRCPSECO,ITEMDA),?40,"Unit per Recpt: ",UNITR,!?37,"Conversion Factor: ",CONV
- . ;
- . ; enter data
- . I '$P(^PRCP(445.3,ORDERDA,1,ITEMDA,0),"^",3) S $P(^(0),"^",3)=UNITCOST
- . S BEFORQTY=+$P(^PRCP(445.3,ORDERDA,1,ITEMDA,0),"^",2)
- . D ITEMEDIT^PRCPOPUS(ORDERDA,ITEMDA,0)
- . S AFTERQTY=+$P(^PRCP(445.3,ORDERDA,1,ITEMDA,0),"^",2)
- . ;
- . ; if status is released and beginning qty '= current qty
- . ; update dueins and dueouts
- . I $P(PRCPORD(0),"^",6)'="",BEFORQTY'=AFTERQTY D DUEOUTIN^PRCPOPU(PRCPPRIM,PRCPSECO,ITEMDA,$S(AFTERQTY<0:0,1:AFTERQTY)-BEFORQTY,1)
- . ;
- . I AFTERQTY=0 D DELITEM^PRCPOPD(ORDERDA,ITEMDA) W !!,"** ITEM HAS BEEN DELETED FROM THE ORDER **" Q
- . I AFTERQTY>0,AFTERQTY<$P(PRIMITEM,"^",17) W !,"WARNING -- THE QUANTITY IS LESS THAN THE MINIMUM ISSUE QUANTITY"
- . I $P(PRIMITEM,"^",25)>0 S %=AFTERQTY/$P(PRIMITEM,"^",25) I $P(%,".",2)>0 W !,"WARNING -- THE QUANTITY IS NOT A CORRECT REQUIRED ISSUE MULTIPLE"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPOPEE 2824 printed Feb 18, 2025@23:40:34 Page 2
- PRCPOPEE ;WISC/RFJ-edit distribution order items ;27 Sep 93
- +1 ;;5.1;IFCAP;;Oct 20, 2000
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ;
- EDIT ; edit distribution order
- +1 DO FULL^VALM1
- +2 SET VALMBCK="R"
- +3 DO ITEMS(ORDERDA)
- +4 DO INIT^PRCPOPL
- +5 QUIT
- +6 ;
- +7 ;
- ITEMS(ORDERDA) ; edit items on distribution order orderda
- +1 IF '$DATA(^PRCP(445.3,ORDERDA,0))
- QUIT
- +2 NEW AFTERQTY,BEFORQTY,CONV,ITEMDA,PRIMITEM,PRCPORD,SECOITEM,UNITCOST,UNITR,VDATA
- +3 DO VARIABLE^PRCPOPU
- +4 ;
- +5 FOR
- SET ITEMDA=+$$ITEMSEL^PRCPOPUS(ORDERDA,PRCPPRIM,1)
- if 'ITEMDA
- QUIT
- Begin DoDot:1
- +6 ;
- +7 ; show inventory data
- +8 SET PRIMITEM=^PRCP(445,PRCPPRIM,1,ITEMDA,0)
- +9 SET UNITCOST=+$PIECE(PRIMITEM,"^",22)
- IF $PIECE(PRIMITEM,"^",15)>UNITCOST
- SET UNITCOST=+$PIECE(PRIMITEM,"^",15)
- +10 ;
- +11 WRITE !!,"Data for PRIMARY inventory point: ",$PIECE(PRCPORD(0),"^",2)
- +12 WRITE !?5,"Quantity On-Hand: ",+$PIECE(PRIMITEM,"^",7),?40,"Unit per Issue: ",$$UNIT^PRCPUX1(PRCPPRIM,ITEMDA," per ")
- +13 WRITE !?5,"Quantity Due-Out: ",$$GETOUT^PRCPUDUE(PRCPPRIM,ITEMDA),!?5,"Quantity Due-In : ",$$GETIN^PRCPUDUE(PRCPPRIM,ITEMDA),!?12,"Unit Cost: ",UNITCOST
- +14 IF $PIECE(PRIMITEM,"^",25)
- WRITE !?2,"Required Issue Mult: ",$PIECE(PRIMITEM,"^",25)
- +15 IF $PIECE(PRIMITEM,"^",17)
- WRITE !?4,"Minimum Issue Qty: ",$PIECE(PRIMITEM,"^",17)
- +16 ;
- +17 SET SECOITEM=$GET(^PRCP(445,PRCPSECO,1,ITEMDA,0))
- +18 WRITE !!,"Data for SECONDARY inventory point: ",$PIECE(PRCPORD(0),"^",3)
- +19 IF SECOITEM=""
- SET CONV=1
- WRITE !?5,"ITEM NOT STORED IN SECONDARY INVENTORY POINT",!
- +20 ;
- +21 IF SECOITEM'=""
- Begin DoDot:2
- +22 WRITE !?5,"Quantity On-Hand: ",+$PIECE(SECOITEM,"^",7),?40,"Unit per Issue: ",$$UNIT^PRCPUX1(PRCPSECO,ITEMDA," per ")
- +23 SET VDATA=$$GETVEN^PRCPUVEN(PRCPSECO,ITEMDA,PRCPPRIM_";PRCP(445,",1)
- SET UNITR=$$UNITVAL^PRCPUX1(+$PIECE(VDATA,"^",3),$PIECE(VDATA,"^",2)," per ")
- SET CONV=$PIECE(VDATA,"^",4)
- +24 WRITE !?5,"Quantity Due-In : ",$$GETIN^PRCPUDUE(PRCPSECO,ITEMDA),?40,"Unit per Recpt: ",UNITR,!?37,"Conversion Factor: ",CONV
- End DoDot:2
- +25 ;
- +26 ; enter data
- +27 IF '$PIECE(^PRCP(445.3,ORDERDA,1,ITEMDA,0),"^",3)
- SET $PIECE(^(0),"^",3)=UNITCOST
- +28 SET BEFORQTY=+$PIECE(^PRCP(445.3,ORDERDA,1,ITEMDA,0),"^",2)
- +29 DO ITEMEDIT^PRCPOPUS(ORDERDA,ITEMDA,0)
- +30 SET AFTERQTY=+$PIECE(^PRCP(445.3,ORDERDA,1,ITEMDA,0),"^",2)
- +31 ;
- +32 ; if status is released and beginning qty '= current qty
- +33 ; update dueins and dueouts
- +34 IF $PIECE(PRCPORD(0),"^",6)'=""
- IF BEFORQTY'=AFTERQTY
- DO DUEOUTIN^PRCPOPU(PRCPPRIM,PRCPSECO,ITEMDA,$SELECT(AFTERQTY<0:0,1:AFTERQTY)-BEFORQTY,1)
- +35 ;
- +36 IF AFTERQTY=0
- DO DELITEM^PRCPOPD(ORDERDA,ITEMDA)
- WRITE !!,"** ITEM HAS BEEN DELETED FROM THE ORDER **"
- QUIT
- +37 IF AFTERQTY>0
- IF AFTERQTY<$PIECE(PRIMITEM,"^",17)
- WRITE !,"WARNING -- THE QUANTITY IS LESS THAN THE MINIMUM ISSUE QUANTITY"
- +38 IF $PIECE(PRIMITEM,"^",25)>0
- SET %=AFTERQTY/$PIECE(PRIMITEM,"^",25)
- IF $PIECE(%,".",2)>0
- WRITE !,"WARNING -- THE QUANTITY IS NOT A CORRECT REQUIRED ISSUE MULTIPLE"
- End DoDot:1
- +39 QUIT
