- XU8P608 ;IRMFO-ALB/CJM - Kernel Lock Manager ;11/28/2012
- ;;8.0;KERNEL;**608**;JUL 10, 1995;Build 84
- ;;
- ;
- ; ******************************************************************
- ; * *
- ; * The Kernel Lock Manager is based on the VistA Lock Manager *
- ; * developed by Tommy Martin. *
- ; * *
- ; ******************************************************************
- ;
- POST ;
- ;D PATCH^ZTMGRSET(608)
- D INPUT2
- Q
- INPUT1 ;
- ;Not needed - replaced by patch xu*8.0*607
- N LINE,OFFSET,LOCKIEN,SUBIEN,RTN
- S RTN="XU8P608A"
- S OFFSET=1
- F S LINE=$T(LOCKS+OFFSET^@RTN) Q:'$L(LINE) Q:$P(LINE,";;",2)="EXIT" S OFFSET=OFFSET+1 D
- .I $P(LINE,";",3)="LOCK" S LOCKIEN=$$LOCK($P(LINE,";",4,99)) Q:LOCKIEN I 'LOCKIEN D BMES^XPDUTL("Failed to create an entry in the XULM LOCK DICTIONARY file for "_$P(LINE,";",4,99)) Q
- .Q:'LOCKIEN
- .I $P(LINE,";",3)="PACKAGE" D Q
- ..N PACKAGE,DATA
- ..S PACKAGE=$P(LINE,";",4)
- ..S PACKAGE=$O(^DIC(9.4,"B",PACKAGE,0))
- ..I PACKAGE S DATA(1.01)=PACKAGE D UPD^XULMU(8993,LOCKIEN,.DATA)
- .I $P(LINE,";",3)="PARTIAL MATCH OK?" D Q
- ..N DATA
- ..S DATA(1.03)=$P(LINE,";",4)
- ..D UPD^XULMU(8993,LOCKIEN,.DATA)
- .I $P(LINE,";",3)="USAGE" D Q
- ..S ^XLM(8993,LOCKIEN,4,0)=$P(LINE,";",4,99)
- ..N CNT S CNT=0
- ..F S LINE=$T(LOCKS+OFFSET^@RTN) Q:$E(LINE,2,4)'=";;;" D
- ...S OFFSET=OFFSET+1
- ...S LINE=$P(LINE,";;;",2,99)
- ...S CNT=CNT+1
- ...S ^XLM(8993,LOCKIEN,4,CNT,0)=LINE
- .I $P(LINE,";",3)="SUBSCRIPT" D Q
- ..N DA,DATA
- ..S LINE=$P(LINE,";",4,99)
- ..S DATA(.01)=$P(LINE,"^")
- ..S DATA(.02)=$P(LINE,"^",2)
- ..S DATA(.04)=$P(LINE,"^",4)
- ..S DA(1)=LOCKIEN
- ..S SUBIEN=$$ADD^XULMU(8993.02,.DA,.DATA)
- .I $P(LINE,";",3)="CHECK LOGIC" D
- ..S:LOCKIEN&SUBIEN ^XLM(8993,LOCKIEN,2,SUBIEN,1)=$P(LINE,";",4,99)
- .I $P(LINE,";",3)="FILE REFERENCE" D Q
- ..N DA,DATA
- ..S DATA(.01)=$P(LINE,";",4)
- ..S DA(1)=LOCKIEN
- ..S SUBIEN=$$ADD^XULMU(8993.03,.DA,.DATA)
- .I $P(LINE,";",3)="L" D
- ..N CODE,X
- ..S (CODE,X)=$P(LINE,";",4,99)
- ..D:$L(X) ^DIM
- ..I '$D(X) D BMES^XPDUTL("Failed syntax check:"),BMES^XPDUTL(CODE) Q
- ..S:LOCKIEN&SUBIEN ^XLM(8993,LOCKIEN,3,SUBIEN,1)=$G(X)
- .I $P(LINE,";",3)="REFERENCE DESCRIPTION" D Q
- ..S:SUBIEN&LOCKIEN ^XLM(8993,LOCKIEN,3,SUBIEN,2,0)=$P(LINE,";",4,99)
- ..N CNT S CNT=0
- ..F S LINE=$T(LOCKS+OFFSET^@RTN) Q:$E(LINE,2,4)'=";;;" D
- ...S OFFSET=OFFSET+1
- ...S LINE=$P(LINE,";;;",2,99)
- ...S CNT=CNT+1
- ...S:LOCKIEN&SUBIEN ^XLM(8993,LOCKIEN,3,SUBIEN,2,CNT,0)=LINE
- Q
- LOCK(LOCK) ;Deletes the old entry and adds a new one.
- N DATA,DA,QUIT,ERROR
- S QUIT=0
- S DATA(.01)=$P(LOCK,"^",2,99)
- S DATA(1.02)=$S($E(LOCK)="^":1,1:0)
- S DA=$O(^XLM(8993,"E",DATA(1.02),DATA(.01),0))
- I DA D DELETE^XULMU(8993,DA)
- Q $$ADD^XULMU(8993,,.DATA,.ERROR)
- ;
- K DATA
- F S LINE=$T(LOCKS+OFFSET^@RTN),OFFSET=OFFSET+1 D Q:QUIT
- .N DATA
- .I $P(LINE,";",3)="SUBSCRIPT" D Q
- ..N PARENT S PARENT=DA N DA
- ..S LINE=$P(LINE,";",4,99)
- ..S DATA(.01)=$P(LINE,"^")
- ..S DATA(.02)=$P(LINE,"^",2)
- ..S DATA(.04)=$P(LINE,"^",4)
- ..S DA(1)=PARENT
- ..S DA=$$ADD^XULMU(8993.02,.DA,.DATA)
- ..S LINE=$T(LOCKS+OFFSET^@RTN)
- .S OFFSET=OFFSET-1,QUIT=1
- Q
- ;
- INPUT2 ;Add system lock list to parameters
- N IEN,LOCK,RTN,OFFSET,TEXT,EXIT,SITE
- S EXIT=0
- S IEN=$O(^XLM(8993.1,0))
- I 'IEN D
- .N DATA
- .S SITE=+$$SITE^VASITE
- .I SITE<1 S SITE=$O(^XTV(8989.3,0)) I SITE S SITE=$P($G(^XTV(8989.3,SITE,"XUS")),"^",17)
- .I 'SITE S SITE="NOT YET ENTERED"
- .S DATA(.01)=SITE
- .S IEN=$$ADD^XULMU(8993.1,,.DATA)
- S RTN="XU8P608B"
- S OFFSET=1
- F S TEXT=$T(LOCKS+OFFSET^@RTN) Q:'$L(TEXT) Q:EXIT D
- .S LOCK=$P(TEXT,";;",2,99)
- .I LOCK="" S EXIT=1 Q
- .I LOCK="EXIT" S EXIT=1 Q
- .S OFFSET=OFFSET+1
- .Q:$D(^XLM(8993.1,"AC",LOCK))
- .N DATA,DA
- .S DA(1)=IEN
- .I $E(LOCK,1)="^" D
- ..S DATA(.01)=$P($P(LOCK,"^",2,99),"(")
- ..S DATA(.02)=$P(LOCK,"^",2,99)
- ..S DATA(.03)=1
- .E D
- ..S DATA(.01)=$P(LOCK,"(")
- ..S DATA(.02)=LOCK
- ..S DATA(.03)=0
- .D ADD^XULMU(8993.15,.DA,.DATA)
- ;
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P608 4155 printed Jan 18, 2025@03:09:35 Page 2
- XU8P608 ;IRMFO-ALB/CJM - Kernel Lock Manager ;11/28/2012
- +1 ;;8.0;KERNEL;**608**;JUL 10, 1995;Build 84
- +2 ;;
- +3 ;
- +4 ; ******************************************************************
- +5 ; * *
- +6 ; * The Kernel Lock Manager is based on the VistA Lock Manager *
- +7 ; * developed by Tommy Martin. *
- +8 ; * *
- +9 ; ******************************************************************
- +10 ;
- POST ;
- +1 ;D PATCH^ZTMGRSET(608)
- +2 DO INPUT2
- +3 QUIT
- INPUT1 ;
- +1 ;Not needed - replaced by patch xu*8.0*607
- +2 NEW LINE,OFFSET,LOCKIEN,SUBIEN,RTN
- +3 SET RTN="XU8P608A"
- +4 SET OFFSET=1
- +5 FOR
- SET LINE=$TEXT(LOCKS+OFFSET^@RTN)
- if '$LENGTH(LINE)
- QUIT
- if $PIECE(LINE,";;",2)="EXIT"
- QUIT
- SET OFFSET=OFFSET+1
- Begin DoDot:1
- +6 IF $PIECE(LINE,";",3)="LOCK"
- SET LOCKIEN=$$LOCK($PIECE(LINE,";",4,99))
- if LOCKIEN
- QUIT
- IF 'LOCKIEN
- DO BMES^XPDUTL("Failed to create an entry in the XULM LOCK DICTIONARY file for "_$PIECE(LINE,";",4,99))
- QUIT
- +7 if 'LOCKIEN
- QUIT
- +8 IF $PIECE(LINE,";",3)="PACKAGE"
- Begin DoDot:2
- +9 NEW PACKAGE,DATA
- +10 SET PACKAGE=$PIECE(LINE,";",4)
- +11 SET PACKAGE=$ORDER(^DIC(9.4,"B",PACKAGE,0))
- +12 IF PACKAGE
- SET DATA(1.01)=PACKAGE
- DO UPD^XULMU(8993,LOCKIEN,.DATA)
- End DoDot:2
- QUIT
- +13 IF $PIECE(LINE,";",3)="PARTIAL MATCH OK?"
- Begin DoDot:2
- +14 NEW DATA
- +15 SET DATA(1.03)=$PIECE(LINE,";",4)
- +16 DO UPD^XULMU(8993,LOCKIEN,.DATA)
- End DoDot:2
- QUIT
- +17 IF $PIECE(LINE,";",3)="USAGE"
- Begin DoDot:2
- +18 SET ^XLM(8993,LOCKIEN,4,0)=$PIECE(LINE,";",4,99)
- +19 NEW CNT
- SET CNT=0
- +20 FOR
- SET LINE=$TEXT(LOCKS+OFFSET^@RTN)
- if $EXTRACT(LINE,2,4)'=";;;"
- QUIT
- Begin DoDot:3
- +21 SET OFFSET=OFFSET+1
- +22 SET LINE=$PIECE(LINE,";;;",2,99)
- +23 SET CNT=CNT+1
- +24 SET ^XLM(8993,LOCKIEN,4,CNT,0)=LINE
- End DoDot:3
- End DoDot:2
- QUIT
- +25 IF $PIECE(LINE,";",3)="SUBSCRIPT"
- Begin DoDot:2
- +26 NEW DA,DATA
- +27 SET LINE=$PIECE(LINE,";",4,99)
- +28 SET DATA(.01)=$PIECE(LINE,"^")
- +29 SET DATA(.02)=$PIECE(LINE,"^",2)
- +30 SET DATA(.04)=$PIECE(LINE,"^",4)
- +31 SET DA(1)=LOCKIEN
- +32 SET SUBIEN=$$ADD^XULMU(8993.02,.DA,.DATA)
- End DoDot:2
- QUIT
- +33 IF $PIECE(LINE,";",3)="CHECK LOGIC"
- Begin DoDot:2
- +34 if LOCKIEN&SUBIEN
- SET ^XLM(8993,LOCKIEN,2,SUBIEN,1)=$PIECE(LINE,";",4,99)
- End DoDot:2
- +35 IF $PIECE(LINE,";",3)="FILE REFERENCE"
- Begin DoDot:2
- +36 NEW DA,DATA
- +37 SET DATA(.01)=$PIECE(LINE,";",4)
- +38 SET DA(1)=LOCKIEN
- +39 SET SUBIEN=$$ADD^XULMU(8993.03,.DA,.DATA)
- End DoDot:2
- QUIT
- +40 IF $PIECE(LINE,";",3)="L"
- Begin DoDot:2
- +41 NEW CODE,X
- +42 SET (CODE,X)=$PIECE(LINE,";",4,99)
- +43 if $LENGTH(X)
- DO ^DIM
- +44 IF '$DATA(X)
- DO BMES^XPDUTL("Failed syntax check:")
- DO BMES^XPDUTL(CODE)
- QUIT
- +45 if LOCKIEN&SUBIEN
- SET ^XLM(8993,LOCKIEN,3,SUBIEN,1)=$GET(X)
- End DoDot:2
- +46 IF $PIECE(LINE,";",3)="REFERENCE DESCRIPTION"
- Begin DoDot:2
- +47 if SUBIEN&LOCKIEN
- SET ^XLM(8993,LOCKIEN,3,SUBIEN,2,0)=$PIECE(LINE,";",4,99)
- +48 NEW CNT
- SET CNT=0
- +49 FOR
- SET LINE=$TEXT(LOCKS+OFFSET^@RTN)
- if $EXTRACT(LINE,2,4)'=";;;"
- QUIT
- Begin DoDot:3
- +50 SET OFFSET=OFFSET+1
- +51 SET LINE=$PIECE(LINE,";;;",2,99)
- +52 SET CNT=CNT+1
- +53 if LOCKIEN&SUBIEN
- SET ^XLM(8993,LOCKIEN,3,SUBIEN,2,CNT,0)=LINE
- End DoDot:3
- End DoDot:2
- QUIT
- End DoDot:1
- +54 QUIT
- LOCK(LOCK) ;Deletes the old entry and adds a new one.
- +1 NEW DATA,DA,QUIT,ERROR
- +2 SET QUIT=0
- +3 SET DATA(.01)=$PIECE(LOCK,"^",2,99)
- +4 SET DATA(1.02)=$SELECT($EXTRACT(LOCK)="^":1,1:0)
- +5 SET DA=$ORDER(^XLM(8993,"E",DATA(1.02),DATA(.01),0))
- +6 IF DA
- DO DELETE^XULMU(8993,DA)
- +7 QUIT $$ADD^XULMU(8993,,.DATA,.ERROR)
- +8 ;
- +9 KILL DATA
- +10 FOR
- SET LINE=$TEXT(LOCKS+OFFSET^@RTN)
- SET OFFSET=OFFSET+1
- Begin DoDot:1
- +11 NEW DATA
- +12 IF $PIECE(LINE,";",3)="SUBSCRIPT"
- Begin DoDot:2
- +13 NEW PARENT
- SET PARENT=DA
- NEW DA
- +14 SET LINE=$PIECE(LINE,";",4,99)
- +15 SET DATA(.01)=$PIECE(LINE,"^")
- +16 SET DATA(.02)=$PIECE(LINE,"^",2)
- +17 SET DATA(.04)=$PIECE(LINE,"^",4)
- +18 SET DA(1)=PARENT
- +19 SET DA=$$ADD^XULMU(8993.02,.DA,.DATA)
- +20 SET LINE=$TEXT(LOCKS+OFFSET^@RTN)
- End DoDot:2
- QUIT
- +21 SET OFFSET=OFFSET-1
- SET QUIT=1
- End DoDot:1
- if QUIT
- QUIT
- +22 QUIT
- +23 ;
- INPUT2 ;Add system lock list to parameters
- +1 NEW IEN,LOCK,RTN,OFFSET,TEXT,EXIT,SITE
- +2 SET EXIT=0
- +3 SET IEN=$ORDER(^XLM(8993.1,0))
- +4 IF 'IEN
- Begin DoDot:1
- +5 NEW DATA
- +6 SET SITE=+$$SITE^VASITE
- +7 IF SITE<1
- SET SITE=$ORDER(^XTV(8989.3,0))
- IF SITE
- SET SITE=$PIECE($GET(^XTV(8989.3,SITE,"XUS")),"^",17)
- +8 IF 'SITE
- SET SITE="NOT YET ENTERED"
- +9 SET DATA(.01)=SITE
- +10 SET IEN=$$ADD^XULMU(8993.1,,.DATA)
- End DoDot:1
- +11 SET RTN="XU8P608B"
- +12 SET OFFSET=1
- +13 FOR
- SET TEXT=$TEXT(LOCKS+OFFSET^@RTN)
- if '$LENGTH(TEXT)
- QUIT
- if EXIT
- QUIT
- Begin DoDot:1
- +14 SET LOCK=$PIECE(TEXT,";;",2,99)
- +15 IF LOCK=""
- SET EXIT=1
- QUIT
- +16 IF LOCK="EXIT"
- SET EXIT=1
- QUIT
- +17 SET OFFSET=OFFSET+1
- +18 if $DATA(^XLM(8993.1,"AC",LOCK))
- QUIT
- +19 NEW DATA,DA
- +20 SET DA(1)=IEN
- +21 IF $EXTRACT(LOCK,1)="^"
- Begin DoDot:2
- +22 SET DATA(.01)=$PIECE($PIECE(LOCK,"^",2,99),"(")
- +23 SET DATA(.02)=$PIECE(LOCK,"^",2,99)
- +24 SET DATA(.03)=1
- End DoDot:2
- +25 IF '$TEST
- Begin DoDot:2
- +26 SET DATA(.01)=$PIECE(LOCK,"(")
- +27 SET DATA(.02)=LOCK
- +28 SET DATA(.03)=0
- End DoDot:2
- +29 DO ADD^XULMU(8993.15,.DA,.DATA)
- End DoDot:1
- +30 ;
- +31 QUIT
- +32 ;