PRCPEITF ;WISC/RFJ-enter/edit inventory items ;01 Dec 93
V ;;5.1;IFCAP;**1**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
DESCRIP(PRCPINPT,ITEMDA,PRCPQUIT) ; edit item description
;
; PRCPINPT = inventory point
; ITEMDA = item ien
; PRCPQUIT = flag if user aborts/times-out
;
N PRCPNM
; because this is sometimes called from templates, new FileMan variables
N D,D0,D1,D2,D3,D4,D5,D6,DA,DB,DC,DD,DE,DG,DH,DI,DIA,DIADD,DIC,DICR,DIE
N DIEC,DIEL,DIFLD,DIK,DIOV,DIR,DK,DL,DLAYGO,DM,DO,DOV,DP,DR,DQ,DU,DV,DW
N I,J,X,Y
I '$D(^PRCP(445,PRCPINPT,1,ITEMDA)) Q
S PRCPNM=$P(^PRCP(445,PRCPINPT,0),"^",1)
D I $D(DUOUT)!$D(DTOUT) Q
. N VALUE
. S DIR(0)="445.01,.7^^",DA(1)=PRCPINPT,DA=ITEMDA
. D ^DIR K DIR
. S VALUE=Y
. I $D(DTOUT)!$D(DUOUT) S PRCPQUIT=1 Q
. S DA=ITEMDA,DIE="^PRCP(445,"_PRCPINPT_",1,",DR=".7///^S X=VALUE",PRCPPRIV=1
. D ^DIE K PRCPPRIV,DIE
. S VALUE=$P($G(^PRCP(445,PRCPINPT,1,ITEMDA,6)),"^",1)
. I $P(^PRCP(445,PRCPINPT,0),"^",3)="P",PRCPNM]"",VALUE]"",PRCPNM'=VALUE D
. . D POPDESC(PRCPINPT,ITEMDA)
Q
;
;
DESDEF(PRCPINPT,ITEMDA) ; get default for item description
; ITEMDA = item number requiring the default description
; PRCPINPT = inventory point
; returns name to use for default
;
; Note: The inventory point must be locked at least at
; the item level prior to calling this routine
;
N DES,PRCPPRIM,PRCPTYPE
S DES=""
S PRCPTYPE=$P($G(^PRCP(445,PRCPINPT,0)),"^",3)
I PRCPTYPE'="S" D
. S DES=$P($G(^PRC(441,ITEMDA,0)),"^",2)
. S $P(^PRCP(445,PRCPINPT,1,ITEMDA,6),"^")=DES
. W !!?5,"...item description set to short description in item master file."
I PRCPTYPE="S" D
. S PRCPPRIM=0
. S PRCPPRIM=$O(^PRCP(445,"AB",+PRCPINPT,PRCPPRIM))
. S DES=$P($G(^PRCP(445,PRCPPRIM,1,ITEMDA,6)),"^",1)
. S $P(^PRCP(445,PRCPINPT,1,ITEMDA,6),"^")=DES
. W !!?5,"...item description set to short description in primary."
Q (DES)
;
;
POPDESC(PRCPINPT,ITEMDA) ; ask user if item description should be used in secondaries
; ITEMDA = item number requiring the default description
; PRCPINPT = inventory point
;
N DES,PRCPRNM,SEC
S PRCPPRNM=$P(^PRCP(445,PRCPINPT,0),"^",1)
;ASK USER IF THEY WISH TO UPDATE ALL SECONDARIES
S XP=" Do you want to update the DESCRIPTION for ALL distribution"
S XP(1)=" points stocked by "_PRCPPRNM
S XH=" Enter 'YES' only if you want to change the DESCRIPTION at ALL"
S XH(1)=" DISTRIBUTION points to be the same as for the "_PRCPPRNM
S XH(2)=" procurement source."
I $$YN^PRCPUYN("")'=1 Q
; IF YES DO
W !!,"updating DESCRIPTION for distribution points....."
S DES=$P(^PRCP(445,PRCPINPT,1,ITEMDA,6),"^",1)
; LOOK AT NODE 2 OF PRIMARY
S SEC=0 F S SEC=$O(^PRCP(445,PRCPINPT,2,SEC)) Q:'+SEC D
. N DA,DIE,DR
. ; IF ITEM IS ON THAT SECONDARY, LOCK & UPDATE NAME
. I $D(^PRCP(445,SEC,1,ITEMDA)) D
. . L +^PRCP(445,SEC,1,ITEMDA):2
. . W !,$J($P(^PRCP(445,SEC,0),"^",1),35)
. . I '$T W " In use, could not update." Q
. . S DIE="^PRCP(445,"_SEC_",1,"
. . S DA=ITEMDA
. . S DR=".7////^S X=DES"
. . D ^DIE K DIE
. . W " DESCRIPTION updated"
. . D BLDSEG^PRCPHLFM(3,ITEMDA,SEC) ; notify supply station of update
. . L -^PRCP(445,SEC,1,ITEMDA)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPEITF 3306 printed Sep 23, 2025@19:49:45 Page 2
PRCPEITF ;WISC/RFJ-enter/edit inventory items ;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 QUIT
+3 ;
+4 ;
DESCRIP(PRCPINPT,ITEMDA,PRCPQUIT) ; edit item description
+1 ;
+2 ; PRCPINPT = inventory point
+3 ; ITEMDA = item ien
+4 ; PRCPQUIT = flag if user aborts/times-out
+5 ;
+6 NEW PRCPNM
+7 ; because this is sometimes called from templates, new FileMan variables
+8 NEW D,D0,D1,D2,D3,D4,D5,D6,DA,DB,DC,DD,DE,DG,DH,DI,DIA,DIADD,DIC,DICR,DIE
+9 NEW DIEC,DIEL,DIFLD,DIK,DIOV,DIR,DK,DL,DLAYGO,DM,DO,DOV,DP,DR,DQ,DU,DV,DW
+10 NEW I,J,X,Y
+11 IF '$DATA(^PRCP(445,PRCPINPT,1,ITEMDA))
QUIT
+12 SET PRCPNM=$PIECE(^PRCP(445,PRCPINPT,0),"^",1)
+13 Begin DoDot:1
+14 NEW VALUE
+15 SET DIR(0)="445.01,.7^^"
SET DA(1)=PRCPINPT
SET DA=ITEMDA
+16 DO ^DIR
KILL DIR
+17 SET VALUE=Y
+18 IF $DATA(DTOUT)!$DATA(DUOUT)
SET PRCPQUIT=1
QUIT
+19 SET DA=ITEMDA
SET DIE="^PRCP(445,"_PRCPINPT_",1,"
SET DR=".7///^S X=VALUE"
SET PRCPPRIV=1
+20 DO ^DIE
KILL PRCPPRIV,DIE
+21 SET VALUE=$PIECE($GET(^PRCP(445,PRCPINPT,1,ITEMDA,6)),"^",1)
+22 IF $PIECE(^PRCP(445,PRCPINPT,0),"^",3)="P"
IF PRCPNM]""
IF VALUE]""
IF PRCPNM'=VALUE
Begin DoDot:2
+23 DO POPDESC(PRCPINPT,ITEMDA)
End DoDot:2
End DoDot:1
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+24 QUIT
+25 ;
+26 ;
DESDEF(PRCPINPT,ITEMDA) ; get default for item description
+1 ; ITEMDA = item number requiring the default description
+2 ; PRCPINPT = inventory point
+3 ; returns name to use for default
+4 ;
+5 ; Note: The inventory point must be locked at least at
+6 ; the item level prior to calling this routine
+7 ;
+8 NEW DES,PRCPPRIM,PRCPTYPE
+9 SET DES=""
+10 SET PRCPTYPE=$PIECE($GET(^PRCP(445,PRCPINPT,0)),"^",3)
+11 IF PRCPTYPE'="S"
Begin DoDot:1
+12 SET DES=$PIECE($GET(^PRC(441,ITEMDA,0)),"^",2)
+13 SET $PIECE(^PRCP(445,PRCPINPT,1,ITEMDA,6),"^")=DES
+14 WRITE !!?5,"...item description set to short description in item master file."
End DoDot:1
+15 IF PRCPTYPE="S"
Begin DoDot:1
+16 SET PRCPPRIM=0
+17 SET PRCPPRIM=$ORDER(^PRCP(445,"AB",+PRCPINPT,PRCPPRIM))
+18 SET DES=$PIECE($GET(^PRCP(445,PRCPPRIM,1,ITEMDA,6)),"^",1)
+19 SET $PIECE(^PRCP(445,PRCPINPT,1,ITEMDA,6),"^")=DES
+20 WRITE !!?5,"...item description set to short description in primary."
End DoDot:1
+21 QUIT (DES)
+22 ;
+23 ;
POPDESC(PRCPINPT,ITEMDA) ; ask user if item description should be used in secondaries
+1 ; ITEMDA = item number requiring the default description
+2 ; PRCPINPT = inventory point
+3 ;
+4 NEW DES,PRCPRNM,SEC
+5 SET PRCPPRNM=$PIECE(^PRCP(445,PRCPINPT,0),"^",1)
+6 ;ASK USER IF THEY WISH TO UPDATE ALL SECONDARIES
+7 SET XP=" Do you want to update the DESCRIPTION for ALL distribution"
+8 SET XP(1)=" points stocked by "_PRCPPRNM
+9 SET XH=" Enter 'YES' only if you want to change the DESCRIPTION at ALL"
+10 SET XH(1)=" DISTRIBUTION points to be the same as for the "_PRCPPRNM
+11 SET XH(2)=" procurement source."
+12 IF $$YN^PRCPUYN("")'=1
QUIT
+13 ; IF YES DO
+14 WRITE !!,"updating DESCRIPTION for distribution points....."
+15 SET DES=$PIECE(^PRCP(445,PRCPINPT,1,ITEMDA,6),"^",1)
+16 ; LOOK AT NODE 2 OF PRIMARY
+17 SET SEC=0
FOR
SET SEC=$ORDER(^PRCP(445,PRCPINPT,2,SEC))
if '+SEC
QUIT
Begin DoDot:1
+18 NEW DA,DIE,DR
+19 ; IF ITEM IS ON THAT SECONDARY, LOCK & UPDATE NAME
+20 IF $DATA(^PRCP(445,SEC,1,ITEMDA))
Begin DoDot:2
+21 LOCK +^PRCP(445,SEC,1,ITEMDA):2
+22 WRITE !,$JUSTIFY($PIECE(^PRCP(445,SEC,0),"^",1),35)
+23 IF '$TEST
WRITE " In use, could not update."
QUIT
+24 SET DIE="^PRCP(445,"_SEC_",1,"
+25 SET DA=ITEMDA
+26 SET DR=".7////^S X=DES"
+27 DO ^DIE
KILL DIE
+28 WRITE " DESCRIPTION updated"
+29 ; notify supply station of update
DO BLDSEG^PRCPHLFM(3,ITEMDA,SEC)
+30 LOCK -^PRCP(445,SEC,1,ITEMDA)
End DoDot:2
End DoDot:1
+31 QUIT
