Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCPEITF

PRCPEITF.m

Go to the documentation of this file. 
  1. PRCPEITF ;WISC/RFJ-enter/edit inventory items                       ;01 Dec 93
  1. V ;;5.1;IFCAP;**1**;Oct 20, 2000
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  Q
  1.  ;
  1.  ;
  1. DESCRIP(PRCPINPT,ITEMDA,PRCPQUIT) ;  edit item description
  1.  ;
  1.  ; PRCPINPT = inventory point
  1.  ; ITEMDA = item ien
  1.  ; PRCPQUIT = flag if user aborts/times-out
  1.  ;
  1.  N PRCPNM
  1.  ; because this is sometimes called from templates, new FileMan variables
  1.  N D,D0,D1,D2,D3,D4,D5,D6,DA,DB,DC,DD,DE,DG,DH,DI,DIA,DIADD,DIC,DICR,DIE
  1.  N DIEC,DIEL,DIFLD,DIK,DIOV,DIR,DK,DL,DLAYGO,DM,DO,DOV,DP,DR,DQ,DU,DV,DW
  1.  N I,J,X,Y
  1.  I '$D(^PRCP(445,PRCPINPT,1,ITEMDA)) Q
  1.  S PRCPNM=$P(^PRCP(445,PRCPINPT,0),"^",1)
  1.  D  I $D(DUOUT)!$D(DTOUT) Q
  1.  . N VALUE
  1.  . S DIR(0)="445.01,.7^^",DA(1)=PRCPINPT,DA=ITEMDA
  1.  . D ^DIR K DIR
  1.  . S VALUE=Y
  1.  . I $D(DTOUT)!$D(DUOUT) S PRCPQUIT=1 Q
  1.  . S DA=ITEMDA,DIE="^PRCP(445,"_PRCPINPT_",1,",DR=".7///^S X=VALUE",PRCPPRIV=1
  1.  . D ^DIE K PRCPPRIV,DIE
  1.  . S VALUE=$P($G(^PRCP(445,PRCPINPT,1,ITEMDA,6)),"^",1)
  1.  . I $P(^PRCP(445,PRCPINPT,0),"^",3)="P",PRCPNM]"",VALUE]"",PRCPNM'=VALUE D
  1.  . . D POPDESC(PRCPINPT,ITEMDA)
  1.  Q
  1.  ;
  1.  ;
  1. DESDEF(PRCPINPT,ITEMDA) ; get default for item description
  1.  ; ITEMDA   = item number requiring the default description
  1.  ; PRCPINPT = inventory point
  1.  ; returns name to use for default
  1.  ;
  1.  ; Note: The inventory point must be locked at least at
  1.  ;       the item level prior to calling this routine
  1.  ;
  1.  N DES,PRCPPRIM,PRCPTYPE
  1.  S DES=""
  1.  S PRCPTYPE=$P($G(^PRCP(445,PRCPINPT,0)),"^",3)
  1.  I PRCPTYPE'="S" D
  1.  . S DES=$P($G(^PRC(441,ITEMDA,0)),"^",2)
  1.  . S $P(^PRCP(445,PRCPINPT,1,ITEMDA,6),"^")=DES
  1.  . W !!?5,"...item description set to short description in item master file."
  1.  I PRCPTYPE="S" D
  1.  . S PRCPPRIM=0
  1.  . S PRCPPRIM=$O(^PRCP(445,"AB",+PRCPINPT,PRCPPRIM))
  1.  . S DES=$P($G(^PRCP(445,PRCPPRIM,1,ITEMDA,6)),"^",1)
  1.  . S $P(^PRCP(445,PRCPINPT,1,ITEMDA,6),"^")=DES
  1.  . W !!?5,"...item description set to short description in primary."
  1.  Q (DES)
  1.  ;
  1.  ;
  1. POPDESC(PRCPINPT,ITEMDA) ; ask user if item description should be used in secondaries
  1.  ; ITEMDA   = item number requiring the default description
  1.  ; PRCPINPT = inventory point
  1.  ;
  1.  N DES,PRCPRNM,SEC
  1.  S PRCPPRNM=$P(^PRCP(445,PRCPINPT,0),"^",1)
  1.  ;ASK USER IF THEY WISH TO UPDATE ALL SECONDARIES
  1.  S XP="  Do you want to update the DESCRIPTION for ALL distribution"
  1.  S XP(1)="  points stocked by "_PRCPPRNM
  1.  S XH="  Enter 'YES' only if you want to change the DESCRIPTION at ALL"
  1.  S XH(1)="  DISTRIBUTION points to be the same as for the "_PRCPPRNM
  1.  S XH(2)="  procurement source."
  1.  I $$YN^PRCPUYN("")'=1 Q
  1.  ; IF YES DO
  1.  W !!,"updating DESCRIPTION for distribution points....."
  1.  S DES=$P(^PRCP(445,PRCPINPT,1,ITEMDA,6),"^",1)
  1.  ; LOOK AT NODE 2 OF PRIMARY
  1.  S SEC=0 F  S SEC=$O(^PRCP(445,PRCPINPT,2,SEC)) Q:'+SEC  D
  1.  . N DA,DIE,DR
  1.  . ; IF ITEM IS ON THAT SECONDARY, LOCK & UPDATE NAME
  1.  . I $D(^PRCP(445,SEC,1,ITEMDA)) D
  1.  . . L +^PRCP(445,SEC,1,ITEMDA):2
  1.  . . W !,$J($P(^PRCP(445,SEC,0),"^",1),35)
  1.  . . I '$T W "  In use, could not update." Q
  1.  . . S DIE="^PRCP(445,"_SEC_",1,"
  1.  . . S DA=ITEMDA
  1.  . . S DR=".7////^S X=DES"
  1.  . . D ^DIE K DIE
  1.  . . W "  DESCRIPTION updated"
  1.  . . D BLDSEG^PRCPHLFM(3,ITEMDA,SEC) ; notify supply station of update
  1.  . . L -^PRCP(445,SEC,1,ITEMDA)
  1.  Q