| 1 | PRCPULOC ;WISC/RFJ-lock file management utilites ;20 Sep 91
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | SHOWWHO(FILE,DA1,DA) ; show who has file locked
|
|---|
| 8 | ; da1=invpt,da=item
|
|---|
| 9 | N DATA,ENTRY,LOCKDA,USER,Y
|
|---|
| 10 | S ENTRY=FILE_"-"_DA1
|
|---|
| 11 | I DA S ENTRY=ENTRY_"-"_DA
|
|---|
| 12 | S FILE=$S(FILE=445:"INVENTORY POINT",FILE=445.3:"DISTRIBUTION ORDER",FILE=445.7:"CASE CART",FILE=445.8:"INSTRUMENT KIT",FILE=410:"ISSUE BOOK/2237",FILE=442:"PURCHASE ORDER",1:"FILE")
|
|---|
| 13 | S FILE=$S(FILE=410.3:"REPETITIVE ITEM LIST",1:FILE)
|
|---|
| 14 | W !,"ANOTHER USER IS WORKING WITH THIS ",FILE,"."
|
|---|
| 15 | S LOCKDA=+$O(^PRCP(447,"B",ENTRY,0)),DATA=$G(^PRCP(447,LOCKDA,0))
|
|---|
| 16 | I DATA="" W !?8,"USER AND PROCESS IS UNKNOWN." Q
|
|---|
| 17 | S USER=$$USER^PRCPUREP(+$P(DATA,"^",2)),Y=$P(DATA,"^",3) D DD^%DT
|
|---|
| 18 | I $P(DATA,"^",4)="" S $P(DATA,"^",4)="UNKNOWN"
|
|---|
| 19 | W !?8,"USER : ",USER," ON: ",Y,!?8,"PROCESS: ",$P(DATA,"^",4)
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | ;
|
|---|
| 23 | ADD(FILE,DA1,DA,PROCESS) ; add lock entry to lock management
|
|---|
| 24 | N %,%H,%I,ENTRY,LOCKDA,PRCPPRIV,X
|
|---|
| 25 | S ENTRY=FILE_"-"_DA1,PRCPPRIV=1
|
|---|
| 26 | I DA S ENTRY=ENTRY_"-"_DA
|
|---|
| 27 | S LOCKDA=+$O(^PRCP(447,"B",ENTRY,0))
|
|---|
| 28 | I 'LOCKDA D
|
|---|
| 29 | . N D0,DA,DD,DIC,DIE,DLAYGO,X,Y
|
|---|
| 30 | . S DIC="^PRCP(447,",DIC(0)="L",DLAYGO=447,X=ENTRY
|
|---|
| 31 | . D FILE^DICN S LOCKDA=+Y
|
|---|
| 32 | I '$D(^PRCP(447,LOCKDA,0)) Q
|
|---|
| 33 | D NOW^%DTC
|
|---|
| 34 | S $P(^PRCP(447,LOCKDA,0),"^",2,4)=DUZ_"^"_%_"^"_PROCESS
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | ;
|
|---|
| 38 | CLEAR(FILE,DA1,DA) ; clear entry from file
|
|---|
| 39 | N %,DIC,DIK,ENTRY,X,Y
|
|---|
| 40 | S ENTRY=FILE_"-"_DA1
|
|---|
| 41 | I DA S ENTRY=ENTRY_"-"_DA
|
|---|
| 42 | S DA=+$O(^PRCP(447,"B",ENTRY,0)) I 'DA Q
|
|---|
| 43 | S DIK="^PRCP(447,"
|
|---|
| 44 | D ^DIK
|
|---|
| 45 | Q
|
|---|
