PRCPWPL0 ;WISC/RFJ-whse post issue book (options) ;13 Jan 94
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
EEITEMS ; called from protocol file to enter/edit invpt items
D FULL^VALM1
N PRC,PRCP
S PRCP("DPTYPE")="WP"
D ^PRCPEILM
D REBUILD^PRCPWPLB
S VALMBCK="R"
Q
;
;
SHOWNSN ; show nsn on list
S PRCPFNSN=$S($G(PRCPFNSN):0,1:1)
D REBUILD^PRCPWPLB
S ^DISV(DUZ,"PRCPWPLM","SHOWNSN")=PRCPFNSN
S VALMSG=$S(PRCPFNSN:"SHOW NSN",1:"DO NOT SHOW NSN")
S VALMBCK="R"
Q
;
;
REMAIN ; set qty to post to remaining (outstanding) qty
D FULL^VALM1
S VALMBCK="R"
N DATA,ITEMDA,LINEDA,QTY,X
K X S X(1)="This option will set the QUANTITY TO POST equal to the QUANTITY REMAINing (same as quantity outstanding). The QUANTITY REMAINing is equal to the QUANTITY ORDERED minus the QUANTITY POSTED previously."
D DISPLAY^PRCPUX2(5,75,.X)
S XP="Do you want to set the QUANTITY TO POST equal to QUANTITY REMAINing",XH="Enter YES to set the QUANTITY TO POST equal to the QUANTITY REMAINing,",XH(1)=" NO or ^ to return to the posting list."
I $$YN^PRCPUYN(1)'=1 Q
S LINEDA=0 F S LINEDA=$O(^TMP($J,"PRCPWPLMLIST",LINEDA)) Q:'LINEDA S DATA=^(LINEDA) D
. S ITEMDA=+$P(DATA,"^"),QTY=+$P(DATA,"^",2)
. I QTY<0 S QTY=0
. I '$D(^PRCP(445,PRCPINPT,1,ITEMDA,0)) S QTY=0
. S ^TMP($J,"PRCPWPLMPOST",LINEDA)=QTY
D REBUILD^PRCPWPLB
S VALMSG="QTY TO POST now set to QTY REMAINing"
Q
;
;
ONHAND ; set qty to post to onhand qty
D FULL^VALM1
S VALMBCK="R"
N DATA,ITEMDA,LINEDA,ONHAND,QTY,X
K X S X(1)="This option will set the QUANTITY TO POST equal to the QUANTITY ON-HAND in the warehouse inventory point. A note of caution: Since the warehouse inventory point is not locked, the quantity on-hand could be changing"
S X(2)="and will be a snapshot of the database. By the time you actually post this issue book, the quantity on-hand may be different and you may even post into the negative."
D DISPLAY^PRCPUX2(5,75,.X)
S XP="Do you want to set the QUANTITY TO POST equal to QUANTITY ONHAND",XH="Enter YES to set the QUANTITY TO POST equal to the QUANTITY ONHAND,",XH(1)=" NO or ^ to return to the posting list."
I $$YN^PRCPUYN(1)'=1 Q
S LINEDA=0 F S LINEDA=$O(^TMP($J,"PRCPWPLMLIST",LINEDA)) Q:'LINEDA S DATA=^(LINEDA) D
. S ITEMDA=+$P(DATA,"^"),QTY=+$P(DATA,"^",2)
. S ONHAND=$P($G(^PRCP(445,PRCPINPT,1,ITEMDA,0)),"^",7) I QTY>ONHAND S QTY=ONHAND
. S ^TMP($J,"PRCPWPLMPOST",LINEDA)=QTY
D REBUILD^PRCPWPLB
S VALMSG="QTY TO POST now set to QTY ONHAND"
Q
;
;
ENTER ; enter quantity to post
D FULL^VALM1
S VALMBCK="R"
N DATA,DIR,ITEMDA,INVDATA,LINEDA,ONHAND,QTYOUT,STATUS,X,Y
F W ! S LINEDA=$$LINEITEM Q:LINEDA<1 D
. S DATA=$G(^PRCS(410,PRCPDA,"IT",LINEDA,0)) I DATA="" W !,"CANNOT FIND LINE ITEM." Q
. S ITEMDA=+$P(DATA,"^",5),STATUS=$P(DATA,"^",14),INVDATA=$G(^PRCP(445,PRCPINPT,1,ITEMDA,0))
. I INVDATA="" W !,"ITEM (#",ITEMDA,") NOT STORED IN THE INVENTORY POINT." Q
. I STATUS'="" W !,"ITEM IS CANCELLED",$S(STATUS["S":" AND SUBSTITUTED WITH LINE #(S): "_$P(STATUS,",",2,99),1:"") Q
. S ONHAND=+$P(INVDATA,"^",7),QTYOUT=+$P($G(^TMP($J,"PRCPWPLMLIST",LINEDA)),"^",2) I QTYOUT<0 S QTYOUT=0
. W !!,ITEMDA,?5,$E($$DESCR^PRCPUX1(PRCPINPT,ITEMDA),1,30)," ",$$NSN^PRCPUX1(ITEMDA)," U/I: ",$$UNIT^PRCPUX1(PRCPINPT,ITEMDA,"/")
. W !?5,"AVERAGE COST : ",$J(+$P(INVDATA,"^",22),0,2)
. W !?5,"LAST COST : ",$J(+$P(INVDATA,"^",15),0,2)
. W !
. W !?5,"QTY ON-HAND : ",ONHAND
. W !?5,"QTY ORDERED : ",+$P(DATA,"^",2)
. W !?5,"QTY POSTED : ",+$P(DATA,"^",12)
. W !?5,"QTY OUTSTANDING: ",QTYOUT
. W !?5,"QTY TO POST : ",+$G(^TMP($J,"PRCPWPLMPOST",LINEDA))
. S DIR(0)="NA^0:"_ONHAND_":0",DIR("A")=" QUANTITY TO POST: ",DIR("B")=$S(QTYOUT<ONHAND:QTYOUT,1:ONHAND)
. S DIR("A",1)="Enter the quantity of this item to post from 0 to "_ONHAND_"."
. W ! D ^DIR K DIR
. I Y S ^TMP($J,"PRCPWPLMPOST",LINEDA)=+Y I Y>ONHAND K X S X(1)="WARNING: YOU WILL BE POSTING INTO THE NEGATIVE" D DISPLAY^PRCPUX2(5,75,.X)
. K X S X(1)="QUANTITY TO POST: "_+$G(^TMP($J,"PRCPWPLMPOST",LINEDA)) D DISPLAY^PRCPUX2(3,32,.X)
D REBUILD^PRCPWPLB
Q
;
;
LINEITEM() ; select line item for issue book
N DA,DIC,X,Y
S DIC="^PRCS(410,"_PRCPDA_",""IT"",",DA(1)=PRCPDA,DIC(0)="QEAMZ",DIC("A")="Select LINE ITEM Number: "
S DIC("W")="S PRCPNODE=12 D DICW^PRCPWPL0 K PRCPNODE"
D ^DIC
Q +Y
;
;
DICW ; write identifier for item
N %,A,B
; reference global ^prcs(410,da,0) from fileman
S %=^(0),B=$G(^PRC(441,+$P(%,"^",5),0))
W ?7," ",$P(B,"^",5)," (#",+$P(%,"^",5),")",?35," QTY.ORD: ",+$P(%,"^",2),?50," QTY.DIS: ",+$P(%,"^",PRCPNODE),?65
I $P(%,"^",14)="" S A=$P(%,"^",2)-$P(%,"^",PRCPNODE) S:A<0 A=0 W " QTY.OUT: ",A
E S %=$P(%,"^",14) S A=$S(%["C":" CANCEL",1:"")_$S(%["S":" SUBST",1:"") W A
I $D(DZ),DZ["??" W !?7," ",$P(B,"^",2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPWPL0 5017 printed Oct 16, 2024@18:17:23 Page 2
PRCPWPL0 ;WISC/RFJ-whse post issue book (options) ;13 Jan 94
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
EEITEMS ; called from protocol file to enter/edit invpt items
+1 DO FULL^VALM1
+2 NEW PRC,PRCP
+3 SET PRCP("DPTYPE")="WP"
+4 DO ^PRCPEILM
+5 DO REBUILD^PRCPWPLB
+6 SET VALMBCK="R"
+7 QUIT
+8 ;
+9 ;
SHOWNSN ; show nsn on list
+1 SET PRCPFNSN=$SELECT($GET(PRCPFNSN):0,1:1)
+2 DO REBUILD^PRCPWPLB
+3 SET ^DISV(DUZ,"PRCPWPLM","SHOWNSN")=PRCPFNSN
+4 SET VALMSG=$SELECT(PRCPFNSN:"SHOW NSN",1:"DO NOT SHOW NSN")
+5 SET VALMBCK="R"
+6 QUIT
+7 ;
+8 ;
REMAIN ; set qty to post to remaining (outstanding) qty
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 NEW DATA,ITEMDA,LINEDA,QTY,X
+4 KILL X
SET X(1)="This option will set the QUANTITY TO POST equal to the QUANTITY REMAINing (same as quantity outstanding). The QUANTITY REMAINing is equal to the QUANTITY ORDERED minus the QUANTITY POSTED previously."
+5 DO DISPLAY^PRCPUX2(5,75,.X)
+6 SET XP="Do you want to set the QUANTITY TO POST equal to QUANTITY REMAINing"
SET XH="Enter YES to set the QUANTITY TO POST equal to the QUANTITY REMAINing,"
SET XH(1)=" NO or ^ to return to the posting list."
+7 IF $$YN^PRCPUYN(1)'=1
QUIT
+8 SET LINEDA=0
FOR
SET LINEDA=$ORDER(^TMP($JOB,"PRCPWPLMLIST",LINEDA))
if 'LINEDA
QUIT
SET DATA=^(LINEDA)
Begin DoDot:1
+9 SET ITEMDA=+$PIECE(DATA,"^")
SET QTY=+$PIECE(DATA,"^",2)
+10 IF QTY<0
SET QTY=0
+11 IF '$DATA(^PRCP(445,PRCPINPT,1,ITEMDA,0))
SET QTY=0
+12 SET ^TMP($JOB,"PRCPWPLMPOST",LINEDA)=QTY
End DoDot:1
+13 DO REBUILD^PRCPWPLB
+14 SET VALMSG="QTY TO POST now set to QTY REMAINing"
+15 QUIT
+16 ;
+17 ;
ONHAND ; set qty to post to onhand qty
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 NEW DATA,ITEMDA,LINEDA,ONHAND,QTY,X
+4 KILL X
SET X(1)="This option will set the QUANTITY TO POST equal to the QUANTITY ON-HAND in the warehouse inventory point. A note of caution: Since the warehouse inventory point is not locked, the quantity on-hand could be changing"
+5 SET X(2)="and will be a snapshot of the database. By the time you actually post this issue book, the quantity on-hand may be different and you may even post into the negative."
+6 DO DISPLAY^PRCPUX2(5,75,.X)
+7 SET XP="Do you want to set the QUANTITY TO POST equal to QUANTITY ONHAND"
SET XH="Enter YES to set the QUANTITY TO POST equal to the QUANTITY ONHAND,"
SET XH(1)=" NO or ^ to return to the posting list."
+8 IF $$YN^PRCPUYN(1)'=1
QUIT
+9 SET LINEDA=0
FOR
SET LINEDA=$ORDER(^TMP($JOB,"PRCPWPLMLIST",LINEDA))
if 'LINEDA
QUIT
SET DATA=^(LINEDA)
Begin DoDot:1
+10 SET ITEMDA=+$PIECE(DATA,"^")
SET QTY=+$PIECE(DATA,"^",2)
+11 SET ONHAND=$PIECE($GET(^PRCP(445,PRCPINPT,1,ITEMDA,0)),"^",7)
IF QTY>ONHAND
SET QTY=ONHAND
+12 SET ^TMP($JOB,"PRCPWPLMPOST",LINEDA)=QTY
End DoDot:1
+13 DO REBUILD^PRCPWPLB
+14 SET VALMSG="QTY TO POST now set to QTY ONHAND"
+15 QUIT
+16 ;
+17 ;
ENTER ; enter quantity to post
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 NEW DATA,DIR,ITEMDA,INVDATA,LINEDA,ONHAND,QTYOUT,STATUS,X,Y
+4 FOR
WRITE !
SET LINEDA=$$LINEITEM
if LINEDA<1
QUIT
Begin DoDot:1
+5 SET DATA=$GET(^PRCS(410,PRCPDA,"IT",LINEDA,0))
IF DATA=""
WRITE !,"CANNOT FIND LINE ITEM."
QUIT
+6 SET ITEMDA=+$PIECE(DATA,"^",5)
SET STATUS=$PIECE(DATA,"^",14)
SET INVDATA=$GET(^PRCP(445,PRCPINPT,1,ITEMDA,0))
+7 IF INVDATA=""
WRITE !,"ITEM (#",ITEMDA,") NOT STORED IN THE INVENTORY POINT."
QUIT
+8 IF STATUS'=""
WRITE !,"ITEM IS CANCELLED",$SELECT(STATUS["S":" AND SUBSTITUTED WITH LINE #(S): "_$PIECE(STATUS,",",2,99),1:"")
QUIT
+9 SET ONHAND=+$PIECE(INVDATA,"^",7)
SET QTYOUT=+$PIECE($GET(^TMP($JOB,"PRCPWPLMLIST",LINEDA)),"^",2)
IF QTYOUT<0
SET QTYOUT=0
+10 WRITE !!,ITEMDA,?5,$EXTRACT($$DESCR^PRCPUX1(PRCPINPT,ITEMDA),1,30)," ",$$NSN^PRCPUX1(ITEMDA)," U/I: ",$$UNIT^PRCPUX1(PRCPINPT,ITEMDA,"/")
+11 WRITE !?5,"AVERAGE COST : ",$JUSTIFY(+$PIECE(INVDATA,"^",22),0,2)
+12 WRITE !?5,"LAST COST : ",$JUSTIFY(+$PIECE(INVDATA,"^",15),0,2)
+13 WRITE !
+14 WRITE !?5,"QTY ON-HAND : ",ONHAND
+15 WRITE !?5,"QTY ORDERED : ",+$PIECE(DATA,"^",2)
+16 WRITE !?5,"QTY POSTED : ",+$PIECE(DATA,"^",12)
+17 WRITE !?5,"QTY OUTSTANDING: ",QTYOUT
+18 WRITE !?5,"QTY TO POST : ",+$GET(^TMP($JOB,"PRCPWPLMPOST",LINEDA))
+19 SET DIR(0)="NA^0:"_ONHAND_":0"
SET DIR("A")=" QUANTITY TO POST: "
SET DIR("B")=$SELECT(QTYOUT<ONHAND:QTYOUT,1:ONHAND)
+20 SET DIR("A",1)="Enter the quantity of this item to post from 0 to "_ONHAND_"."
+21 WRITE !
DO ^DIR
KILL DIR
+22 IF Y
SET ^TMP($JOB,"PRCPWPLMPOST",LINEDA)=+Y
IF Y>ONHAND
KILL X
SET X(1)="WARNING: YOU WILL BE POSTING INTO THE NEGATIVE"
DO DISPLAY^PRCPUX2(5,75,.X)
+23 KILL X
SET X(1)="QUANTITY TO POST: "_+$GET(^TMP($JOB,"PRCPWPLMPOST",LINEDA))
DO DISPLAY^PRCPUX2(3,32,.X)
End DoDot:1
+24 DO REBUILD^PRCPWPLB
+25 QUIT
+26 ;
+27 ;
LINEITEM() ; select line item for issue book
+1 NEW DA,DIC,X,Y
+2 SET DIC="^PRCS(410,"_PRCPDA_",""IT"","
SET DA(1)=PRCPDA
SET DIC(0)="QEAMZ"
SET DIC("A")="Select LINE ITEM Number: "
+3 SET DIC("W")="S PRCPNODE=12 D DICW^PRCPWPL0 K PRCPNODE"
+4 DO ^DIC
+5 QUIT +Y
+6 ;
+7 ;
DICW ; write identifier for item
+1 NEW %,A,B
+2 ; reference global ^prcs(410,da,0) from fileman
+3 SET %=^(0)
SET B=$GET(^PRC(441,+$PIECE(%,"^",5),0))
+4 WRITE ?7," ",$PIECE(B,"^",5)," (#",+$PIECE(%,"^",5),")",?35," QTY.ORD: ",+$PIECE(%,"^",2),?50," QTY.DIS: ",+$PIECE(%,"^",PRCPNODE),?65
+5 IF $PIECE(%,"^",14)=""
SET A=$PIECE(%,"^",2)-$PIECE(%,"^",PRCPNODE)
if A<0
SET A=0
WRITE " QTY.OUT: ",A
+6 IF '$TEST
SET %=$PIECE(%,"^",14)
SET A=$SELECT(%["C":" CANCEL",1:"")_$SELECT(%["S":" SUBST",1:"")
WRITE A
+7 IF $DATA(DZ)
IF DZ["??"
WRITE !?7," ",$PIECE(B,"^",2)
+8 QUIT
