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

Last change on this file since 1365 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.1 KB
Line 
1PRCPEITF ;WISC/RFJ-enter/edit inventory items ;01 Dec 93
2V ;;5.1;IFCAP;**1**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7DESCRIP(PRCPINPT,ITEMDA,PRCPQUIT) ; edit item description
8 ;
9 ; PRCPINPT = inventory point
10 ; ITEMDA = item ien
11 ; PRCPQUIT = flag if user aborts/times-out
12 ;
13 N PRCPNM
14 ; because this is sometimes called from templates, new FileMan variables
15 N D,D0,D1,D2,D3,D4,D5,D6,DA,DB,DC,DD,DE,DG,DH,DI,DIA,DIADD,DIC,DICR,DIE
16 N DIEC,DIEL,DIFLD,DIK,DIOV,DIR,DK,DL,DLAYGO,DM,DO,DOV,DP,DR,DQ,DU,DV,DW
17 N I,J,X,Y
18 I '$D(^PRCP(445,PRCPINPT,1,ITEMDA)) Q
19 S PRCPNM=$P(^PRCP(445,PRCPINPT,0),"^",1)
20 D I $D(DUOUT)!$D(DTOUT) Q
21 . N VALUE
22 . S DIR(0)="445.01,.7^^",DA(1)=PRCPINPT,DA=ITEMDA
23 . D ^DIR K DIR
24 . S VALUE=Y
25 . I $D(DTOUT)!$D(DUOUT) S PRCPQUIT=1 Q
26 . S DA=ITEMDA,DIE="^PRCP(445,"_PRCPINPT_",1,",DR=".7///^S X=VALUE",PRCPPRIV=1
27 . D ^DIE K PRCPPRIV,DIE
28 . S VALUE=$P($G(^PRCP(445,PRCPINPT,1,ITEMDA,6)),"^",1)
29 . I $P(^PRCP(445,PRCPINPT,0),"^",3)="P",PRCPNM]"",VALUE]"",PRCPNM'=VALUE D
30 . . D POPDESC(PRCPINPT,ITEMDA)
31 Q
32 ;
33 ;
34DESDEF(PRCPINPT,ITEMDA) ; get default for item description
35 ; ITEMDA = item number requiring the default description
36 ; PRCPINPT = inventory point
37 ; returns name to use for default
38 ;
39 ; Note: The inventory point must be locked at least at
40 ; the item level prior to calling this routine
41 ;
42 N DES,PRCPPRIM,PRCPTYPE
43 S DES=""
44 S PRCPTYPE=$P($G(^PRCP(445,PRCPINPT,0)),"^",3)
45 I PRCPTYPE'="S" D
46 . S DES=$P($G(^PRC(441,ITEMDA,0)),"^",2)
47 . S $P(^PRCP(445,PRCPINPT,1,ITEMDA,6),"^")=DES
48 . W !!?5,"...item description set to short description in item master file."
49 I PRCPTYPE="S" D
50 . S PRCPPRIM=0
51 . S PRCPPRIM=$O(^PRCP(445,"AB",+PRCPINPT,PRCPPRIM))
52 . S DES=$P($G(^PRCP(445,PRCPPRIM,1,ITEMDA,6)),"^",1)
53 . S $P(^PRCP(445,PRCPINPT,1,ITEMDA,6),"^")=DES
54 . W !!?5,"...item description set to short description in primary."
55 Q (DES)
56 ;
57 ;
58POPDESC(PRCPINPT,ITEMDA) ; ask user if item description should be used in secondaries
59 ; ITEMDA = item number requiring the default description
60 ; PRCPINPT = inventory point
61 ;
62 N DES,PRCPRNM,SEC
63 S PRCPPRNM=$P(^PRCP(445,PRCPINPT,0),"^",1)
64 ;ASK USER IF THEY WISH TO UPDATE ALL SECONDARIES
65 S XP=" Do you want to update the DESCRIPTION for ALL distribution"
66 S XP(1)=" points stocked by "_PRCPPRNM
67 S XH=" Enter 'YES' only if you want to change the DESCRIPTION at ALL"
68 S XH(1)=" DISTRIBUTION points to be the same as for the "_PRCPPRNM
69 S XH(2)=" procurement source."
70 I $$YN^PRCPUYN("")'=1 Q
71 ; IF YES DO
72 W !!,"updating DESCRIPTION for distribution points....."
73 S DES=$P(^PRCP(445,PRCPINPT,1,ITEMDA,6),"^",1)
74 ; LOOK AT NODE 2 OF PRIMARY
75 S SEC=0 F S SEC=$O(^PRCP(445,PRCPINPT,2,SEC)) Q:'+SEC D
76 . N DA,DIE,DR
77 . ; IF ITEM IS ON THAT SECONDARY, LOCK & UPDATE NAME
78 . I $D(^PRCP(445,SEC,1,ITEMDA)) D
79 . . L +^PRCP(445,SEC,1,ITEMDA):2
80 . . W !,$J($P(^PRCP(445,SEC,0),"^",1),35)
81 . . I '$T W " In use, could not update." Q
82 . . S DIE="^PRCP(445,"_SEC_",1,"
83 . . S DA=ITEMDA
84 . . S DR=".7////^S X=DES"
85 . . D ^DIE K DIE
86 . . W " DESCRIPTION updated"
87 . . D BLDSEG^PRCPHLFM(3,ITEMDA,SEC) ; notify supply station of update
88 . . L -^PRCP(445,SEC,1,ITEMDA)
89 Q
Note: See TracBrowser for help on using the repository browser.