PRCPEITD ;WISC/RFJ-enter,edit items for distribution point ;01 Dec 93
V ;;5.1;IFCAP;**1**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
D ^PRCPUSEL Q:'$G(PRCP("I"))
I "PW"'[PRCP("DPTYPE") W !,"This option can only be used by primary or warehouse inventory points." Q
N %,D,D0,D1,DA,DATA,DI,DIC,DIE,DQ,DR,DISTRPT,GROUP,ITEMDA,ITEMDATA,MANDATA,MANSRCE,PRCPFLAG,PRCPINPT,PRCPSTOP,X,Y
F D I $G(PRCPFLAG) QUIT
. W !!?7,"You can only edit items in distribution points"
. W !?7,"NOT keeping a perpetual inventory."
. S DISTRPT=+$$TO^PRCPUDPT(PRCP("I")) I 'DISTRPT S PRCPFLAG=1 Q
. I $P($G(^PRCP(445,DISTRPT,0)),"^",2)="Y" Q
. L +^PRCP(445,DISTRPT,1):5 I '$T D SHOWWHO^PRCPULOC(445,DISTRPT_"-1",0) Q
. D ADD^PRCPULOC(445,DISTRPT_"-1",0,"Enter/Edit Items On Distribution Point")
. K PRCPSTOP F D Q:$G(PRCPSTOP)
. . W !!
. . S ITEMDA=$$ITEM^PRCPUITM(DISTRPT,1,",$D(^PRCP(445,"_PRCP("I")_",1,+Y,0))","")
. . I ITEMDA["^" S (PRCPFLAG,PRCPSTOP)=1 Q
. . I 'ITEMDA S PRCPSTOP=1 Q
. . S GROUP=$$GROUPDA^PRCPEGRP(DISTRPT,ITEMDA)
. . I 'GROUP S GROUP=$$GROUPDA^PRCPEGRP(PRCP("I"),ITEMDA) I GROUP S DATA=$G(^PRCP(445.6,GROUP,0)) I DATA'="" D
. . . ; lookup group category
. . . S Y=+$$GROUP^PRCPEGRP(DISTRPT,$P(DATA,"^"))
. . . I Y>0 D SETGRP^PRCPEGRP(DISTRPT,ITEMDA,Y) Q
. . . ; add group category to group category file
. . . S Y=$$ADDGRP^PRCPEGRP(DISTRPT,$P(DATA,"^"),$P(DATA,"^",3))
. . . I Y D SETGRP^PRCPEGRP(DISTRPT,ITEMDA,Y)
. . ;
. . S %=$P($G(^PRCP(445,PRCP("I"),1,ITEMDA,6)),"^")
. . I %'="" S $P(^PRCP(445,DISTRPT,1,ITEMDA,6),"^")=%
. . ;
. . S DATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0))
. . S MANSRCE=PRCP("I")_";PRCP(445,"
. . I PRCP("DPTYPE")="W" S MANSRCE=$O(^PRC(440,"AC","S",0))_";PRC(440,"
. . I +MANSRCE D
. . . S $P(^PRCP(445,DISTRPT,1,ITEMDA,0),"^",12)=MANSRCE
. . . S ^PRCP(445,DISTRPT,1,"AC",$E(MANSRCE,1,30),ITEMDA)=""
. . . W !?5,"MANDATORY SOURCE : ",$$VENNAME^PRCPUX1(MANSRCE)
. . . I '$$GETVEN^PRCPUVEN(DISTRPT,ITEMDA,MANSRCE,1) D ADDVEN^PRCPUVEN(DISTRPT,ITEMDA,MANSRCE,$P(DATA,"^",5),$P(DATA,"^",14),1)
. . S MANDATA=$$GETVEN^PRCPUVEN(DISTRPT,ITEMDA,MANSRCE,1)
. . S ITEMDATA=^PRCP(445,DISTRPT,1,ITEMDA,0)
. . S:$P(ITEMDATA,"^",5)="" $P(ITEMDATA,"^",5)=$P(DATA,"^",5)
. . S:$P(ITEMDATA,"^",14)="" $P(ITEMDATA,"^",14)=$P(DATA,"^",14)
. . S ^PRCP(445,DISTRPT,1,ITEMDA,0)=ITEMDATA
. . W !?5,"UNIT per ISSUE : "
. . W $$UNITVAL^PRCPUX1($P(ITEMDATA,"^",14),$P(ITEMDATA,"^",5)," per ")
. . I MANDATA D
. . . W !?5,"UNIT per RECEIPT : "
. . . W $$UNITVAL^PRCPUX1($P(MANDATA,"^",3),$P(MANDATA,"^",2)," per ")
. . . W !?5,"CONVERSION FACTOR: ",$P(MANDATA,"^",4)
. . S DR=".01;4;4.5;.6;4.7;9;5;"_$S(PRCP("DPTYPE")="W":"14.3;14.4;",1:"")
. . S DR(2,445.07)="3;"
. . I $P(^PRCP(445,DISTRPT,0),"^",3)="S",$P($G(^PRCP(445,DISTRPT,5)),"^",1)]"" D
. . . D EDNORM^PRCPEITE(DISTRPT,ITEMDA,"NORMAL STOCK LEVEL")
. . . I $D(DUOUT)!$D(DTOUT) S PRCPSTOP=1 Q
. . . S DR=".01;4;4.5;.6;4.7;5;"_$S(PRCP("DPTYPE")="W":"14.3;14.4;",1:"")
. . I $G(PRCPSTOP) S PRCPFLAG=1 Q ; allow user to exit item editing
. . S DIE="^PRCP(445,"_DISTRPT_",1,"
. . S (DA(1),PRCPINPT)=DISTRPT
. . S (DA,D1)=ITEMDA
. . D ^DIE K DIC,DIE,DR I $D(Y) Q
. . D BLDSEG^PRCPHLFM(3,ITEMDA,DISTRPT) ; send supply station an update of any changes to the item
. L -^PRCP(445,DISTRPT,1,ITEMDA) ; do this even if user enters '^'
. D CLEAR^PRCPULOC(445,DISTRPT_"-1",0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPEITD 3730 printed Apr 09, 2024@21:20:58 Page 2
PRCPEITD ;WISC/RFJ-enter,edit items for distribution point ;01 Dec 93
V ;;5.1;IFCAP;**1**;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 DO ^PRCPUSEL
if '$GET(PRCP("I"))
QUIT
+3 IF "PW"'[PRCP("DPTYPE")
WRITE !,"This option can only be used by primary or warehouse inventory points."
QUIT
+4 NEW %,D,D0,D1,DA,DATA,DI,DIC,DIE,DQ,DR,DISTRPT,GROUP,ITEMDA,ITEMDATA,MANDATA,MANSRCE,PRCPFLAG,PRCPINPT,PRCPSTOP,X,Y
+5 FOR
Begin DoDot:1
+6 WRITE !!?7,"You can only edit items in distribution points"
+7 WRITE !?7,"NOT keeping a perpetual inventory."
+8 SET DISTRPT=+$$TO^PRCPUDPT(PRCP("I"))
IF 'DISTRPT
SET PRCPFLAG=1
QUIT
+9 IF $PIECE($GET(^PRCP(445,DISTRPT,0)),"^",2)="Y"
QUIT
+10 LOCK +^PRCP(445,DISTRPT,1):5
IF '$TEST
DO SHOWWHO^PRCPULOC(445,DISTRPT_"-1",0)
QUIT
+11 DO ADD^PRCPULOC(445,DISTRPT_"-1",0,"Enter/Edit Items On Distribution Point")
+12 KILL PRCPSTOP
FOR
Begin DoDot:2
+13 WRITE !!
+14 SET ITEMDA=$$ITEM^PRCPUITM(DISTRPT,1,",$D(^PRCP(445,"_PRCP("I")_",1,+Y,0))","")
+15 IF ITEMDA["^"
SET (PRCPFLAG,PRCPSTOP)=1
QUIT
+16 IF 'ITEMDA
SET PRCPSTOP=1
QUIT
+17 SET GROUP=$$GROUPDA^PRCPEGRP(DISTRPT,ITEMDA)
+18 IF 'GROUP
SET GROUP=$$GROUPDA^PRCPEGRP(PRCP("I"),ITEMDA)
IF GROUP
SET DATA=$GET(^PRCP(445.6,GROUP,0))
IF DATA'=""
Begin DoDot:3
+19 ; lookup group category
+20 SET Y=+$$GROUP^PRCPEGRP(DISTRPT,$PIECE(DATA,"^"))
+21 IF Y>0
DO SETGRP^PRCPEGRP(DISTRPT,ITEMDA,Y)
QUIT
+22 ; add group category to group category file
+23 SET Y=$$ADDGRP^PRCPEGRP(DISTRPT,$PIECE(DATA,"^"),$PIECE(DATA,"^",3))
+24 IF Y
DO SETGRP^PRCPEGRP(DISTRPT,ITEMDA,Y)
End DoDot:3
+25 ;
+26 SET %=$PIECE($GET(^PRCP(445,PRCP("I"),1,ITEMDA,6)),"^")
+27 IF %'=""
SET $PIECE(^PRCP(445,DISTRPT,1,ITEMDA,6),"^")=%
+28 ;
+29 SET DATA=$GET(^PRCP(445,PRCP("I"),1,ITEMDA,0))
+30 SET MANSRCE=PRCP("I")_";PRCP(445,"
+31 IF PRCP("DPTYPE")="W"
SET MANSRCE=$ORDER(^PRC(440,"AC","S",0))_";PRC(440,"
+32 IF +MANSRCE
Begin DoDot:3
+33 SET $PIECE(^PRCP(445,DISTRPT,1,ITEMDA,0),"^",12)=MANSRCE
+34 SET ^PRCP(445,DISTRPT,1,"AC",$EXTRACT(MANSRCE,1,30),ITEMDA)=""
+35 WRITE !?5,"MANDATORY SOURCE : ",$$VENNAME^PRCPUX1(MANSRCE)
+36 IF '$$GETVEN^PRCPUVEN(DISTRPT,ITEMDA,MANSRCE,1)
DO ADDVEN^PRCPUVEN(DISTRPT,ITEMDA,MANSRCE,$PIECE(DATA,"^",5),$PIECE(DATA,"^",14),1)
End DoDot:3
+37 SET MANDATA=$$GETVEN^PRCPUVEN(DISTRPT,ITEMDA,MANSRCE,1)
+38 SET ITEMDATA=^PRCP(445,DISTRPT,1,ITEMDA,0)
+39 if $PIECE(ITEMDATA,"^",5)=""
SET $PIECE(ITEMDATA,"^",5)=$PIECE(DATA,"^",5)
+40 if $PIECE(ITEMDATA,"^",14)=""
SET $PIECE(ITEMDATA,"^",14)=$PIECE(DATA,"^",14)
+41 SET ^PRCP(445,DISTRPT,1,ITEMDA,0)=ITEMDATA
+42 WRITE !?5,"UNIT per ISSUE : "
+43 WRITE $$UNITVAL^PRCPUX1($PIECE(ITEMDATA,"^",14),$PIECE(ITEMDATA,"^",5)," per ")
+44 IF MANDATA
Begin DoDot:3
+45 WRITE !?5,"UNIT per RECEIPT : "
+46 WRITE $$UNITVAL^PRCPUX1($PIECE(MANDATA,"^",3),$PIECE(MANDATA,"^",2)," per ")
+47 WRITE !?5,"CONVERSION FACTOR: ",$PIECE(MANDATA,"^",4)
End DoDot:3
+48 SET DR=".01;4;4.5;.6;4.7;9;5;"_$SELECT(PRCP("DPTYPE")="W":"14.3;14.4;",1:"")
+49 SET DR(2,445.07)="3;"
+50 IF $PIECE(^PRCP(445,DISTRPT,0),"^",3)="S"
IF $PIECE($GET(^PRCP(445,DISTRPT,5)),"^",1)]""
Begin DoDot:3
+51 DO EDNORM^PRCPEITE(DISTRPT,ITEMDA,"NORMAL STOCK LEVEL")
+52 IF $DATA(DUOUT)!$DATA(DTOUT)
SET PRCPSTOP=1
QUIT
+53 SET DR=".01;4;4.5;.6;4.7;5;"_$SELECT(PRCP("DPTYPE")="W":"14.3;14.4;",1:"")
End DoDot:3
+54 ; allow user to exit item editing
IF $GET(PRCPSTOP)
SET PRCPFLAG=1
QUIT
+55 SET DIE="^PRCP(445,"_DISTRPT_",1,"
+56 SET (DA(1),PRCPINPT)=DISTRPT
+57 SET (DA,D1)=ITEMDA
+58 DO ^DIE
KILL DIC,DIE,DR
IF $DATA(Y)
QUIT
+59 ; send supply station an update of any changes to the item
DO BLDSEG^PRCPHLFM(3,ITEMDA,DISTRPT)
End DoDot:2
if $GET(PRCPSTOP)
QUIT
+60 ; do this even if user enters '^'
LOCK -^PRCP(445,DISTRPT,1,ITEMDA)
+61 DO CLEAR^PRCPULOC(445,DISTRPT_"-1",0)
End DoDot:1
IF $GET(PRCPFLAG)
QUIT
+62 QUIT
