90 lines
3.1 KiB
Mathematica
90 lines
3.1 KiB
Mathematica
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
|