PRCPULOC.m

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 ---PRCPULOC   1610     printed  Apr 09, 2024@21:07:28                                                                                                                                                                                                    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