- 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 Jan 18, 2025@03:32: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