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

XULMU.m

Go to the documentation of this file.
  1. XULMU ;IRMFO-ALB/CJM/SWO/RGG - KERNEL LOCK MANAGER ;11/16/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. ;
  1. ; Miscellaneous utilities
  1. ;
  1. GETLOCKS(LOCKS) ;
  1. N NODE,QUIT,RSET
  1. ;
  1. S NODE=$$NODE
  1. S @LOCKS@("XULM REPORTED NODE")=NODE
  1. S QUIT=0
  1. D LOCKQRY^%ZLMLIB(.RSET)
  1. F D Q:QUIT
  1. .N PID,LOCK
  1. .I '$$NXTLOCK^%ZLMLIB(.RSET,.LOCK) S QUIT=1 Q
  1. .S PID=LOCK(LOCK,"PID")
  1. .D:PID
  1. ..S @LOCKS@(LOCK,NODE)=LOCK(LOCK)
  1. ..S @LOCKS@(LOCK,NODE,"SYSTEM")=$$IFSYSTEM(LOCK)
  1. ..S @LOCKS@(LOCK,NODE,"PID")=PID
  1. ..S @LOCKS@(LOCK,NODE,"TASK")=$G(^XUTL("XQ",PID,"ZTSKNUM"))
  1. ..S @LOCKS@(LOCK,NODE,"OWNER")=$$OWNER(PID,@LOCKS@(LOCK,NODE,"SYSTEM"))
  1. Q
  1. ;
  1. OWNER(PID,SYSTEM) ;Return the DUZ^<name> of owner of this process
  1. N OWNER,OWNERDUZ
  1. S (OWNER,OWNERDUZ)=""
  1. I PID=$J S OWNERDUZ=$G(DUZ)
  1. S:'OWNERDUZ OWNERDUZ=$G(^XUTL("XQ",PID,"DUZ"))
  1. S:OWNERDUZ OWNER=$P($G(^VA(200,OWNERDUZ,0)),"^")
  1. I OWNER="",'$G(SYSTEM) S OWNER=$$OSUSER^%ZLMLIB(PID)
  1. I OWNER="" S OWNER="{?}"
  1. I OWNER="{?}",$E(LOCK,1,4)["%ZT" S OWNER="TASKMAN"
  1. Q OWNERDUZ_"^"_OWNER
  1. ;
  1. ;
  1. PAT(DFN) ;
  1. ;Returns ID() array with patient information
  1. K ID
  1. I 'DFN S ID(0)=0,ID("IEN")="" Q
  1. S ID("IEN")=DFN
  1. D ADDPAT(DFN)
  1. Q
  1. ADDPAT(DFN) ;
  1. ;Adds patient information to the existing ID() array.
  1. Q:'DFN
  1. N NODE
  1. S NODE=$G(^DPT(DFN,0))
  1. Q:NODE=""
  1. S ID(0)=+$G(ID(0))
  1. S ID(ID(0)+1)="Patient Name:"_$P(NODE,"^"),ID(ID(0)+2)="Sex:"_$S($P(NODE,"^",2)="M":"MALE",1:"FEMALE"),ID(ID(0)+3)="DOB:"_$$FMTE^XLFDT($P(NODE,"^",3)),ID(ID(0)+4)="SSN:"_$P(NODE,"^",9),ID(0)=ID(0)+4
  1. Q
  1. ;
  1. PAUSE(MSG) ;
  1. ;Screen pause without scrolling. Returns 1 if the user quits out
  1. ;
  1. I $L($G(MSG)) W !,MSG,!
  1. N DIR,DIRUT,X,Y
  1. S DIR(0)="E"
  1. D ^DIR
  1. Q:('(+Y))!$D(DIRUT) 1
  1. Q 0
  1. PAUSE2(MSG) ;
  1. ;First scroll to the bottome of the page, then does a screen pause. Returns 1 if user decides to quit, otherwise returns 0
  1. ;
  1. I $L($G(MSG)) W !,MSG,!
  1. N DIR,X,Y,QUIT
  1. S QUIT=0
  1. F Q:$Y>(IOSL-3) W !
  1. S DIR(0)="E"
  1. D ^DIR
  1. I ('(+Y))!$D(DIRUT) S QUIT=1
  1. Q QUIT
  1. ;
  1. ASKYESNO(PROMPT,DEFAULT) ;
  1. ;Description: Displays PROMPT, appending '?'. Expects a YES NO response
  1. ;Input:
  1. ; PROMPT - text to display as prompt. Appends '?'
  1. ; DEFAULT - (optional) YES or NO. If not passed, defaults to YES
  1. ;Output:
  1. ; Function value: 1 if yes, 0 if no, "" if '^' entered or timeout
  1. ;
  1. N DIR,Y
  1. S DIR(0)="Y"
  1. S DIR("A")=PROMPT
  1. S DIR("B")=$S($G(DEFAULT)="NO":"NO",1:"YES")
  1. D ^DIR
  1. Q:$D(DIRUT) ""
  1. Q Y
  1. ;
  1. ;
  1. IFSYSTEM(LOCK) ;returns 1 if system lock, 0 otherwise
  1. N SUB,LEN,FOUND,NOTFOUND
  1. I $P(LOCK,"(")["%" Q 1
  1. S (FOUND,NOTFOUND)=0
  1. S LEN=$L(LOCK)
  1. F I=1:1:LEN S SUB=$E(LOCK,1,I) D Q:FOUND Q:NOTFOUND
  1. .I $D(^XLM(8993.1,"AC",SUB)) S FOUND=1 Q
  1. .N NEXT
  1. .S NEXT=$O(^XLM(8993.1,"AC",SUB))
  1. .I NEXT="" S NOTFOUND=1 Q
  1. .I NEXT]LOCK S NOTFOUND=1 Q
  1. Q FOUND
  1. ;
  1. NODE() ;Get Cache' instance name for this process
  1. Q ##class(%SYS.System).GetInstanceName()
  1. ;
  1. VOLUME() ;Returns the namespace of current environment
  1. Q $SYSTEM.SYS.NameSpace()
  1. ;
  1. SAMENODE(NODE) ;Is the current process running on the indicated node?
  1. N SNODE
  1. S SNODE=$$NODE()
  1. I $G(NODE)=SNODE Q 1
  1. Q 0
  1. ;
  1. OS() ;Get OS
  1. N X
  1. S X=$$VERSION^%ZOSV(1)
  1. Q $S(X["VMS":"VMS",X["UNIX":"LNX",X["Linux":"LNX",X["Windows":"WIN",1:"? OS")
  1. ;
  1. ;
  1. HEX(DEC) ;Convert decimal number to hexidecimal
  1. Q $$BASE^XLFUTL(DEC,10,16)
  1. ;
  1. ADD(FILE,DA,DATA,ERROR,IEN) ;
  1. ;
  1. ;Description: Creates a new record and files the data.
  1. ; Input:
  1. ; FILE - File or sub-file number
  1. ; DA - Traditional FileMan DA array with same
  1. ; meaning. Pass by reference. Only needed if adding to a
  1. ; subfile.
  1. ; DATA - Data array to file, pass by reference
  1. ;Format: DATA(<field #>)=<value>
  1. ; IEN - internal entry number to use (optional)
  1. ;
  1. ; Output:
  1. ; Function Value - If no error then it returns the ien of the created
  1. ;record, else returns NULL.
  1. ; DA - returns the ien of the new record, NULL if none created. If needed, pass by reference.
  1. ; ERROR - optional error message - if needed, pass by reference
  1. ;
  1. ; Example: To add a record in subfile 2.0361 in the record with ien=353
  1. ;with the field .01 value = 21:
  1. ; S DATA(.01)=21,DA(1)=353 I $$ADD(2.0361,.DA,.DATA) W !,"DONE"
  1. ;
  1. ; Example: If creating a record not in a subfile, would look like this:
  1. ;S DATA(.01)=21 I $$ADD(867,,.DATA) W !,"DONE"
  1. ;
  1. N FDA,FIELD,IENA,IENS,ERRORS,DIERR
  1. ;
  1. ;IENS - Internal Entry Number String defined by FM
  1. ;IENA - the Internal Entry Number Array defined by FM
  1. ;FDA - the FDA array defined by FM
  1. ;IEN - the ien of the new record
  1. ;
  1. S DA="+1"
  1. S IENS=$$IENS^DILF(.DA)
  1. S FIELD=0
  1. F S FIELD=$O(DATA(FIELD)) Q:'FIELD D
  1. .S FDA(FILE,IENS,FIELD)=$G(DATA(FIELD))
  1. I $G(IEN) S IENA(1)=IEN
  1. D UPDATE^DIE("","FDA","IENA","ERRORS(1)")
  1. I +$G(DIERR) D
  1. .S ERROR=$G(ERRORS(1,"DIERR",1,"TEXT",1))
  1. .S IEN=""
  1. E D
  1. .S IEN=IENA(1)
  1. .S ERROR=""
  1. D CLEAN^DILF
  1. S DA=IEN
  1. Q IEN
  1. ;
  1. DELETE(FILE,DA,ERROR) ;
  1. ;Delete an existing record.
  1. N DATA
  1. S DATA(.01)="@"
  1. Q $$UPD(FILE,.DA,.DATA,.ERROR)
  1. Q
  1. ;
  1. UPD(FILE,DA,DATA,ERROR) ;File data into an existing record.
  1. ; Input:
  1. ; FILE - File or sub-file number
  1. ; DA - Traditional DA array, with same meaning.
  1. ; Pass by reference.
  1. ; DATA - Data array to file (pass by reference)
  1. ;Format: DATA(<field #>)=<value>
  1. ;
  1. ; Output:
  1. ; Function Value - 0=error and 1=no error
  1. ; ERROR - optional error message - if needed, pass by reference
  1. ;
  1. ; Example: To update a record in subfile 2.0361 in record with ien=353,
  1. ;subrecord ien=68, with the field .01 value = 21:
  1. ; S DATA(.01)=21,DA=68,DA(1)=353 I $$UPD(2.0361,.DA,.DATA,.ERROR) W !,"DONE"
  1. ;
  1. N FDA,FIELD,IENS,ERRORS
  1. ;
  1. ;IENS - Internal Entry Number String defined by FM
  1. ;FDA - the FDA array as defined by FM
  1. ;
  1. I '$G(DA) S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED" Q 0
  1. S IENS=$$IENS^DILF(.DA)
  1. S FIELD=0
  1. F S FIELD=$O(DATA(FIELD)) Q:'FIELD D
  1. .S FDA(FILE,IENS,FIELD)=$G(DATA(FIELD))
  1. D FILE^DIE("","FDA","ERRORS(1)")
  1. I +$G(DIERR) D
  1. .S ERROR=$G(ERRORS(1,"DIERR",1,"TEXT",1))
  1. E D
  1. .S ERROR=""
  1. ;
  1. D CLEAN^DILF
  1. Q $S(+$G(DIERR):0,1:1)
  1. ;
  1. SETCLEAN(RTN,VAR) ;
  1. ;Description: The purpose of this API is to register a cleanup routine
  1. ; that should be executed when the process is terminated by the
  1. ; Kernel Lock Manager. An entry is created on a stack kept for the
  1. ; process. The location is ^XTMP("XULM","XULM CLEANUP_"_$J,0) where $J
  1. ; uniquely identifies the process. A process may call SETCLEAN^XULMU
  1. ; repeatedly, and each time a new entry is placed on the stack.
  1. ;
  1. ;Input:
  1. ; RTN - The routine to be executed when the process is terminated.
  1. ; VAR - A list of variables that should be defined whent the routine
  1. ; is executed. It is up to the application to insure that
  1. ; all the required variables are defined.
  1. ; Function: An integer is returned that identifies the entry created
  1. ; on the stack. The application needs to retain this only
  1. ; if it may need to later remove the entry from the stack.
  1. ;
  1. ; Example:
  1. ; S VAR("DFN")=DFN
  1. ; S CLNENTRY=$$SETCLEAN^XULMU("MYCLEAN^MYRTN",.VAR)
  1. ;
  1. N I,GBL
  1. S GBL=$NA(^XTMP("XULM","XULM CLEANUP_"_$J,0))
  1. ;I '$D(@GBL@(0)) S @GBL@(0)=$$FMADD^XLFDT($$NOW^XLFDT\1,2)_"me^here"_$$NOW^XLFDT\1
  1. I '$D(@GBL@(0)) D
  1. .S @GBL@(0)=$$FMADD^XLFDT($$NOW^XLFDT\1,2)
  1. .S @GBL@(0)=@GBL@(0)_"^"_($$NOW^XLFDT\1)
  1. S I=+$O(@GBL@(9999999),-1)+1
  1. S @GBL@(I,"ROUTINE")=RTN
  1. M @GBL@(I,"VARIABLES")=VAR
  1. Q I
  1. ;
  1. CLEANUP(XULAST,DOLLARJ) ;
  1. ;Description: This API will execute the housecleaning stack set by the
  1. ;process identified by DOLLARJ. Entries are executed in the FIFO order,
  1. ;with the last entry added being the first to be executed, and XULAST
  1. ;being the last entry executed. If LAST is not passed in,
  1. ;then the entire stack is executed.
  1. ;
  1. ;Input:
  1. ; XULAST (optional) - This is the last entry that will be executed.
  1. ; If not passed in, then the entire housecleaning stack is executed.
  1. ; DOLLARJ - The $J value of the process that created the housecleaning
  1. ; stack. If DOLLARJ is not passed in, the value defaults to be $J.
  1. ;
  1. N XUGBL,XUENTRY
  1. I $G(DOLLARJ)="" S DOLLARJ=$J
  1. S XUGBL=$NA(^XTMP("XULM","XULM CLEANUP_"_DOLLARJ,0))
  1. S XULAST=+$G(XULAST)
  1. S XUENTRY=9999
  1. F S XUENTRY=$O(@XUGBL@(XUENTRY),-1) Q:XUENTRY<XULAST D
  1. .N XURTN,XUVAR
  1. .S XURTN=$G(@XUGBL@(XUENTRY,"ROUTINE"))
  1. .S XUVAR=""
  1. .F S XUVAR=$O(@XUGBL@(XUENTRY,"VARIABLES",XUVAR)) Q:XUVAR="" N @XUVAR S @XUVAR=@XUGBL@(XUENTRY,"VARIABLES",XUVAR)
  1. .D:$L(XURTN) @XURTN
  1. .K @XUGBL@(XUENTRY)
  1. Q
  1. UNCLEAN(LAST,DOLLARJ) ;
  1. ;Description - this removes entries form the housecleaning stack set by
  1. ;calling SETCLEAN^XULMU. Entries are removed in FIFO order. If LAST is
  1. ;not passed in, then the entire stack is deleted, otherwise just the
  1. ;entries back to LAST are removed.
  1. ;Input:
  1. ; LAST - Identifies the last entry on the housekeeping stack to remove.
  1. ; Entries are removed in FIFO order, so the first entry removed is
  1. ; the last entry that was added, and the last entry removed is
  1. ; LAST. If not passed in, the entire housecleainging stack is
  1. ; deleted.
  1. ; DOLLARJ (optional) The $J value of process that set the stack. If
  1. ; not passed in then its value is assumed to be $J.
  1. ;
  1. N GBL,ENTRY
  1. I $G(DOLLARJ)="" S DOLLARJ=$J
  1. S GBL=$NA(^XTMP("XULM","XULM CLEANUP_"_DOLLARJ,0))
  1. S LAST=+$G(LAST)
  1. I 'LAST K @GBL Q
  1. S ENTRY=9999
  1. F S ENTRY=$O(@GBL@(ENTRY),-1) Q:ENTRY<LAST K @GBL@(ENTRY) I 'ENTRY K @GBL
  1. Q
  1. ;
  1. TEMPLATE(IEN) ;Returns the lock template, with the "^" prefix if it is on a global
  1. N LOCK
  1. S LOCK=$G(^XLM(8993,IEN,0))
  1. I $P($G(^XLM(8993,IEN,1)),"^",2) S LOCK="^"_LOCK
  1. Q LOCK
  1. ;
  1. ;