- 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 Mar 13, 2025@20:56:15 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
