| [613] | 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
 | 
|---|