PXUALOCK.m

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 ---PXUALOCK   1170     printed  Apr 09, 2024@21:31:38                                                                                                                                                                                                    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