source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPEITF.m@ 1010

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