Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XULM1

XULM1.m

Go to the documentation of this file. 
  1. XULM1 ;IRMFO-ALB/CJM/SWO/RGG - KERNEL LOCK MANAGER ;12/04/2012
  1.  ;;8.0;KERNEL;**608**;JUL 10, 1995;Build 84
  1.  ;;Per VA Directive 6402, this routine should not be modified
  1.  ;
  1.  ;  ******************************************************************
  1.  ;  *                                                                *
  1.  ;  *  The Kernel Lock Manager is based on the VistA Lock Manager    *
  1.  ;  *        developed by Tommy Martin.                              *
  1.  ;  *                                                                *
  1.  ;  ******************************************************************
  1.  ;Contains routines for editing and creating entries in the LOCK DICTIONARY
  1.  ;
  1. SNTXLOCK(X,PARTS) ;
  1.  ;
  1.  ;Checks the syntax for a lock, returns 1 if ok, 0 otherwise
  1.  ;
  1.  ;Input: 
  1.  ;  X - the value of the LOCK TEMPLATE that was entered
  1.  ;  DA - if defined, it should be the ien of the record that is being edited
  1.  ;Output:
  1.  ;  function returns 1 if X is syntactically correct, 0 otherwise
  1.  ;  PARTS - optional, pass-by-references.  Returns the parsed of the LOCK TEMPLATE
  1.  ;  PARTS(<subscripts>):
  1.  ;       ("GLOBAL") =1 if the lock is on a global, 0 otherwise
  1.  ;       ("VARIABLE") = the locked variable, without subscripts
  1.  ;       (0) = count of subscripts
  1.  ;       (<1,2,3,...>) = the subscripts, in the order they occur
  1.  ;
  1.  N LOCK,BAD,NODE0,NODE1
  1.  I $E(X)=" " S X=$E(X,2,500)
  1.  I $L(X)>245 Q 0
  1.  I $G(DA) S NODE1=$G(^XLM(8993,DA,1)) I $P(NODE1,"^",2),$E(X)'="^" S X="^"_X
  1.  ;
  1.  S LOCK=X
  1.  K PARTS
  1.  S PARTS(0)=0
  1.  S PARTS("GLOBAL")=0
  1.  S BAD=0
  1.  ;
  1.  I $E(LOCK)="^" D
  1.  .S LOCK=$E(LOCK,2,245)
  1.  .S PARTS("GLOBAL")=1
  1.  S PARTS("VARIABLE")=$P(LOCK,"(")
  1.  I $G(DA) S NODE0=$G(^XLM(8993,DA,0)),NODE1=$G(^XLM(8993,DA,1)) I $L(NODE1) Q:($L($P(NODE1,"^",2))&($P(NODE1,"^",2)'=PARTS("GLOBAL")))!($L($P(NODE0,"^"))&($P($P(NODE0,"^"),"(")'=PARTS("VARIABLE"))) 0
  1.  D
  1.  .N COUNT
  1.  .I '$$SNTXVAR(PARTS("VARIABLE")) S BAD=1 Q
  1.  .Q:LOCK'["("
  1.  .I $E(LOCK,$L(LOCK))'=")" S BAD=1 Q
  1.  .S LOCK=$P(LOCK,"(",2,99)
  1.  .F COUNT=1:1 S PARTS=$P(LOCK,",",COUNT) Q:PARTS=""  D  Q:BAD
  1.  ..I $E(PARTS,$L(PARTS))=")" S PARTS=$E(PARTS,1,$L(PARTS)-1) I $P(LOCK,",",COUNT+1)'="" S BAD=1 Q
  1.  ..S PARTS(COUNT)=PARTS,PARTS(0)=COUNT
  1.  ..;
  1.  ..D
  1.  ...;PARTS is either a number, a string, or a variable
  1.  ...I PARTS=+PARTS S PARTS(COUNT,"VARIABLE")=0 Q
  1.  ...I $E(PARTS)="""",$E(PARTS,$L(PARTS))="""" S PARTS(COUNT,"VARIABLE")=0 Q
  1.  ...I '$$SNTXVAR(PARTS) S BAD=1 Q
  1.  ...S PARTS(COUNT,"VARIABLE")=1 Q
  1.  ;
  1.  I BAD K PARTS S PARTS(0)=0
  1.  S PARTS=""
  1.  Q 'BAD
  1. SNTXVAR(X) ;
  1.  ;Checks the syntax for a variable.  Returns 1 if ok, 0 otherwise.
  1.  ;
  1.  N PATTERN,LEN
  1.  S LEN=$L(X)
  1.  Q:LEN>8 0
  1.  S PATTERN=$S(LEN>1:"1U"_(LEN-1)_"UN",1:"1U")
  1.  I X?@PATTERN Q 1
  1.  Q 0
  1.  ;
  1. ADDPARTS(IEN) ;
  1.  ;Adds the parts parsed from the lock template to the dictionary
  1.  ;IEN is the record in the LOCK DICTIONARY.
  1.  ;PARTS is an array containing the elements parsed out of the lock template
  1.  ;
  1.  N TEMPLATE,PARTS
  1.  S TEMPLATE=$$TEMPLATE^XULMU(IEN)
  1.  Q:'$$SNTXLOCK(TEMPLATE,.PARTS)
  1.  N ORDER,DATA,DA
  1.  S DATA(1.02)=PARTS("GLOBAL")
  1.  D UPD^XULMU(8993,IEN,.DATA)
  1.  K DATA
  1.  F ORDER=1:1:PARTS(0) D
  1.  .S DA(1)=IEN
  1.  .S DATA(.01)=ORDER
  1.  .S DATA(.02)=PARTS(ORDER)
  1.  .S DATA(.04)=$S($G(PARTS(ORDER,"VARIABLE")):"V",1:"L")
  1.  .S DA=$O(^XLM(8993,DA(1),2,"B",ORDER,0))
  1.  .I 'DA D
  1.  ..D ADD^XULMU(8993.02,.DA,.DATA)
  1.  .E  D
  1.  ..D UPD^XULMU(8993.02,.DA,.DATA)
  1.  ;
  1.  ;delete any subscripts not found in the LOCK TEMPLATE
  1.  S ORDER=PARTS(0) F  S ORDER=$O(^XLM(8993,IEN,2,"B",ORDER)) Q:'ORDER  S DA=$O(^XLM(8993,IEN,2,"B",ORDER,0)) I DA S DA(1)=IEN D DELETE^XULMU(8993.02,.DA)
  1.  Q
  1.  ;
  1. SELECT() ;Select a LOCK TEMPLATE to edit
  1.  N DA,DIC,Y,DTOUT
  1.  S DA=0
  1.  S DIC=8993
  1.  S DIC(0)="AEMNO"
  1.  W !,"** You cannot enter the '^' prefix when selecting a lock template. **"
  1.  D ^DIC
  1.  S:+Y>0 DA=+Y
  1.  Q DA
  1.  ;
  1. EDIT(DA) ;Edit the lock dictionary entry ien=DA
  1.  ;
  1.  Q:'$G(DA)
  1.  N DIE,DR,Y,RET,DTOUT,ORDER,D,D0,DI,DQ,QUIT
  1.  S QUIT=0
  1.  ;
  1.  D
  1.  .S RET=DA
  1.  .S DR=".01;1.02;1.01;1.03//YES;W !!,""What is the purpose of the lock?"",!;4Purpose;S QUIT=0"
  1.  .S DIE=8993
  1.  .S QUIT=1
  1.  .D ^DIE
  1.  .Q:QUIT
  1.  .D ADDPARTS(RET)
  1.  .S DA(1)=RET
  1.  .F ORDER=1:1 S DA=$O(^XLM(8993,DA(1),2,"B",ORDER,0)) Q:'DA  D  I QUIT S QUIT=0 Q
  1.  ..I ORDER=1 W !!,"Checking for variables within the LOCK TEMPLATE..."
  1.  ..N NODE
  1.  ..S NODE=$G(^XLM(8993,DA(1),2,DA,0))
  1.  ..I $P(NODE,"^",4)="V" D
  1.  ...N VARIABLE
  1.  ...S VARIABLE=$P(NODE,"^",2)
  1.  ...W !!,"Found variable '"_VARIABLE_"'..."
  1.  ...S DIE="^XLM(8993,DA(1),2,"
  1.  ...W !!,"You can optionally enter MUMPS code to verify that the variable '"_VARIABLE_"'",!,"has a permissible value. It should set Y=0 if not ok, Y=1 if ok.",!
  1.  ...S DR="1Executable check logic"
  1.  ...D ^DIE I $D(DTOUT)!$D(Y) S QUIT=1 Q
  1.  .;
  1.  .W !!,"You can display file identifiers for the locked record, or for a record in"
  1.  .W !,"another file related to the locked record.  Most locks are related to a"
  1.  .W !,"specific patient, so most entries in the lock dictionary should include a"
  1.  .W !,"file reference to the PATIENT file (#2) and to the file of the locked record,"
  1.  .W !,"and perhaps other files as well."
  1.  .W !!,"If you would like to include file references, first select the file, and then",!,"enter the MUMPS code that will retrieve the file identifiers from that file.",!
  1.  .K DA S DA=+RET
  1.  .S DR="3"
  1.  .S DR(2,8993.03)=".01File;W !!,""Enter MUMPS code to return identifiers for the record related to the lock."",!;1MUMPS Code;W !!,""List the identifiers that are returned for this file reference."",!;2Identifiers"
  1.  .S DIE=8993
  1.  .D ^DIE
  1.  .I $D(DTOUT)!$D(Y) S QUIT=1 Q
  1.  Q QUIT
  1.  ;
  1. ASK() ;Ask user if he wants to edit an existing lock template or create
  1.  ;a new one.
  1.  ;
  1.  N DIR
  1.  S DIR(0)="S^A:Add a new entry;E:Edit an existing entry;D:Delete an existing entry"
  1.  S DIR("?")="Do you want to Add, Edit, or Delete an entry in the lock dictionary?"
  1.  W !,DIR("?"),!
  1.  S DIR("B")="E"
  1.  D ^DIR
  1.  I Y="E" D
  1.  .D EDIT($$SELECT)
  1.  E  I Y="D" D
  1.  .D DELETE($$SELECT)
  1.  E  I Y="A" D
  1.  .D EDIT($$CREATE)
  1.  Q
  1. DELETE(IEN) ;
  1.  Q:'IEN
  1.  I $$ASKYESNO^XULMU("Are you sure","NO") D DELETE^XULMU(8993,IEN) W !,"Deleted!"
  1.  Q
  1.  ;
  1.  ;
  1. CREATE() ;Ask the user to enter a LOCK TEMPLATE, then
  1.  ;create a new entry in the lock dictionary.
  1.  ;
  1.  N DA,QUIT
  1.  S (DA,QUIT)=0
  1.  ;
  1.  F  D  Q:QUIT
  1.  .N I,DIR,X,Y
  1.  .N TEMPLATE,GLOBAL
  1.  .S DIR(0)="8993,.01"
  1.  .;ask user for LOCK TEMPLATE
  1.  .D ^DIR
  1.  .I $D(DIRUT) S QUIT=1 K DIRUT Q
  1.  .S GLOBAL=$S($E(X,1,2)["^":1,1:0)
  1.  .S TEMPLATE=$P(X,"^",(1+GLOBAL))
  1.  .I TEMPLATE="" S QUIT=1 QUIT
  1.  .S DA=$O(^XLM(8993,"E",GLOBAL,TEMPLATE,0))
  1.  .S:'DA DA=$O(^XLM(8993,"E",'GLOBAL,TEMPLATE,0))
  1.  .I DA S QUIT='$$ASKYESNO^XULMU("That LOCK TEMPLATE already exists!  Do you want to edit it","NO") I QUIT S DA=0 Q
  1.  .;
  1.  .;create a new entry
  1.  .I 'DA D
  1.  ..N DATA,ERROR
  1.  ..S DATA(.01)=TEMPLATE
  1.  ..S DATA(1.02)=GLOBAL
  1.  ..S DA=$$ADD^XULMU(8993,,.DATA,.ERROR)
  1.  ..I 'DA W !,ERROR
  1.  ..S QUIT=1
  1.  ;
  1.  ;
  1.  Q DA
  1.  ;
  1.  ;
  1.  ;