EDPBLK ;SLC/KCM - Handle locking for configuration ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
;
READL(AREA,PART,TOKEN) ; lock for reading
N DAY,SEQ
S DAY=$$INITLOCK
L +^XTMP("EDP-LOCK-"_DAY,AREA,PART):10 E Q ""
S SEQ=+$G(^XTMP("EDP-LOCK-"_DAY,AREA,PART,"READ"))+1
S ^XTMP("EDP-LOCK-"_DAY,AREA,PART,"READ")=SEQ
S TOKEN=DAY_"-"_SEQ
Q
READU(AREA,PART,TOKEN) ; unlock for reading
Q:$G(TOKEN)=""
L -^XTMP("EDP-LOCK-"_$P(TOKEN,"-"),AREA,PART)
Q
INITLOCK() ; returns lock table id, initializing new table if necessary
S DAY=+$H
I '$D(^XTMP("EDP-LOCK-"_DAY,0)) D
. S ^XTMP("EDP-LOCK-"_DAY,0)=$$FMADD^XLFDT(DT,2)_U_DT_U_"ED Locks"
. N X S X=DAY-3 ; delete any older than 3 days
. F S X=$O(^XTMP("EDP-LOCK-"_X),-1) Q:$E(X,1,8)'="EDP-LOCK" D
. . S X=$P(X,"-",3)
. . K ^XTMP("EDP-LOCK-"_X)
Q DAY
;
SAVEL(AREA,PART,TOKEN,ERR) ; lock for saving configuration
; ERR is return, empty if successful, message if lock fails
; TOKEN is returned with save token, contains read token initially
S ERR=""
I '$L(TOKEN) S ERR="Unable to update with empty token" Q
;
; extract from token the time of the GET
N GDAY,GSEQ
S GDAY=$P(TOKEN,"-"),GSEQ=$P(TOKEN,"-",2)
;
; lock out all reads during the update
N DAY
S DAY=$$INITLOCK
L +^XTMP("EDP-LOCK-"_DAY,AREA,PART):10 E S ERR="Unable to obtain lock" Q
;
; look backwards for interfering updates since GET
N COLLIDE,SEQ,X,Y
S COLLIDE="",X="EDP-LOCK-?"
F S X=$O(^XTMP(X),-1) Q:$E(X,1,8)'="EDP-LOCK" Q:$P(X,"-",3)<GDAY D
. S Y=$O(^XTMP(X,AREA,PART,"SAVE"," "),-1) Q:'Y ; no puts
. I (GDAY=$P(X,"-",3)),(Y<GSEQ) Q ; put earlier than get token
. S COLLIDE=^XTMP(X,AREA,PART,"SAVE",Y)
;
I COLLIDE D
. L -^XTMP("EDP-LOCK-"_DAY,AREA,PART)
. I COLLIDE=TOKEN S ERR="These changes have already been saved." Q
. S ERR="Only one person should edit the configuration at a time. "
. S ERR=ERR_"The configuration has been modified since you began. "
. S ERR=ERR_"You will need to re-enter the changes you have made."
E D
. S SEQ=+$G(^XTMP("EDP-LOCK-"_DAY,AREA,PART,"READ"))+1
. S ^XTMP("EDP-LOCK-"_DAY,AREA,PART,"READ")=SEQ
. S ^XTMP("EDP-LOCK-"_DAY,AREA,PART,"SAVE",SEQ)=TOKEN
. S TOKEN=DAY_"-"_SEQ
;
; return & do the actual update now, unlocking afterwards
Q
SAVEU(AREA,PART,TOKEN) ; Unlock for saving
L -^XTMP("EDP-LOCK-"_$P(TOKEN,"-"),AREA,PART)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPBLK 2433 printed Nov 22, 2024@17:01:43 Page 2
EDPBLK ;SLC/KCM - Handle locking for configuration ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
+2 ;
READL(AREA,PART,TOKEN) ; lock for reading
+1 NEW DAY,SEQ
+2 SET DAY=$$INITLOCK
+3 LOCK +^XTMP("EDP-LOCK-"_DAY,AREA,PART):10
IF '$TEST
QUIT ""
+4 SET SEQ=+$GET(^XTMP("EDP-LOCK-"_DAY,AREA,PART,"READ"))+1
+5 SET ^XTMP("EDP-LOCK-"_DAY,AREA,PART,"READ")=SEQ
+6 SET TOKEN=DAY_"-"_SEQ
+7 QUIT
READU(AREA,PART,TOKEN) ; unlock for reading
+1 if $GET(TOKEN)=""
QUIT
+2 LOCK -^XTMP("EDP-LOCK-"_$PIECE(TOKEN,"-"),AREA,PART)
+3 QUIT
INITLOCK() ; returns lock table id, initializing new table if necessary
+1 SET DAY=+$HOROLOG
+2 IF '$DATA(^XTMP("EDP-LOCK-"_DAY,0))
Begin DoDot:1
+3 SET ^XTMP("EDP-LOCK-"_DAY,0)=$$FMADD^XLFDT(DT,2)_U_DT_U_"ED Locks"
+4 ; delete any older than 3 days
NEW X
SET X=DAY-3
+5 FOR
SET X=$ORDER(^XTMP("EDP-LOCK-"_X),-1)
if $EXTRACT(X,1,8)'="EDP-LOCK"
QUIT
Begin DoDot:2
+6 SET X=$PIECE(X,"-",3)
+7 KILL ^XTMP("EDP-LOCK-"_X)
End DoDot:2
End DoDot:1
+8 QUIT DAY
+9 ;
SAVEL(AREA,PART,TOKEN,ERR) ; lock for saving configuration
+1 ; ERR is return, empty if successful, message if lock fails
+2 ; TOKEN is returned with save token, contains read token initially
+3 SET ERR=""
+4 IF '$LENGTH(TOKEN)
SET ERR="Unable to update with empty token"
QUIT
+5 ;
+6 ; extract from token the time of the GET
+7 NEW GDAY,GSEQ
+8 SET GDAY=$PIECE(TOKEN,"-")
SET GSEQ=$PIECE(TOKEN,"-",2)
+9 ;
+10 ; lock out all reads during the update
+11 NEW DAY
+12 SET DAY=$$INITLOCK
+13 LOCK +^XTMP("EDP-LOCK-"_DAY,AREA,PART):10
IF '$TEST
SET ERR="Unable to obtain lock"
QUIT
+14 ;
+15 ; look backwards for interfering updates since GET
+16 NEW COLLIDE,SEQ,X,Y
+17 SET COLLIDE=""
SET X="EDP-LOCK-?"
+18 FOR
SET X=$ORDER(^XTMP(X),-1)
if $EXTRACT(X,1,8)'="EDP-LOCK"
QUIT
if $PIECE(X,"-",3)<GDAY
QUIT
Begin DoDot:1
+19 ; no puts
SET Y=$ORDER(^XTMP(X,AREA,PART,"SAVE"," "),-1)
if 'Y
QUIT
+20 ; put earlier than get token
IF (GDAY=$PIECE(X,"-",3))
IF (Y<GSEQ)
QUIT
+21 SET COLLIDE=^XTMP(X,AREA,PART,"SAVE",Y)
End DoDot:1
+22 ;
+23 IF COLLIDE
Begin DoDot:1
+24 LOCK -^XTMP("EDP-LOCK-"_DAY,AREA,PART)
+25 IF COLLIDE=TOKEN
SET ERR="These changes have already been saved."
QUIT
+26 SET ERR="Only one person should edit the configuration at a time. "
+27 SET ERR=ERR_"The configuration has been modified since you began. "
+28 SET ERR=ERR_"You will need to re-enter the changes you have made."
End DoDot:1
+29 IF '$TEST
Begin DoDot:1
+30 SET SEQ=+$GET(^XTMP("EDP-LOCK-"_DAY,AREA,PART,"READ"))+1
+31 SET ^XTMP("EDP-LOCK-"_DAY,AREA,PART,"READ")=SEQ
+32 SET ^XTMP("EDP-LOCK-"_DAY,AREA,PART,"SAVE",SEQ)=TOKEN
+33 SET TOKEN=DAY_"-"_SEQ
End DoDot:1
+34 ;
+35 ; return & do the actual update now, unlocking afterwards
+36 QUIT
SAVEU(AREA,PART,TOKEN) ; Unlock for saving
+1 LOCK -^XTMP("EDP-LOCK-"_$PIECE(TOKEN,"-"),AREA,PART)
+2 QUIT
