PXUALOCK ;ISA/KWP - PCE LOCK/UNLOCK UTILITY;3/29/1999
;;1.0;PCE PATIENT CARE ENCOUNTER;**67**;AUG 12, 1996
;+ LOCK(PXGLOBAL,PXWAIT,PXATT,PXMSG,PXBKG)
;+ Returns 1 success 0 failure
;+ PXGLOBAL -Global to be locked
;+ PXWAIT -seconds for wait, default of 0
;+ PXATT -Number of attempts to lock before failing
;+ 0 would mean until canceled,default
;+ PXMSG -a message to be printed above the wait message
;+ PXBKG -0 foreground, default
;+ 1 background, if background max 20 attempts
LOCK(PXGLOBAL,PXWAIT,PXATT,PXMSG,PXBKG) ;
I '$G(PXWAIT) S PXWAIT=0
I '$G(PXATT) S PXATT=0
I '$G(PXBKG) S PXBKG=0
N PXTMP,PXSPACE,PXEXIT,PXRESVAL S (PXEXIT,PXRESVAL)=0
F PXTMP=1:1:$S(PXATT:PXATT,PXBKG&('PXATT):20,1:9999999) D Q:PXEXIT
.L +@PXGLOBAL:PXWAIT
.I S (PXRESVAL,PXEXIT)=1 Q
.I 'PXBKG D
..I 'PXBKG,PXTMP=1 W:$G(PXMSG)'="" !,PXMSG W !,"Waiting for file access, press ENTER to cancel..."
..R PXSPACE:0
..I S PXEXIT=1 Q
..W "."
Q PXRESVAL
;+ UNLOCK (PXGLOBAL,PXMSG)
;+ PXGLOBAL -Global to unlock
;+ PXMSG -message to be printed when unlocked, if any
UNLOCK(PXGLOBAL,PXMSG) ;
L -@PXGLOBAL
I $G(PXMSG)'="" W !,PXMSG
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXUALOCK 1170 printed Dec 13, 2024@02:31:35 Page 2
PXUALOCK ;ISA/KWP - PCE LOCK/UNLOCK UTILITY;3/29/1999
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**67**;AUG 12, 1996
+2 ;+ LOCK(PXGLOBAL,PXWAIT,PXATT,PXMSG,PXBKG)
+3 ;+ Returns 1 success 0 failure
+4 ;+ PXGLOBAL -Global to be locked
+5 ;+ PXWAIT -seconds for wait, default of 0
+6 ;+ PXATT -Number of attempts to lock before failing
+7 ;+ 0 would mean until canceled,default
+8 ;+ PXMSG -a message to be printed above the wait message
+9 ;+ PXBKG -0 foreground, default
+10 ;+ 1 background, if background max 20 attempts
LOCK(PXGLOBAL,PXWAIT,PXATT,PXMSG,PXBKG) ;
+1 IF '$GET(PXWAIT)
SET PXWAIT=0
+2 IF '$GET(PXATT)
SET PXATT=0
+3 IF '$GET(PXBKG)
SET PXBKG=0
+4 NEW PXTMP,PXSPACE,PXEXIT,PXRESVAL
SET (PXEXIT,PXRESVAL)=0
+5 FOR PXTMP=1:1:$SELECT(PXATT:PXATT,PXBKG&('PXATT):20,1:9999999)
Begin DoDot:1
+6 LOCK +@PXGLOBAL:PXWAIT
+7 IF $TEST
SET (PXRESVAL,PXEXIT)=1
QUIT
+8 IF 'PXBKG
Begin DoDot:2
+9 IF 'PXBKG
IF PXTMP=1
if $GET(PXMSG)'=""
WRITE !,PXMSG
WRITE !,"Waiting for file access, press ENTER to cancel..."
+10 READ PXSPACE:0
+11 IF $TEST
SET PXEXIT=1
QUIT
+12 WRITE "."
End DoDot:2
End DoDot:1
if PXEXIT
QUIT
+13 QUIT PXRESVAL
+14 ;+ UNLOCK (PXGLOBAL,PXMSG)
+15 ;+ PXGLOBAL -Global to unlock
+16 ;+ PXMSG -message to be printed when unlocked, if any
UNLOCK(PXGLOBAL,PXMSG) ;
+1 LOCK -@PXGLOBAL
+2 IF $GET(PXMSG)'=""
WRITE !,PXMSG
+3 QUIT
