- SDECLK ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
- ;;5.3;Scheduling;**627,686**;Aug 13, 1993;Build 53
- ;
- Q
- ;
- LOCK(SDECY,REQ) ; -- Attempt to lock request record
- ;INPUT:
- ; REQ = Request - (required) Appt Request type - variable pointer pointer
- ; to one of these files:
- ; SDEC APPT REQUEST - A|<APPT IEN> A|123
- ; SD WAIT LIST - E|<WL IEN> E|123
- ; REQUEST/CONSULTATION - C|<CONSULT IEN> C|123
- ; RECALL REMINDERS - R|^<RECALL IEN> R|123
- ;RETURN:
- ; A single entry in the global array indicating the success/failure of getting the lock:
- ; 1. CODE - 1 if successful, or 0^Message if could not get lock
- ; 2. MESSAGE - Message Text
- N RET,SDI,SDTYP,SDIEN
- N Y,SDECLK,NOW,NOW1
- S SDECY="^TMP(""SDEC"","_$J_")"
- K @SDECY
- S @SDECY@(0)="T00030CODE^T00030MESSAGE"_$C(30)
- I $G(REQ)="" S RET="0^Invalid Request input"_$C(30,31) Q
- S SDTYP=$P(REQ,"|",1) I "ACER"'[SDTYP S @SDECY@(1)="0^Invalid Request Type"_$C(30,31) Q
- S SDIEN=$P(REQ,"|",2) I SDIEN'?1.N S @SDECY@(1)="0^Invalid Request ID"_$C(30,31) Q
- 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
- 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
- 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
- ;unlock user's previous locks
- S SDI="SDECLK" F S SDI=$O(^XTMP(SDI)) Q:SDI'["SDECLK" Q:SDI="" D
- .I ($P($G(^XTMP(SDI,1)),U,1)=DUZ)!($P($G(^XTMP(SDI,1)),U,1)="") D
- ..L +^XTMP(SDI):5 ;*zeb+1 3/15/18 fix handling of system locks
- ..Q:'$T
- ..K ^XTMP(SDI)
- ..L -^XTMP(SDI)
- S NOW=$$NOW^XLFDT,NOW1=$$FMADD^XLFDT(NOW,1)
- S ^XTMP("SDECLK"_SDTYP_"-"_SDIEN,0)=NOW1_U_NOW_"^VSE GUI Request Lock"
- S ^XTMP("SDECLK"_SDTYP_"-"_SDIEN,1)=DUZ_U_$J
- S @SDECY@(1)="1^Lock successful"_$C(30,31)
- L -^XTMP("SDECLK"_SDTYP_"-"_SDIEN) ;*zeb 3/15/18 fix handling of system locks
- Q
- ;
- UNLOCK(SDECY,REQ,FLG) ; -- Unlock request record
- ;INPUT:
- ; REQ = (required) - Appt Request type - variable pointer pointer
- ; to one of these files:
- ; SDEC APPT REQUEST - A|<APPT IEN> A|123
- ; SD WAIT LIST - E|<WL IEN> E|123
- ; REQUEST/CONSULTATION - C|<CONSULT IEN> C|123
- ; RECALL REMINDERS - R|^<RECALL IEN> R|123
- ; FLG = (optional) Unlock if other job
- ; 0 = (default) only unlock if lock belongs to current user and current $J job
- ; 1 = unlock even if the lock does not belong to current user and current $J job
- ;RETURN:
- ; A single entry in the global array indicating the success of unlocking the record:
- ; 1. CODE - 1 if successful, or 0^Message if could not get lock
- ; 2. MESSAGE - Message Text
- ; If message text="Not your lock" you can call again and send 1 as the 2nd input to unlock anyway.
- N SDTYP,SDIEN
- N Y,SDECLK,NOW,NOW1,SDECUSER
- S SDECY="^TMP(""SDEC"","_$J_")"
- K @SDECY
- S @SDECY@(0)="T00030CODE^T00030MESSAGE"_$C(30)
- I $G(REQ)="" S @SDECY@(1)="0^Invalid Request input"_$C(30,31) Q
- S SDTYP=$P(REQ,"|",1) I "ACER"'[SDTYP S @SDECY@(1)="0^Invalid Request Type"_$C(30,31) Q
- S SDIEN=$P(REQ,"|",2) I SDIEN'?1.N S @SDECY@(1)="0^Invalid Request ID"_$C(30,31) Q
- 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
- S SDECLK=$G(^XTMP("SDECLK"_SDTYP_"-"_SDIEN,1)) ;*zeb+2 3/15/18 only do this once
- S SDECUSER=$P(SDECLK,U,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
- ;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
- ;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
- K ^XTMP("SDECLK"_SDTYP_"-"_SDIEN) ;*zeb+1 3/15/18 change node before unlocking it
- L -^XTMP("SDECLK"_SDTYP_"-"_SDIEN)
- S @SDECY@(1)="1^Unlock successful"_$C(30,31)
- Q
- ;
- ;*zeb+tag 3/19/18 686 fix lock handling
- ;--------------------
- ;UNLKALL - Remove users' appointment request locks interactively
- ;--------------------
- UNLKALL ;interactive option to remove a user's locks
- N SDECUSER,DIC,Y,U,SDNODE,SDLKDATA,SDLKUSER,SDLKFILE,SDLKIEN
- S Y="",U="^"
- W !,"Release all appointment request locks held by a user",!
- F D I Y=-1 Q
- .K DIC,Y
- .S DIC="^VA(200,"
- .S DIC(0)="AEQ"
- .S DIC("A")="Whose locks to release? "
- .D ^DIC
- .Q:(Y=-1)
- .S SDECUSER=$P(Y,U,1)
- .S SDNODE="SDECLK"
- .F S SDNODE=$O(^XTMP(SDNODE)) Q:SDNODE'["SDECLK" D
- ..S SDLKDATA=$G(^XTMP(SDNODE,1))
- ..S SDLKUSER=$P(SDLKDATA,U,1)
- ..Q:SDLKUSER'=SDECUSER ;only want locks for this user
- ..K ^XTMP(SDNODE)
- ..S SDLKFILE=$E(SDNODE,7)
- ..S SDLKFILE=$S(SDLKFILE="E":"EWL Request",SDLKFILE="R":"PtCSch Request",SDLKFILE="C":"Consult",1:"APPT Request")
- ..S SDLKIEN=$P(SDNODE,"-",2)
- ..W !,"Lock released for "_SDLKFILE_" "_SDLKIEN
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECLK 5591 printed Jan 18, 2025@03:53:23 Page 2
- SDECLK ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
- +1 ;;5.3;Scheduling;**627,686**;Aug 13, 1993;Build 53
- +2 ;
- +3 QUIT
- +4 ;
- LOCK(SDECY,REQ) ; -- Attempt to lock request record
- +1 ;INPUT:
- +2 ; REQ = Request - (required) Appt Request type - variable pointer pointer
- +3 ; to one of these files:
- +4 ; SDEC APPT REQUEST - A|<APPT IEN> A|123
- +5 ; SD WAIT LIST - E|<WL IEN> E|123
- +6 ; REQUEST/CONSULTATION - C|<CONSULT IEN> C|123
- +7 ; RECALL REMINDERS - R|^<RECALL IEN> R|123
- +8 ;RETURN:
- +9 ; A single entry in the global array indicating the success/failure of getting the lock:
- +10 ; 1. CODE - 1 if successful, or 0^Message if could not get lock
- +11 ; 2. MESSAGE - Message Text
- +12 NEW RET,SDI,SDTYP,SDIEN
- +13 NEW Y,SDECLK,NOW,NOW1
- +14 SET SDECY="^TMP(""SDEC"","_$JOB_")"
- +15 KILL @SDECY
- +16 SET @SDECY@(0)="T00030CODE^T00030MESSAGE"_$CHAR(30)
- +17 IF $GET(REQ)=""
- SET RET="0^Invalid Request input"_$CHAR(30,31)
- QUIT
- +18 SET SDTYP=$PIECE(REQ,"|",1)
- IF "ACER"'[SDTYP
- SET @SDECY@(1)="0^Invalid Request Type"_$CHAR(30,31)
- QUIT
- +19 SET SDIEN=$PIECE(REQ,"|",2)
- IF SDIEN'?1.N
- SET @SDECY@(1)="0^Invalid Request ID"_$CHAR(30,31)
- QUIT
- +20 ;*zeb 3/15/18 return this result for user for any $J
- SET SDECLK=$GET(^XTMP("SDECLK"_SDTYP_"-"_SDIEN,1))
- IF $PIECE(SDECLK,U,1)=DUZ
- SET @SDECY@(1)="1^You already have the lock"_$CHAR(30,31)
- QUIT
- +21 LOCK +^XTMP("SDECLK"_SDTYP_"-"_SDIEN):5
- IF '$TEST
- SET @SDECY@(1)="0^"_$SELECT(+SDECLK:$PIECE($GET(^VA(200,+SDECLK,0)),U),1:"Another person")_" is editing this request."_$CHAR(30,31)
- QUIT
- +22 ;*zeb 3/15/18 respect locks from other users
- IF SDECLK
- IF $PIECE(SDECLK,U,1)'=DUZ
- SET @SDECY@(1)="0^"_$SELECT(+SDECLK:$PIECE($GET(^VA(200,+SDECLK,0)),U),1:"Another person")_" is editing this request."_$CHAR(30,31)
- LOCK -^XTMP("SDECLK"_SDTYP_"-"_SDIEN)
- QUIT
- +23 ;unlock user's previous locks
- +24 SET SDI="SDECLK"
- FOR
- SET SDI=$ORDER(^XTMP(SDI))
- if SDI'["SDECLK"
- QUIT
- if SDI=""
- QUIT
- Begin DoDot:1
- +25 IF ($PIECE($GET(^XTMP(SDI,1)),U,1)=DUZ)!($PIECE($GET(^XTMP(SDI,1)),U,1)="")
- Begin DoDot:2
- +26 ;*zeb+1 3/15/18 fix handling of system locks
- LOCK +^XTMP(SDI):5
- +27 if '$TEST
- QUIT
- +28 KILL ^XTMP(SDI)
- +29 LOCK -^XTMP(SDI)
- End DoDot:2
- End DoDot:1
- +30 SET NOW=$$NOW^XLFDT
- SET NOW1=$$FMADD^XLFDT(NOW,1)
- +31 SET ^XTMP("SDECLK"_SDTYP_"-"_SDIEN,0)=NOW1_U_NOW_"^VSE GUI Request Lock"
- +32 SET ^XTMP("SDECLK"_SDTYP_"-"_SDIEN,1)=DUZ_U_$JOB
- +33 SET @SDECY@(1)="1^Lock successful"_$CHAR(30,31)
- +34 ;*zeb 3/15/18 fix handling of system locks
- LOCK -^XTMP("SDECLK"_SDTYP_"-"_SDIEN)
- +35 QUIT
- +36 ;
- UNLOCK(SDECY,REQ,FLG) ; -- Unlock request record
- +1 ;INPUT:
- +2 ; REQ = (required) - Appt Request type - variable pointer pointer
- +3 ; to one of these files:
- +4 ; SDEC APPT REQUEST - A|<APPT IEN> A|123
- +5 ; SD WAIT LIST - E|<WL IEN> E|123
- +6 ; REQUEST/CONSULTATION - C|<CONSULT IEN> C|123
- +7 ; RECALL REMINDERS - R|^<RECALL IEN> R|123
- +8 ; FLG = (optional) Unlock if other job
- +9 ; 0 = (default) only unlock if lock belongs to current user and current $J job
- +10 ; 1 = unlock even if the lock does not belong to current user and current $J job
- +11 ;RETURN:
- +12 ; A single entry in the global array indicating the success of unlocking the record:
- +13 ; 1. CODE - 1 if successful, or 0^Message if could not get lock
- +14 ; 2. MESSAGE - Message Text
- +15 ; If message text="Not your lock" you can call again and send 1 as the 2nd input to unlock anyway.
- +16 NEW SDTYP,SDIEN
- +17 NEW Y,SDECLK,NOW,NOW1,SDECUSER
- +18 SET SDECY="^TMP(""SDEC"","_$JOB_")"
- +19 KILL @SDECY
- +20 SET @SDECY@(0)="T00030CODE^T00030MESSAGE"_$CHAR(30)
- +21 IF $GET(REQ)=""
- SET @SDECY@(1)="0^Invalid Request input"_$CHAR(30,31)
- QUIT
- +22 SET SDTYP=$PIECE(REQ,"|",1)
- IF "ACER"'[SDTYP
- SET @SDECY@(1)="0^Invalid Request Type"_$CHAR(30,31)
- QUIT
- +23 SET SDIEN=$PIECE(REQ,"|",2)
- IF SDIEN'?1.N
- SET @SDECY@(1)="0^Invalid Request ID"_$CHAR(30,31)
- QUIT
- +24 ;*zeb 3/15/18 fix handling of system locks
- LOCK +^XTMP("SDECLK"_SDTYP_"-"_SDIEN):5
- IF '$TEST
- SET @SDECY@(1)="0^Unable to access lock table."_$CHAR(30,31)
- QUIT
- +25 ;*zeb+2 3/15/18 only do this once
- SET SDECLK=$GET(^XTMP("SDECLK"_SDTYP_"-"_SDIEN,1))
- +26 SET SDECUSER=$PIECE(SDECLK,U,1)
- +27 ;*zeb 3/22/18 fix handling of system locks
- IF $GET(FLG)'=1
- IF (SDECUSER]"")
- IF (SDECUSER'=DUZ)
- SET @SDECY@(1)="1^Not your lock"_$CHAR(30,31)
- LOCK -^XTMP("SDECLK"_SDTYP_"-"_SDIEN)
- QUIT
- +28 ;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
- +29 ;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
- +30 ;*zeb+1 3/15/18 change node before unlocking it
- KILL ^XTMP("SDECLK"_SDTYP_"-"_SDIEN)
- +31 LOCK -^XTMP("SDECLK"_SDTYP_"-"_SDIEN)
- +32 SET @SDECY@(1)="1^Unlock successful"_$CHAR(30,31)
- +33 QUIT
- +34 ;
- +35 ;*zeb+tag 3/19/18 686 fix lock handling
- +36 ;--------------------
- +37 ;UNLKALL - Remove users' appointment request locks interactively
- +38 ;--------------------
- UNLKALL ;interactive option to remove a user's locks
- +1 NEW SDECUSER,DIC,Y,U,SDNODE,SDLKDATA,SDLKUSER,SDLKFILE,SDLKIEN
- +2 SET Y=""
- SET U="^"
- +3 WRITE !,"Release all appointment request locks held by a user",!
- +4 FOR
- Begin DoDot:1
- +5 KILL DIC,Y
- +6 SET DIC="^VA(200,"
- +7 SET DIC(0)="AEQ"
- +8 SET DIC("A")="Whose locks to release? "
- +9 DO ^DIC
- +10 if (Y=-1)
- QUIT
- +11 SET SDECUSER=$PIECE(Y,U,1)
- +12 SET SDNODE="SDECLK"
- +13 FOR
- SET SDNODE=$ORDER(^XTMP(SDNODE))
- if SDNODE'["SDECLK"
- QUIT
- Begin DoDot:2
- +14 SET SDLKDATA=$GET(^XTMP(SDNODE,1))
- +15 SET SDLKUSER=$PIECE(SDLKDATA,U,1)
- +16 ;only want locks for this user
- if SDLKUSER'=SDECUSER
- QUIT
- +17 KILL ^XTMP(SDNODE)
- +18 SET SDLKFILE=$EXTRACT(SDNODE,7)
- +19 SET SDLKFILE=$SELECT(SDLKFILE="E":"EWL Request",SDLKFILE="R":"PtCSch Request",SDLKFILE="C":"Consult",1:"APPT Request")
- +20 SET SDLKIEN=$PIECE(SDNODE,"-",2)
- +21 WRITE !,"Lock released for "_SDLKFILE_" "_SDLKIEN
- End DoDot:2
- End DoDot:1
- IF Y=-1
- QUIT
- +22 QUIT