PRCPULOC ;WISC/RFJ-lock file management utilites ;20 Sep 91
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
SHOWWHO(FILE,DA1,DA) ; show who has file locked
; da1=invpt,da=item
N DATA,ENTRY,LOCKDA,USER,Y
S ENTRY=FILE_"-"_DA1
I DA S ENTRY=ENTRY_"-"_DA
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")
S FILE=$S(FILE=410.3:"REPETITIVE ITEM LIST",1:FILE)
W !,"ANOTHER USER IS WORKING WITH THIS ",FILE,"."
S LOCKDA=+$O(^PRCP(447,"B",ENTRY,0)),DATA=$G(^PRCP(447,LOCKDA,0))
I DATA="" W !?8,"USER AND PROCESS IS UNKNOWN." Q
S USER=$$USER^PRCPUREP(+$P(DATA,"^",2)),Y=$P(DATA,"^",3) D DD^%DT
I $P(DATA,"^",4)="" S $P(DATA,"^",4)="UNKNOWN"
W !?8,"USER : ",USER," ON: ",Y,!?8,"PROCESS: ",$P(DATA,"^",4)
Q
;
;
ADD(FILE,DA1,DA,PROCESS) ; add lock entry to lock management
N %,%H,%I,ENTRY,LOCKDA,PRCPPRIV,X
S ENTRY=FILE_"-"_DA1,PRCPPRIV=1
I DA S ENTRY=ENTRY_"-"_DA
S LOCKDA=+$O(^PRCP(447,"B",ENTRY,0))
I 'LOCKDA D
. N D0,DA,DD,DIC,DIE,DLAYGO,X,Y
. S DIC="^PRCP(447,",DIC(0)="L",DLAYGO=447,X=ENTRY
. D FILE^DICN S LOCKDA=+Y
I '$D(^PRCP(447,LOCKDA,0)) Q
D NOW^%DTC
S $P(^PRCP(447,LOCKDA,0),"^",2,4)=DUZ_"^"_%_"^"_PROCESS
Q
;
;
CLEAR(FILE,DA1,DA) ; clear entry from file
N %,DIC,DIK,ENTRY,X,Y
S ENTRY=FILE_"-"_DA1
I DA S ENTRY=ENTRY_"-"_DA
S DA=+$O(^PRCP(447,"B",ENTRY,0)) I 'DA Q
S DIK="^PRCP(447,"
D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPULOC 1610 printed Nov 22, 2024@17:26:19 Page 2
PRCPULOC ;WISC/RFJ-lock file management utilites ;20 Sep 91
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
SHOWWHO(FILE,DA1,DA) ; show who has file locked
+1 ; da1=invpt,da=item
+2 NEW DATA,ENTRY,LOCKDA,USER,Y
+3 SET ENTRY=FILE_"-"_DA1
+4 IF DA
SET ENTRY=ENTRY_"-"_DA
+5 SET FILE=$SELECT(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")
+6 SET FILE=$SELECT(FILE=410.3:"REPETITIVE ITEM LIST",1:FILE)
+7 WRITE !,"ANOTHER USER IS WORKING WITH THIS ",FILE,"."
+8 SET LOCKDA=+$ORDER(^PRCP(447,"B",ENTRY,0))
SET DATA=$GET(^PRCP(447,LOCKDA,0))
+9 IF DATA=""
WRITE !?8,"USER AND PROCESS IS UNKNOWN."
QUIT
+10 SET USER=$$USER^PRCPUREP(+$PIECE(DATA,"^",2))
SET Y=$PIECE(DATA,"^",3)
DO DD^%DT
+11 IF $PIECE(DATA,"^",4)=""
SET $PIECE(DATA,"^",4)="UNKNOWN"
+12 WRITE !?8,"USER : ",USER," ON: ",Y,!?8,"PROCESS: ",$PIECE(DATA,"^",4)
+13 QUIT
+14 ;
+15 ;
ADD(FILE,DA1,DA,PROCESS) ; add lock entry to lock management
+1 NEW %,%H,%I,ENTRY,LOCKDA,PRCPPRIV,X
+2 SET ENTRY=FILE_"-"_DA1
SET PRCPPRIV=1
+3 IF DA
SET ENTRY=ENTRY_"-"_DA
+4 SET LOCKDA=+$ORDER(^PRCP(447,"B",ENTRY,0))
+5 IF 'LOCKDA
Begin DoDot:1
+6 NEW D0,DA,DD,DIC,DIE,DLAYGO,X,Y
+7 SET DIC="^PRCP(447,"
SET DIC(0)="L"
SET DLAYGO=447
SET X=ENTRY
+8 DO FILE^DICN
SET LOCKDA=+Y
End DoDot:1
+9 IF '$DATA(^PRCP(447,LOCKDA,0))
QUIT
+10 DO NOW^%DTC
+11 SET $PIECE(^PRCP(447,LOCKDA,0),"^",2,4)=DUZ_"^"_%_"^"_PROCESS
+12 QUIT
+13 ;
+14 ;
CLEAR(FILE,DA1,DA) ; clear entry from file
+1 NEW %,DIC,DIK,ENTRY,X,Y
+2 SET ENTRY=FILE_"-"_DA1
+3 IF DA
SET ENTRY=ENTRY_"-"_DA
+4 SET DA=+$ORDER(^PRCP(447,"B",ENTRY,0))
IF 'DA
QUIT
+5 SET DIK="^PRCP(447,"
+6 DO ^DIK
+7 QUIT
