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

SDECLK.m

Go to the documentation of this file.
  1. SDECLK ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
  1. ;;5.3;Scheduling;**627,686**;Aug 13, 1993;Build 53
  1. ;
  1. Q
  1. ;
  1. LOCK(SDECY,REQ) ; -- Attempt to lock request record
  1. ;INPUT:
  1. ; REQ = Request - (required) Appt Request type - variable pointer pointer
  1. ; to one of these files:
  1. ; SDEC APPT REQUEST - A|<APPT IEN> A|123
  1. ; SD WAIT LIST - E|<WL IEN> E|123
  1. ; REQUEST/CONSULTATION - C|<CONSULT IEN> C|123
  1. ; RECALL REMINDERS - R|^<RECALL IEN> R|123
  1. ;RETURN:
  1. ; A single entry in the global array indicating the success/failure of getting the lock:
  1. ; 1. CODE - 1 if successful, or 0^Message if could not get lock
  1. ; 2. MESSAGE - Message Text
  1. N RET,SDI,SDTYP,SDIEN
  1. N Y,SDECLK,NOW,NOW1
  1. S SDECY="^TMP(""SDEC"","_$J_")"
  1. K @SDECY
  1. S @SDECY@(0)="T00030CODE^T00030MESSAGE"_$C(30)
  1. I $G(REQ)="" S RET="0^Invalid Request input"_$C(30,31) Q
  1. S SDTYP=$P(REQ,"|",1) I "ACER"'[SDTYP S @SDECY@(1)="0^Invalid Request Type"_$C(30,31) Q
  1. S SDIEN=$P(REQ,"|",2) I SDIEN'?1.N S @SDECY@(1)="0^Invalid Request ID"_$C(30,31) Q
  1. S SDECLK=$G(^XTMP("SDECLK"_SDTYP_"-"_SDIEN,1)) I $P(SDECLK,U,1)=DUZ S @SDECY@(1)="1^You already have the lock"_$C(30,31) Q ;*zeb 3/15/18 return this result for user for any $J
  1. L +^XTMP("SDECLK"_SDTYP_"-"_SDIEN):5 I '$T S @SDECY@(1)="0^"_$S(+SDECLK:$P($G(^VA(200,+SDECLK,0)),U),1:"Another person")_" is editing this request."_$C(30,31) Q
  1. I SDECLK,$P(SDECLK,U,1)'=DUZ S @SDECY@(1)="0^"_$S(+SDECLK:$P($G(^VA(200,+SDECLK,0)),U),1:"Another person")_" is editing this request."_$C(30,31) L -^XTMP("SDECLK"_SDTYP_"-"_SDIEN) Q ;*zeb 3/15/18 respect locks from other users
  1. ;unlock user's previous locks
  1. S SDI="SDECLK" F S SDI=$O(^XTMP(SDI)) Q:SDI'["SDECLK" Q:SDI="" D
  1. .I ($P($G(^XTMP(SDI,1)),U,1)=DUZ)!($P($G(^XTMP(SDI,1)),U,1)="") D
  1. ..L +^XTMP(SDI):5 ;*zeb+1 3/15/18 fix handling of system locks
  1. ..Q:'$T
  1. ..K ^XTMP(SDI)
  1. ..L -^XTMP(SDI)
  1. S NOW=$$NOW^XLFDT,NOW1=$$FMADD^XLFDT(NOW,1)
  1. S ^XTMP("SDECLK"_SDTYP_"-"_SDIEN,0)=NOW1_U_NOW_"^VSE GUI Request Lock"
  1. S ^XTMP("SDECLK"_SDTYP_"-"_SDIEN,1)=DUZ_U_$J
  1. S @SDECY@(1)="1^Lock successful"_$C(30,31)
  1. L -^XTMP("SDECLK"_SDTYP_"-"_SDIEN) ;*zeb 3/15/18 fix handling of system locks
  1. Q
  1. ;
  1. UNLOCK(SDECY,REQ,FLG) ; -- Unlock request record
  1. ;INPUT:
  1. ; REQ = (required) - Appt Request type - variable pointer pointer
  1. ; to one of these files:
  1. ; SDEC APPT REQUEST - A|<APPT IEN> A|123
  1. ; SD WAIT LIST - E|<WL IEN> E|123
  1. ; REQUEST/CONSULTATION - C|<CONSULT IEN> C|123
  1. ; RECALL REMINDERS - R|^<RECALL IEN> R|123
  1. ; FLG = (optional) Unlock if other job
  1. ; 0 = (default) only unlock if lock belongs to current user and current $J job
  1. ; 1 = unlock even if the lock does not belong to current user and current $J job
  1. ;RETURN:
  1. ; A single entry in the global array indicating the success of unlocking the record:
  1. ; 1. CODE - 1 if successful, or 0^Message if could not get lock
  1. ; 2. MESSAGE - Message Text
  1. ; If message text="Not your lock" you can call again and send 1 as the 2nd input to unlock anyway.
  1. N SDTYP,SDIEN
  1. N Y,SDECLK,NOW,NOW1,SDECUSER
  1. S SDECY="^TMP(""SDEC"","_$J_")"
  1. K @SDECY
  1. S @SDECY@(0)="T00030CODE^T00030MESSAGE"_$C(30)
  1. I $G(REQ)="" S @SDECY@(1)="0^Invalid Request input"_$C(30,31) Q
  1. S SDTYP=$P(REQ,"|",1) I "ACER"'[SDTYP S @SDECY@(1)="0^Invalid Request Type"_$C(30,31) Q
  1. S SDIEN=$P(REQ,"|",2) I SDIEN'?1.N S @SDECY@(1)="0^Invalid Request ID"_$C(30,31) Q
  1. L +^XTMP("SDECLK"_SDTYP_"-"_SDIEN):5 I '$T S @SDECY@(1)="0^Unable to access lock table."_$C(30,31) Q ;*zeb 3/15/18 fix handling of system locks
  1. S SDECLK=$G(^XTMP("SDECLK"_SDTYP_"-"_SDIEN,1)) ;*zeb+2 3/15/18 only do this once
  1. S SDECUSER=$P(SDECLK,U,1)
  1. I $G(FLG)'=1,(SDECUSER]""),(SDECUSER'=DUZ) S @SDECY@(1)="1^Not your lock"_$C(30,31) L -^XTMP("SDECLK"_SDTYP_"-"_SDIEN) Q ;*zeb 3/22/18 fix handling of system locks
  1. ;the previous line is a silent failure if the lock doesn't exist or if someone else has it; they already have been behaving as if they had the lock
  1. ;this is a "shouldn't happen" scenario since the user had the lock before they tried to get rid of it, but we don't want to delete the new user
  1. K ^XTMP("SDECLK"_SDTYP_"-"_SDIEN) ;*zeb+1 3/15/18 change node before unlocking it
  1. L -^XTMP("SDECLK"_SDTYP_"-"_SDIEN)
  1. S @SDECY@(1)="1^Unlock successful"_$C(30,31)
  1. Q
  1. ;
  1. ;*zeb+tag 3/19/18 686 fix lock handling
  1. ;--------------------
  1. ;UNLKALL - Remove users' appointment request locks interactively
  1. ;--------------------
  1. UNLKALL ;interactive option to remove a user's locks
  1. N SDECUSER,DIC,Y,U,SDNODE,SDLKDATA,SDLKUSER,SDLKFILE,SDLKIEN
  1. S Y="",U="^"
  1. W !,"Release all appointment request locks held by a user",!
  1. F D I Y=-1 Q
  1. .K DIC,Y
  1. .S DIC="^VA(200,"
  1. .S DIC(0)="AEQ"
  1. .S DIC("A")="Whose locks to release? "
  1. .D ^DIC
  1. .Q:(Y=-1)
  1. .S SDECUSER=$P(Y,U,1)
  1. .S SDNODE="SDECLK"
  1. .F S SDNODE=$O(^XTMP(SDNODE)) Q:SDNODE'["SDECLK" D
  1. ..S SDLKDATA=$G(^XTMP(SDNODE,1))
  1. ..S SDLKUSER=$P(SDLKDATA,U,1)
  1. ..Q:SDLKUSER'=SDECUSER ;only want locks for this user
  1. ..K ^XTMP(SDNODE)
  1. ..S SDLKFILE=$E(SDNODE,7)
  1. ..S SDLKFILE=$S(SDLKFILE="E":"EWL Request",SDLKFILE="R":"PtCSch Request",SDLKFILE="C":"Consult",1:"APPT Request")
  1. ..S SDLKIEN=$P(SDNODE,"-",2)
  1. ..W !,"Lock released for "_SDLKFILE_" "_SDLKIEN
  1. Q