- XULMUI ;IRMFO-ALB/CJM/SWO/RGG - KERNEL LOCK MANAGER ;10/24/2012
- ;;8.0;KERNEL;**608**;JUL 10, 1995;Build 84
- ;;Per VA Directive 6402, this routine should not be modified
- ;
- ; ******************************************************************
- ; * *
- ; * The Kernel Lock Manager is based on the VistA Lock Manager *
- ; * developed by Tommy Martin. *
- ; * *
- ; ******************************************************************
- ;
- ;
- REFRESH ;
- K @LOCKS,@IDX
- Q:'$$GETLOCKS^XULM(.XUPARMS)
- I $D(XUPARMS("LAST ACTION")) D
- .D @XUPARMS("LAST ACTION")
- E D BYPAT
- Q
- BYLOCK ; display user locks sorted by lock
- N LOCK,XUTOPIC
- S XUTOPIC="LOCK"
- S XUPARMS("LAST ACTION")="BYLOCK^XULMUI"
- S VALMCNT=0
- D CLEAN^VALM10
- S VALMBG=1
- S VALMSG="User Locks Sorted by Lock ["_$S($L($G(XUPARMS("SELECTED NODE"))):$$LAST8(XUPARMS("SELECTED NODE")),1:"ALL NODES")_"]"
- D HDR("Lock",35,"Node",8,"User",13,"Patient",25)
- S LOCK=""
- F S LOCK=$O(@LOCKS@(LOCK)) Q:LOCK="" D
- .N NODE
- .S NODE=""
- .F S NODE=$O(@LOCKS@(LOCK,NODE)) Q:NODE="" Q:$D(XUPARMS("SELECTED NODE"))&'(NODE=$G(XUPARMS("SELECTED NODE"))) I '$G(@LOCKS@(LOCK,NODE,"SYSTEM")) D
- ..D NEWENTRY(LOCK,NODE,LOCK,35,$$LAST8(NODE),8,$P(@LOCKS@(LOCK,NODE,"OWNER"),"^",2),13,$$GETID(LOCK,NODE,2),25)
- ;
- S VALMBCK="R"
- Q
- ;
- SYSTEM ; display system locks sorted by lock
- N LOCK
- I '$$KCHK^XUSRB("XULM SYSTEM LOCKS") D Q
- . W *7,!!!,?10,"***You are not authorized to view SYSTEM LOCKS***" H 5
- . S VALMBCK="R"
- S XUPARMS("LAST ACTION")="SYSTEM^XULMUI"
- S XUTOPIC="LOCK"
- S VALMCNT=0
- D CLEAN^VALM10
- S VALMBG=1
- S VALMSG="System Locks Sorted by Lock ["_$S($L($G(XUPARMS("SELECTED NODE"))):$$LAST8(XUPARMS("SELECTED NODE")),1:"ALL NODES")_"]"
- D HDR("Lock",50,"Node",8,"User",15)
- S LOCK=""
- F S LOCK=$O(@LOCKS@(LOCK)) Q:LOCK="" D
- .N NODE
- .S NODE=""
- .F S NODE=$O(@LOCKS@(LOCK,NODE)) Q:NODE="" Q:$D(XUPARMS("SELECTED NODE"))&'(NODE=$G(XUPARMS("SELECTED NODE"))) I $G(@LOCKS@(LOCK,NODE,"SYSTEM")) D
- ..D NEWENTRY(LOCK,NODE,LOCK,50,$$LAST8(NODE),8,$P(@LOCKS@(LOCK,NODE,"OWNER"),"^",2),15)
- ;
- S VALMBCK="R"
- Q
- ;
- GOTO ;Jumps to a location on the screen
- S VALMBG=$$ASKWHERE(XUTOPIC)
- S VALMBCK="R"
- Q
- ;
- BYUSER ; display list sorted by user
- N LOCK,USER
- S XUPARMS("LAST ACTION")="BYUSER^XULMUI"
- S XUTOPIC="USER"
- D HDR("User",14,"Lock",33,"Node",8,"Patient",25)
- S VALMCNT=0
- S VALMBG=1
- D CLEAN^VALM10
- S VALMSG="User Locks Sorted by User Name ["_$S($L($G(XUPARMS("SELECTED NODE"))):$$LAST8(XUPARMS("SELECTED NODE")),1:"ALL NODES")_"]"
- S USER=""
- ;
- F S USER=$O(@IDX@("OWNER",USER)) Q:USER="" D
- .S LOCK=""
- .F S LOCK=$O(@IDX@("OWNER",USER,LOCK)) Q:LOCK="" D
- ..N NODE
- ..S NODE=""
- ..F S NODE=$O(@IDX@("OWNER",USER,LOCK,NODE)) Q:NODE="" Q:$D(XUPARMS("SELECTED NODE"))&'(NODE=$G(XUPARMS("SELECTED NODE"))) Q:$G(@LOCKS@(LOCK,NODE,"SYSTEM")) D
- ...D NEWENTRY(LOCK,NODE,$P(@LOCKS@(LOCK,NODE,"OWNER"),"^",2),14,LOCK,33,$$LAST8(NODE),8,$$GETID(LOCK,NODE,2),25)
- S VALMBCK="R"
- Q
- ;
- BYPAT ; display list sorted by Patient
- N LOCK,USER,PAT
- S XUPARMS("LAST ACTION")="BYPAT^XULMUI"
- S XUTOPIC="PATIENT"
- D HDR("Patient",15,"Lock",33,"Node",8,"User",15)
- S VALMCNT=0
- S VALMBG=1
- D CLEAN^VALM10
- K @IDX@("FILE/ID")
- S VALMSG="User Locks Sorted by Patient Name ["_$S($L($G(XUPARMS("SELECTED NODE"))):$$LAST8(XUPARMS("SELECTED NODE")),1:"ALL NODES")_"]"
- S LOCK=""
- F S LOCK=$O(@LOCKS@(LOCK)) Q:LOCK="" D
- .S NODE=""
- .F S NODE=$O(@LOCKS@(LOCK,NODE)) Q:NODE="" Q:NODE="" Q:$D(XUPARMS("SELECTED NODE"))&'(NODE=$G(XUPARMS("SELECTED NODE"))) I '$G(@LOCKS@(LOCK,NODE,"SYSTEM")) D
- ..S PAT=$$GETID(LOCK,NODE,2) S:PAT="" PAT="{?}"
- ..S @IDX@("FILE/ID",PAT,LOCK,NODE)=""
- S PAT=""
- F S PAT=$O(@IDX@("FILE/ID",PAT)) Q:PAT="" D
- .S LOCK=""
- .F S LOCK=$O(@IDX@("FILE/ID",PAT,LOCK)) Q:LOCK="" D
- ..N NODE
- ..S NODE=""
- ..F S NODE=$O(@IDX@("FILE/ID",PAT,LOCK,NODE)) Q:NODE="" Q:$D(XUPARMS("SELECTED NODE"))&'(NODE=$G(XUPARMS("SELECTED NODE"))) D
- ...D NEWENTRY(LOCK,NODE,PAT,15,LOCK,33,$$LAST8(NODE),8,$P(@LOCKS@(LOCK,NODE,"OWNER"),"^",2),25)
- S VALMBCK="R"
- Q
- ;
- SLCTFILE() ;Select a file reference to screen locks by
- D FULL^VALM1
- W !
- N NAME,FILE,I,FILES
- S (FILE,I)=0
- F S FILE=$O(@IDX@("FILE",FILE)) Q:'FILE D
- .S NAME=$P($G(^DIC(FILE,0)),"^")
- .I $L(NAME) D
- ..S I=I+1
- ..S FILES(I)=FILE
- ..W !,$$LJ("("_I_")",8),NAME," File (#"_FILE_")"
- I 'I D PAUSE^XULMU("There are no file references available!") Q 0
- W !
- S DIR(0)="NO^"_1_":"_I_":0"
- S DIR("A")="Select a file from the list: "
- I I>0 S DIR("B")=1
- S DIR("?")="Enter the number of an entry on the screen to select a file."
- D ^DIR
- ;
- I +Y Q $G(FILES(+Y))
- Q 0
- ;
- BYFILE(FILE) ; Display locks that have a computable references to a particular file
- N LOCK,USER
- S XUPARMS("LAST ACTION")="BYFILE^XULMUI("_FILE_")"
- I FILE D
- .N FID
- .S XUTOPIC="PATIENT"
- .D CLEAN^VALM10
- .D HDR("Patient",15,"User",14,"Node",8,"LOCK",60)
- .S VALMSG="User Locks Related to the "_$P($G(^DIC(FILE,0)),"^")_" File"
- .K @IDX@("FILE/ID")
- .S VALMCNT=0
- .S VALMBG=1
- .S LOCK=""
- .F S LOCK=$O(@IDX@("FILE",FILE,LOCK)) Q:LOCK="" D
- ..N NODE S NODE=""
- ..F S NODE=$O(@IDX@("FILE",FILE,LOCK,NODE)) Q:NODE="" Q:$D(XUPARMS("SELECTED NODE"))&'(NODE=$G(XUPARMS("SELECTED NODE"))) S FID=$$GETID(LOCK,NODE,2) S:FID="" FID="?" S @IDX@("FILE/ID",FID,LOCK,NODE)=""
- .S FID=""
- .F S FID=$O(@IDX@("FILE/ID",FID)) Q:FID="" D
- ..S LOCK=""
- ..F S LOCK=$O(@IDX@("FILE/ID",FID,LOCK)) Q:LOCK="" D
- ...N NODE S NODE=""
- ...F S NODE=$O(@IDX@("FILE/ID",FID,LOCK,NODE)) Q:NODE="" Q:NODE="" Q:$D(XUPARMS("SELECTED NODE"))&'(NODE=$G(XUPARMS("SELECTED NODE"))) D
- ....D NEWENTRY(LOCK,NODE,FID,15,$P(@LOCKS@(LOCK,NODE,"OWNER"),"^",2),14,$$LAST8(NODE),8,LOCK,60)
- S VALMBCK="R"
- Q
- ASKWHERE(TOPIC) ;Asks the user where to jump to.
- N Y,DIR,DIRUT,RESPONSE,GOTO,WHERETO
- W !!,"Are you looking for a specific "_TOPIC_"?"
- W !,"If so, enter the "_TOPIC_", or the first few letters of "_TOPIC_"."
- S DIR("A")=TOPIC_": "
- S DIR(0)="FOA^1:45"
- D ^DIR
- I $D(DIRUT),(TOPIC'="LOCK")!(Y="^") Q VALMBG
- I TOPIC'="LOCK" S Y=$$UP^XLFSTR(Y)
- S WHERETO=Y
- I WHERETO="" Q 1
- S GOTO=$O(@VALMAR@("IDX1",WHERETO))
- I $E(GOTO,1,$L(WHERETO))'=WHERETO S GOTO=$O(@VALMAR@("IDX1",GOTO),-1)
- I $L(GOTO) D
- .S VALMBG=+$G(@VALMAR@("IDX1",GOTO))
- E S VALMBG=1
- Q VALMBG
- ;
- ;
- NEWENTRY(LOCK,NODE,COL1,W1,COL2,W2,COL3,W3,COL4,W4) ;
- N TEMP
- S:$G(COL1)="{?}" COL1=" "
- S:$G(COL2)="{?}" COL2=" "
- S:$G(COL3)="{?}" COL3=" "
- S:$G(COL4)="{?}" COL3=" "
- S @VALMAR@($$I,0)=$$RJ(VALMCNT,4)_" "_$$LJ($E(COL1,1,W1),W1)_" "_$$LJ($E($G(COL2),1,$G(W2)),$G(W2))_" "_$$LJ($E($G(COL3),1,$G(W3)),$G(W3))_" "_$$LJ($E($G(COL4),1,$G(W4)),$G(W4))
- D CNTRL^VALM10(VALMCNT,1,5,IOINHI,IOINORM)
- S TEMP=$G(@VALMAR@("IDX1",COL1))
- I ('TEMP)!(VALMCNT<TEMP) S @VALMAR@("IDX1",COL1)=VALMCNT
- S @VALMAR@("IDX2",VALMCNT)=NODE_"|XULM|"_LOCK
- Q
- ;
- GETID(LOCK,NODE,FILE) ;gets first ID for sorting purposes.
- ;
- N ID,TEMPLATE,VARS,FILES
- S TEMPLATE=$G(@LOCKS@(LOCK,NODE,"TEMPLATE"))
- Q:'TEMPLATE ""
- S FILES(FILE)=$G(@LOCKS@(LOCK,NODE,"FILES",FILE))
- Q:'FILES(FILE) ""
- M VARS=@LOCKS@(LOCK,NODE,"VARIABLES")
- D GETREFS^XULMLD(TEMPLATE,.FILES,.VARS)
- Q $S($D(FILES(FILE,1)):$P(FILES(FILE,1),":",2,5),1:"?")
- ;
- ADDLINE(LINE) ;
- N LIN
- S LIN=" "_LINE
- D ADD(LINE)
- Q
- ADD(LINE) ;
- S @VALMAR@($$I,0)=LINE
- Q
- ;
- EXIT ; -- exit code
- D CLEAN^VALM10
- D CLEAR^VALM1
- Q
- SELECT ;
- N START,END,DIR,XULMLOCK,Y,XULMNODE,XULMEXIT
- S START=$G(@VALMAR@("IDX1",VALMBG),1)
- I START,$G(@VALMAR@("IDX1",(VALMBG-1)))=START,(START+1)'>VALMCNT S START=START+1
- S END=$G(@VALMAR@("IDX1",VALMBG+17))
- I 'END S END=VALMCNT
- I START,START=END S Y=START
- E D
- .S DIR(0)="NO^"_START_":"_END_":0"
- .S DIR("A")="Select a lock: "
- .S DIR("?")="Enter the number of an entry on the screen to select a lock."
- .D ^DIR
- ;
- I +Y D
- .N X
- .S X=@VALMAR@("IDX2",+Y)
- .S XULMNODE=$P(X,"|XULM|")
- .S XULMLOCK=$P(X,"|XULM|",2)
- .S XUPARMS("KILL")=0
- .D EN^VALM("XULM DISPLAY SINGLE LOCK")
- .I $G(XUPARMS("KILL")),'$G(XULMEXIT) K XUPARMS("KILL") D REFRESH
- S VALMBCK=$S($G(XULMEXIT):"Q",1:"R")
- Q
- ;
- ;
- SLCTNODE ;
- N NODE,DIR
- S NODE(0)=1,NODE(1)="ALL NODES"
- S NODE=""
- F S NODE=$O(XUPARMS("REPORTING NODES",NODE)) Q:NODE="" S NODE(0)=NODE(0)+1,NODE(NODE(0))=NODE
- D FULL^VALM1
- W !!,"You can display locks from all the nodes or a single node."
- F I=1:1:NODE(0) S DIR("A",I)="["_I_"] "_NODE(I)
- S NODE(0)=NODE(0)+1
- S DIR("A",NODE(0))=" "
- S DIR(0)="NO^"_1_":"_NODE(0)_":0"
- S DIR("A")="Select a node"
- S DIR("?")="Enter a number to select a node."
- S DIR("B")=1
- D ^DIR
- I +Y D
- .I +Y=1 K XUPARMS("SELECTED NODE")
- .I +Y>1,+Y<NODE(0) S XUPARMS("SELECTED NODE")=$G(NODE(+Y))
- .D:$D(XUPARMS("LAST ACTION")) @XUPARMS("LAST ACTION")
- S VALMBCK="R"
- Q
- ;
- ;
- LJ(STRING,LEN) ;
- Q $$LJ^XLFSTR(STRING,LEN)
- RJ(STRING,LEN) ;
- Q $$RJ^XLFSTR(STRING,LEN)
- ;
- I() ;
- S VALMCNT=VALMCNT+1
- Q VALMCNT
- ;
- ;
- HELP ; -- help code
- N COUNT,LINE
- D CLEAR^VALM1
- F COUNT=1:1:19 S LINE=$T(HLPTEXT+COUNT) W !,$P(LINE,";",3,9)
- W !!!
- D:'$$PAUSE^XULMU
- .W @IOF
- .F COUNT=20:1:35 S LINE=$T(HLPTEXT+COUNT) W !,$P(LINE,";",3,9)
- .W !!!!!!
- .D PAUSE^XULMU
- D RE^VALM4
- Q
- ;
- HDR(COL1,W1,COL2,W2,COL3,W3,COL4,W4) ;
- S VALMCAP=" # "_$$LJ($G(COL1),W1)_" "_$$LJ($G(COL2),$G(W2))_" "_$$LJ($G(COL3),$G(W3))_" "_$$LJ($G(COL4),$G(W4))_" "
- Q
- ;
- OPTIONS ;Give options for how the lock list should be displayed.
- N DIR
- D FULL^VALM1
- S DIR(0)="S^1:Sort List by Patient Name;2:Sort List by User Name;3:Sort List by Lock;4:Screen List by File Reference"
- S DIR("A")="Select a display option: "
- ;S DIR("A",#)=""
- S DIR("B")=1
- S DIR("?",1)=" [1] - Sorts the list of user locks by patient name."
- S DIR("?",2)=""
- S DIR("?",3)=" [2] - Sorts the list of user locks by user name."
- S DIR("?",4)=""
- S DIR("?",5)=" [3] - Sorts the list of user locks by the lock string."
- S DIR("?",6)=""
- S DIR("?",7)=" [4] - Diplays only those user locks that reference the specific file"
- S DIR("?",8)=" that you select, sorted by patient name."
- S DIR("?",9)=" "
- S DIR("?")=" *System locks are not included in the display list."
- D ^DIR
- D
- .I Y=1 D BYPAT Q
- .I Y=2 D BYUSER Q
- .I Y=3 D BYLOCK Q
- .I Y=4 D Q
- ..N FILE
- ..S FILE=$$SLCTFILE
- ..I FILE D BYFILE(FILE)
- S VALMBCK="R"
- ;
- ;
- ;
- LAST8(STRING) ;
- I $L(STRING)>8,$L($G(XUPARMS("NODES",STRING,"SHORT NAME"))) Q $G(XUPARMS("NODES",STRING,"SHORT NAME"))
- N LEN
- S LEN=$L(STRING)
- Q $E(STRING,$S(LEN>8:LEN-7,1:1),LEN)
- ;
- ;;
- HLPTEXT ;;
- ;;Select an action from the bottom of the screen.
- ;;
- ;;Enter '??' to see additional actions that are available.
- ;;
- ;;SL - This action will prompt you to select a lock by its number on the list.
- ;; It will then display additional information about the lock and the
- ;; process that holds the lock.
- ;;
- ;;
- ;;GO -This action asks where you want to go to on the list and then shifts
- ;; the display to that location.
- ;;
- ;;
- ;;RL - This action will rebuild the list of locks displayed on the screen.
- ;; Active locks usually change from moment to moment, but users of the
- ;; Lock Manager are generally only interested in those locks that are
- ;; being improperly held for prolonged periods of time.
- ;;
- ;;
- ;;SYS - This action will display only system locks. System locks are
- ;; those locks set by the Kernel, HL7, and other infrastructure packages.
- ;;
- ;;
- ;;
- ;;SS - This action provides several options for how the list locks should be
- ;; displayed. The options include sorting the list by patient name, sorting
- ;; the list by the user name, sorting the list by the lock string, and
- ;; screening the entries by lock reference, which means that only locks
- ;; that relate to that specific file will be included in the display.
- ;;
- ;;
- ;;SN - This action allows the user to select either a single computer node or
- ;; all the computer nodes. If the user selects a single node then the display
- ;; of locks will include only locks placed by processess running on that node.
- ;;
- ;;
- ;;
- ;;
- ;;
- ENDHELP ;;END
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXULMUI 12488 printed Jan 18, 2025@03:11:13 Page 2
- XULMUI ;IRMFO-ALB/CJM/SWO/RGG - KERNEL LOCK MANAGER ;10/24/2012
- +1 ;;8.0;KERNEL;**608**;JUL 10, 1995;Build 84
- +2 ;;Per VA Directive 6402, this routine should not be modified
- +3 ;
- +4 ; ******************************************************************
- +5 ; * *
- +6 ; * The Kernel Lock Manager is based on the VistA Lock Manager *
- +7 ; * developed by Tommy Martin. *
- +8 ; * *
- +9 ; ******************************************************************
- +10 ;
- +11 ;
- REFRESH ;
- +1 KILL @LOCKS,@IDX
- +2 if '$$GETLOCKS^XULM(.XUPARMS)
- QUIT
- +3 IF $DATA(XUPARMS("LAST ACTION"))
- Begin DoDot:1
- +4 DO @XUPARMS("LAST ACTION")
- End DoDot:1
- +5 IF '$TEST
- DO BYPAT
- +6 QUIT
- BYLOCK ; display user locks sorted by lock
- +1 NEW LOCK,XUTOPIC
- +2 SET XUTOPIC="LOCK"
- +3 SET XUPARMS("LAST ACTION")="BYLOCK^XULMUI"
- +4 SET VALMCNT=0
- +5 DO CLEAN^VALM10
- +6 SET VALMBG=1
- +7 SET VALMSG="User Locks Sorted by Lock ["_$SELECT($LENGTH($GET(XUPARMS("SELECTED NODE"))):$$LAST8(XUPARMS("SELECTED NODE")),1:"ALL NODES")_"]"
- +8 DO HDR("Lock",35,"Node",8,"User",13,"Patient",25)
- +9 SET LOCK=""
- +10 FOR
- SET LOCK=$ORDER(@LOCKS@(LOCK))
- if LOCK=""
- QUIT
- Begin DoDot:1
- +11 NEW NODE
- +12 SET NODE=""
- +13 FOR
- SET NODE=$ORDER(@LOCKS@(LOCK,NODE))
- if NODE=""
- QUIT
- if $DATA(XUPARMS("SELECTED NODE"))&'(NODE=$GET(XUPARMS("SELECTED NODE")))
- QUIT
- IF '$GET(@LOCKS@(LOCK,NODE,"SYSTEM"))
- Begin DoDot:2
- +14 DO NEWENTRY(LOCK,NODE,LOCK,35,$$LAST8(NODE),8,$PIECE(@LOCKS@(LOCK,NODE,"OWNER"),"^",2),13,$$GETID(LOCK,NODE,2),25)
- End DoDot:2
- End DoDot:1
- +15 ;
- +16 SET VALMBCK="R"
- +17 QUIT
- +18 ;
- SYSTEM ; display system locks sorted by lock
- +1 NEW LOCK
- +2 IF '$$KCHK^XUSRB("XULM SYSTEM LOCKS")
- Begin DoDot:1
- +3 WRITE *7,!!!,?10,"***You are not authorized to view SYSTEM LOCKS***"
- HANG 5
- +4 SET VALMBCK="R"
- End DoDot:1
- QUIT
- +5 SET XUPARMS("LAST ACTION")="SYSTEM^XULMUI"
- +6 SET XUTOPIC="LOCK"
- +7 SET VALMCNT=0
- +8 DO CLEAN^VALM10
- +9 SET VALMBG=1
- +10 SET VALMSG="System Locks Sorted by Lock ["_$SELECT($LENGTH($GET(XUPARMS("SELECTED NODE"))):$$LAST8(XUPARMS("SELECTED NODE")),1:"ALL NODES")_"]"
- +11 DO HDR("Lock",50,"Node",8,"User",15)
- +12 SET LOCK=""
- +13 FOR
- SET LOCK=$ORDER(@LOCKS@(LOCK))
- if LOCK=""
- QUIT
- Begin DoDot:1
- +14 NEW NODE
- +15 SET NODE=""
- +16 FOR
- SET NODE=$ORDER(@LOCKS@(LOCK,NODE))
- if NODE=""
- QUIT
- if $DATA(XUPARMS("SELECTED NODE"))&'(NODE=$GET(XUPARMS("SELECTED NODE")))
- QUIT
- IF $GET(@LOCKS@(LOCK,NODE,"SYSTEM"))
- Begin DoDot:2
- +17 DO NEWENTRY(LOCK,NODE,LOCK,50,$$LAST8(NODE),8,$PIECE(@LOCKS@(LOCK,NODE,"OWNER"),"^",2),15)
- End DoDot:2
- End DoDot:1
- +18 ;
- +19 SET VALMBCK="R"
- +20 QUIT
- +21 ;
- GOTO ;Jumps to a location on the screen
- +1 SET VALMBG=$$ASKWHERE(XUTOPIC)
- +2 SET VALMBCK="R"
- +3 QUIT
- +4 ;
- BYUSER ; display list sorted by user
- +1 NEW LOCK,USER
- +2 SET XUPARMS("LAST ACTION")="BYUSER^XULMUI"
- +3 SET XUTOPIC="USER"
- +4 DO HDR("User",14,"Lock",33,"Node",8,"Patient",25)
- +5 SET VALMCNT=0
- +6 SET VALMBG=1
- +7 DO CLEAN^VALM10
- +8 SET VALMSG="User Locks Sorted by User Name ["_$SELECT($LENGTH($GET(XUPARMS("SELECTED NODE"))):$$LAST8(XUPARMS("SELECTED NODE")),1:"ALL NODES")_"]"
- +9 SET USER=""
- +10 ;
- +11 FOR
- SET USER=$ORDER(@IDX@("OWNER",USER))
- if USER=""
- QUIT
- Begin DoDot:1
- +12 SET LOCK=""
- +13 FOR
- SET LOCK=$ORDER(@IDX@("OWNER",USER,LOCK))
- if LOCK=""
- QUIT
- Begin DoDot:2
- +14 NEW NODE
- +15 SET NODE=""
- +16 FOR
- SET NODE=$ORDER(@IDX@("OWNER",USER,LOCK,NODE))
- if NODE=""
- QUIT
- if $DATA(XUPARMS("SELECTED NODE"))&'(NODE=$GET(XUPARMS("SELECTED NODE")))
- QUIT
- if $GET(@LOCKS@(LOCK,NODE,"SYSTEM"))
- QUIT
- Begin DoDot:3
- +17 DO NEWENTRY(LOCK,NODE,$PIECE(@LOCKS@(LOCK,NODE,"OWNER"),"^",2),14,LOCK,33,$$LAST8(NODE),8,$$GETID(LOCK,NODE,2),25)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +18 SET VALMBCK="R"
- +19 QUIT
- +20 ;
- BYPAT ; display list sorted by Patient
- +1 NEW LOCK,USER,PAT
- +2 SET XUPARMS("LAST ACTION")="BYPAT^XULMUI"
- +3 SET XUTOPIC="PATIENT"
- +4 DO HDR("Patient",15,"Lock",33,"Node",8,"User",15)
- +5 SET VALMCNT=0
- +6 SET VALMBG=1
- +7 DO CLEAN^VALM10
- +8 KILL @IDX@("FILE/ID")
- +9 SET VALMSG="User Locks Sorted by Patient Name ["_$SELECT($LENGTH($GET(XUPARMS("SELECTED NODE"))):$$LAST8(XUPARMS("SELECTED NODE")),1:"ALL NODES")_"]"
- +10 SET LOCK=""
- +11 FOR
- SET LOCK=$ORDER(@LOCKS@(LOCK))
- if LOCK=""
- QUIT
- Begin DoDot:1
- +12 SET NODE=""
- +13 FOR
- SET NODE=$ORDER(@LOCKS@(LOCK,NODE))
- if NODE=""
- QUIT
- if NODE=""
- QUIT
- if $DATA(XUPARMS("SELECTED NODE"))&'(NODE=$GET(XUPARMS("SELECTED NODE")))
- QUIT
- IF '$GET(@LOCKS@(LOCK,NODE,"SYSTEM"))
- Begin DoDot:2
- +14 SET PAT=$$GETID(LOCK,NODE,2)
- if PAT=""
- SET PAT="{?}"
- +15 SET @IDX@("FILE/ID",PAT,LOCK,NODE)=""
- End DoDot:2
- End DoDot:1
- +16 SET PAT=""
- +17 FOR
- SET PAT=$ORDER(@IDX@("FILE/ID",PAT))
- if PAT=""
- QUIT
- Begin DoDot:1
- +18 SET LOCK=""
- +19 FOR
- SET LOCK=$ORDER(@IDX@("FILE/ID",PAT,LOCK))
- if LOCK=""
- QUIT
- Begin DoDot:2
- +20 NEW NODE
- +21 SET NODE=""
- +22 FOR
- SET NODE=$ORDER(@IDX@("FILE/ID",PAT,LOCK,NODE))
- if NODE=""
- QUIT
- if $DATA(XUPARMS("SELECTED NODE"))&'(NODE=$GET(XUPARMS("SELECTED NODE")))
- QUIT
- Begin DoDot:3
- +23 DO NEWENTRY(LOCK,NODE,PAT,15,LOCK,33,$$LAST8(NODE),8,$PIECE(@LOCKS@(LOCK,NODE,"OWNER"),"^",2),25)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +24 SET VALMBCK="R"
- +25 QUIT
- +26 ;
- SLCTFILE() ;Select a file reference to screen locks by
- +1 DO FULL^VALM1
- +2 WRITE !
- +3 NEW NAME,FILE,I,FILES
- +4 SET (FILE,I)=0
- +5 FOR
- SET FILE=$ORDER(@IDX@("FILE",FILE))
- if 'FILE
- QUIT
- Begin DoDot:1
- +6 SET NAME=$PIECE($GET(^DIC(FILE,0)),"^")
- +7 IF $LENGTH(NAME)
- Begin DoDot:2
- +8 SET I=I+1
- +9 SET FILES(I)=FILE
- +10 WRITE !,$$LJ("("_I_")",8),NAME," File (#"_FILE_")"
- End DoDot:2
- End DoDot:1
- +11 IF 'I
- DO PAUSE^XULMU("There are no file references available!")
- QUIT 0
- +12 WRITE !
- +13 SET DIR(0)="NO^"_1_":"_I_":0"
- +14 SET DIR("A")="Select a file from the list: "
- +15 IF I>0
- SET DIR("B")=1
- +16 SET DIR("?")="Enter the number of an entry on the screen to select a file."
- +17 DO ^DIR
- +18 ;
- +19 IF +Y
- QUIT $GET(FILES(+Y))
- +20 QUIT 0
- +21 ;
- BYFILE(FILE) ; Display locks that have a computable references to a particular file
- +1 NEW LOCK,USER
- +2 SET XUPARMS("LAST ACTION")="BYFILE^XULMUI("_FILE_")"
- +3 IF FILE
- Begin DoDot:1
- +4 NEW FID
- +5 SET XUTOPIC="PATIENT"
- +6 DO CLEAN^VALM10
- +7 DO HDR("Patient",15,"User",14,"Node",8,"LOCK",60)
- +8 SET VALMSG="User Locks Related to the "_$PIECE($GET(^DIC(FILE,0)),"^")_" File"
- +9 KILL @IDX@("FILE/ID")
- +10 SET VALMCNT=0
- +11 SET VALMBG=1
- +12 SET LOCK=""
- +13 FOR
- SET LOCK=$ORDER(@IDX@("FILE",FILE,LOCK))
- if LOCK=""
- QUIT
- Begin DoDot:2
- +14 NEW NODE
- SET NODE=""
- +15 FOR
- SET NODE=$ORDER(@IDX@("FILE",FILE,LOCK,NODE))
- if NODE=""
- QUIT
- if $DATA(XUPARMS("SELECTED NODE"))&'(NODE=$GET(XUPARMS("SELECTED NODE")))
- QUIT
- SET FID=$$GETID(LOCK,NODE,2)
- if FID=""
- SET FID="?"
- SET @IDX@("FILE/ID",FID,LOCK,NODE)=""
- End DoDot:2
- +16 SET FID=""
- +17 FOR
- SET FID=$ORDER(@IDX@("FILE/ID",FID))
- if FID=""
- QUIT
- Begin DoDot:2
- +18 SET LOCK=""
- +19 FOR
- SET LOCK=$ORDER(@IDX@("FILE/ID",FID,LOCK))
- if LOCK=""
- QUIT
- Begin DoDot:3
- +20 NEW NODE
- SET NODE=""
- +21 FOR
- SET NODE=$ORDER(@IDX@("FILE/ID",FID,LOCK,NODE))
- if NODE=""
- QUIT
- if NODE=""
- QUIT
- if $DATA(XUPARMS("SELECTED NODE"))&'(NODE=$GET(XUPARMS("SELECTED NODE")))
- QUIT
- Begin DoDot:4
- +22 DO NEWENTRY(LOCK,NODE,FID,15,$PIECE(@LOCKS@(LOCK,NODE,"OWNER"),"^",2),14,$$LAST8(NODE),8,LOCK,60)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +23 SET VALMBCK="R"
- +24 QUIT
- ASKWHERE(TOPIC) ;Asks the user where to jump to.
- +1 NEW Y,DIR,DIRUT,RESPONSE,GOTO,WHERETO
- +2 WRITE !!,"Are you looking for a specific "_TOPIC_"?"
- +3 WRITE !,"If so, enter the "_TOPIC_", or the first few letters of "_TOPIC_"."
- +4 SET DIR("A")=TOPIC_": "
- +5 SET DIR(0)="FOA^1:45"
- +6 DO ^DIR
- +7 IF $DATA(DIRUT)
- IF (TOPIC'="LOCK")!(Y="^")
- QUIT VALMBG
- +8 IF TOPIC'="LOCK"
- SET Y=$$UP^XLFSTR(Y)
- +9 SET WHERETO=Y
- +10 IF WHERETO=""
- QUIT 1
- +11 SET GOTO=$ORDER(@VALMAR@("IDX1",WHERETO))
- +12 IF $EXTRACT(GOTO,1,$LENGTH(WHERETO))'=WHERETO
- SET GOTO=$ORDER(@VALMAR@("IDX1",GOTO),-1)
- +13 IF $LENGTH(GOTO)
- Begin DoDot:1
- +14 SET VALMBG=+$GET(@VALMAR@("IDX1",GOTO))
- End DoDot:1
- +15 IF '$TEST
- SET VALMBG=1
- +16 QUIT VALMBG
- +17 ;
- +18 ;
- NEWENTRY(LOCK,NODE,COL1,W1,COL2,W2,COL3,W3,COL4,W4) ;
- +1 NEW TEMP
- +2 if $GET(COL1)="{?}"
- SET COL1=" "
- +3 if $GET(COL2)="{?}"
- SET COL2=" "
- +4 if $GET(COL3)="{?}"
- SET COL3=" "
- +5 if $GET(COL4)="{?}"
- SET COL3=" "
- +6 SET @VALMAR@($$I,0)=$$RJ(VALMCNT,4)_" "_$$LJ($EXTRACT(COL1,1,W1),W1)_" "_$$LJ($EXTRACT($GET(COL2),1,$GET(W2)),$GET(W2))_" "_$$LJ($EXTRACT($GET(COL3),1,$GET(W3)),$GET(W3))_" "_$$LJ($EXTRACT($GET(COL4),1,$GET(W4)),$GET(W4))
- +7 DO CNTRL^VALM10(VALMCNT,1,5,IOINHI,IOINORM)
- +8 SET TEMP=$GET(@VALMAR@("IDX1",COL1))
- +9 IF ('TEMP)!(VALMCNT<TEMP)
- SET @VALMAR@("IDX1",COL1)=VALMCNT
- +10 SET @VALMAR@("IDX2",VALMCNT)=NODE_"|XULM|"_LOCK
- +11 QUIT
- +12 ;
- GETID(LOCK,NODE,FILE) ;gets first ID for sorting purposes.
- +1 ;
- +2 NEW ID,TEMPLATE,VARS,FILES
- +3 SET TEMPLATE=$GET(@LOCKS@(LOCK,NODE,"TEMPLATE"))
- +4 if 'TEMPLATE
- QUIT ""
- +5 SET FILES(FILE)=$GET(@LOCKS@(LOCK,NODE,"FILES",FILE))
- +6 if 'FILES(FILE)
- QUIT ""
- +7 MERGE VARS=@LOCKS@(LOCK,NODE,"VARIABLES")
- +8 DO GETREFS^XULMLD(TEMPLATE,.FILES,.VARS)
- +9 QUIT $SELECT($DATA(FILES(FILE,1)):$PIECE(FILES(FILE,1),":",2,5),1:"?")
- +10 ;
- ADDLINE(LINE) ;
- +1 NEW LIN
- +2 SET LIN=" "_LINE
- +3 DO ADD(LINE)
- +4 QUIT
- ADD(LINE) ;
- +1 SET @VALMAR@($$I,0)=LINE
- +2 QUIT
- +3 ;
- EXIT ; -- exit code
- +1 DO CLEAN^VALM10
- +2 DO CLEAR^VALM1
- +3 QUIT
- SELECT ;
- +1 NEW START,END,DIR,XULMLOCK,Y,XULMNODE,XULMEXIT
- +2 SET START=$GET(@VALMAR@("IDX1",VALMBG),1)
- +3 IF START
- IF $GET(@VALMAR@("IDX1",(VALMBG-1)))=START
- IF (START+1)'>VALMCNT
- SET START=START+1
- +4 SET END=$GET(@VALMAR@("IDX1",VALMBG+17))
- +5 IF 'END
- SET END=VALMCNT
- +6 IF START
- IF START=END
- SET Y=START
- +7 IF '$TEST
- Begin DoDot:1
- +8 SET DIR(0)="NO^"_START_":"_END_":0"
- +9 SET DIR("A")="Select a lock: "
- +10 SET DIR("?")="Enter the number of an entry on the screen to select a lock."
- +11 DO ^DIR
- End DoDot:1
- +12 ;
- +13 IF +Y
- Begin DoDot:1
- +14 NEW X
- +15 SET X=@VALMAR@("IDX2",+Y)
- +16 SET XULMNODE=$PIECE(X,"|XULM|")
- +17 SET XULMLOCK=$PIECE(X,"|XULM|",2)
- +18 SET XUPARMS("KILL")=0
- +19 DO EN^VALM("XULM DISPLAY SINGLE LOCK")
- +20 IF $GET(XUPARMS("KILL"))
- IF '$GET(XULMEXIT)
- KILL XUPARMS("KILL")
- DO REFRESH
- End DoDot:1
- +21 SET VALMBCK=$SELECT($GET(XULMEXIT):"Q",1:"R")
- +22 QUIT
- +23 ;
- +24 ;
- SLCTNODE ;
- +1 NEW NODE,DIR
- +2 SET NODE(0)=1
- SET NODE(1)="ALL NODES"
- +3 SET NODE=""
- +4 FOR
- SET NODE=$ORDER(XUPARMS("REPORTING NODES",NODE))
- if NODE=""
- QUIT
- SET NODE(0)=NODE(0)+1
- SET NODE(NODE(0))=NODE
- +5 DO FULL^VALM1
- +6 WRITE !!,"You can display locks from all the nodes or a single node."
- +7 FOR I=1:1:NODE(0)
- SET DIR("A",I)="["_I_"] "_NODE(I)
- +8 SET NODE(0)=NODE(0)+1
- +9 SET DIR("A",NODE(0))=" "
- +10 SET DIR(0)="NO^"_1_":"_NODE(0)_":0"
- +11 SET DIR("A")="Select a node"
- +12 SET DIR("?")="Enter a number to select a node."
- +13 SET DIR("B")=1
- +14 DO ^DIR
- +15 IF +Y
- Begin DoDot:1
- +16 IF +Y=1
- KILL XUPARMS("SELECTED NODE")
- +17 IF +Y>1
- IF +Y<NODE(0)
- SET XUPARMS("SELECTED NODE")=$GET(NODE(+Y))
- +18 if $DATA(XUPARMS("LAST ACTION"))
- DO @XUPARMS("LAST ACTION")
- End DoDot:1
- +19 SET VALMBCK="R"
- +20 QUIT
- +21 ;
- +22 ;
- LJ(STRING,LEN) ;
- +1 QUIT $$LJ^XLFSTR(STRING,LEN)
- RJ(STRING,LEN) ;
- +1 QUIT $$RJ^XLFSTR(STRING,LEN)
- +2 ;
- I() ;
- +1 SET VALMCNT=VALMCNT+1
- +2 QUIT VALMCNT
- +3 ;
- +4 ;
- HELP ; -- help code
- +1 NEW COUNT,LINE
- +2 DO CLEAR^VALM1
- +3 FOR COUNT=1:1:19
- SET LINE=$TEXT(HLPTEXT+COUNT)
- WRITE !,$PIECE(LINE,";",3,9)
- +4 WRITE !!!
- +5 if '$$PAUSE^XULMU
- Begin DoDot:1
- +6 WRITE @IOF
- +7 FOR COUNT=20:1:35
- SET LINE=$TEXT(HLPTEXT+COUNT)
- WRITE !,$PIECE(LINE,";",3,9)
- +8 WRITE !!!!!!
- +9 DO PAUSE^XULMU
- End DoDot:1
- +10 DO RE^VALM4
- +11 QUIT
- +12 ;
- HDR(COL1,W1,COL2,W2,COL3,W3,COL4,W4) ;
- +1 SET VALMCAP=" # "_$$LJ($GET(COL1),W1)_" "_$$LJ($GET(COL2),$GET(W2))_" "_$$LJ($GET(COL3),$GET(W3))_" "_$$LJ($GET(COL4),$GET(W4))_" "
- +2 QUIT
- +3 ;
- OPTIONS ;Give options for how the lock list should be displayed.
- +1 NEW DIR
- +2 DO FULL^VALM1
- +3 SET DIR(0)="S^1:Sort List by Patient Name;2:Sort List by User Name;3:Sort List by Lock;4:Screen List by File Reference"
- +4 SET DIR("A")="Select a display option: "
- +5 ;S DIR("A",#)=""
- +6 SET DIR("B")=1
- +7 SET DIR("?",1)=" [1] - Sorts the list of user locks by patient name."
- +8 SET DIR("?",2)=""
- +9 SET DIR("?",3)=" [2] - Sorts the list of user locks by user name."
- +10 SET DIR("?",4)=""
- +11 SET DIR("?",5)=" [3] - Sorts the list of user locks by the lock string."
- +12 SET DIR("?",6)=""
- +13 SET DIR("?",7)=" [4] - Diplays only those user locks that reference the specific file"
- +14 SET DIR("?",8)=" that you select, sorted by patient name."
- +15 SET DIR("?",9)=" "
- +16 SET DIR("?")=" *System locks are not included in the display list."
- +17 DO ^DIR
- +18 Begin DoDot:1
- +19 IF Y=1
- DO BYPAT
- QUIT
- +20 IF Y=2
- DO BYUSER
- QUIT
- +21 IF Y=3
- DO BYLOCK
- QUIT
- +22 IF Y=4
- Begin DoDot:2
- +23 NEW FILE
- +24 SET FILE=$$SLCTFILE
- +25 IF FILE
- DO BYFILE(FILE)
- End DoDot:2
- QUIT
- End DoDot:1
- +26 SET VALMBCK="R"
- +27 ;
- +28 ;
- +29 ;
- LAST8(STRING) ;
- +1 IF $LENGTH(STRING)>8
- IF $LENGTH($GET(XUPARMS("NODES",STRING,"SHORT NAME")))
- QUIT $GET(XUPARMS("NODES",STRING,"SHORT NAME"))
- +2 NEW LEN
- +3 SET LEN=$LENGTH(STRING)
- +4 QUIT $EXTRACT(STRING,$SELECT(LEN>8:LEN-7,1:1),LEN)
- +5 ;
- +6 ;;
- HLPTEXT ;;
- +1 ;;Select an action from the bottom of the screen.
- +2 ;;
- +3 ;;Enter '??' to see additional actions that are available.
- +4 ;;
- +5 ;;SL - This action will prompt you to select a lock by its number on the list.
- +6 ;; It will then display additional information about the lock and the
- +7 ;; process that holds the lock.
- +8 ;;
- +9 ;;
- +10 ;;GO -This action asks where you want to go to on the list and then shifts
- +11 ;; the display to that location.
- +12 ;;
- +13 ;;
- +14 ;;RL - This action will rebuild the list of locks displayed on the screen.
- +15 ;; Active locks usually change from moment to moment, but users of the
- +16 ;; Lock Manager are generally only interested in those locks that are
- +17 ;; being improperly held for prolonged periods of time.
- +18 ;;
- +19 ;;
- +20 ;;SYS - This action will display only system locks. System locks are
- +21 ;; those locks set by the Kernel, HL7, and other infrastructure packages.
- +22 ;;
- +23 ;;
- +24 ;;
- +25 ;;SS - This action provides several options for how the list locks should be
- +26 ;; displayed. The options include sorting the list by patient name, sorting
- +27 ;; the list by the user name, sorting the list by the lock string, and
- +28 ;; screening the entries by lock reference, which means that only locks
- +29 ;; that relate to that specific file will be included in the display.
- +30 ;;
- +31 ;;
- +32 ;;SN - This action allows the user to select either a single computer node or
- +33 ;; all the computer nodes. If the user selects a single node then the display
- +34 ;; of locks will include only locks placed by processess running on that node.
- +35 ;;
- +36 ;;
- +37 ;;
- +38 ;;
- +39 ;;
- ENDHELP ;;END