BOPMTR ;IHS/ILC/ALG/CIA/PLS - ILC Job Monitor;16-Aug-2005 10:56;SM
;;1.0;AUTOMATED DISPENSING INTERFACE;**1**;Jul 26, 2005
;This routine should be started immediately when MUMPs is started
;Consider it to run in the Automatic partition startup at reboot.
N V,X,Y,QFLG
D INIT
S BOPWHO=$$INTFACE^BOPTU(1)
S BOPWHO=$S(BOPWHO="O":"Omnicell",1:"Pyxis")
;
;Stop the Monitor running / Schedule Monitor Task
START G ENQUE2:'$P($G(^BOP(90355,1,4)),U) D ENQUE2
;
CHECK ;Start a Listener/Sender pair for each Facility
;
;Make sure another monitor is not running and hold lock if not
K BOPTOP L ^BOP(90355,"L","MONITOR"):1 E S BOPTOP=1 Q
;
S BOPI=0 F S BOPI=$O(^BOP(90355,1,3,BOPI)) Q:BOPI<1 D
.S BOPD0=$G(^BOP(90355,1,3,BOPI,0)) Q:'BOPD0 Q:'$P(BOPD0,U,2)
.S (V,BOPDIV)=$P(BOPD0,U),BOPIP=$P(BOPD0,U,3)
.S BOPOCK=$P(BOPD0,U,4),BOPLSOC=$P(BOPD0,U,5)
.S BOPPCPU=$P(BOPD0,U,7)
.L +^BOP(90355,"S",V):1 D QUESEND:$T L -^BOP(90355,"S",V)
.;
.L +^BOP(90355,"L",V):1 D QUEREC:$T L -^BOP(90355,"L",V)
;
;Check to see if HL-7 messages are being processed.
L +^BOP(90355.1,"FILER"):1 E G CHQ
;
;Check queue for records that require processing - Start Task?
;Must be a "Filable" Transaction. $P(^BOP(90355.1,X,99),U)=1
;Transaction ready to process. $P(^BOP(90355.1,X,99),U,2)=0
S (QFLG,X)=0 F S X=$O(^BOP(90355.1,"AC",0,X)) Q:'X!QFLG D
.S Y=$G(^BOP(90355.1,X,99))
.I Y,$P(Y,U)=1,'$P(Y,U,2) D QUEFILE S QFLG=1
FQ ;
L -^BOP(90355.1,"FILER")
;
;Start the BOP interface
;
; Quit if the STOP flag is set
G CHQ:'$P($G(^BOP(90355,1,"IP-MCK")),U,2)
;
; Quit if not active
G CHQ:$L($P($G(^BOP(90355,1,"IP-MCK")),U))=0
;
; Quit if the interface is already running -- Lock lock
L +^BOP(90355,"IP-MCK"):3 E G CHQ
;
; Schedule the interface
D QUEMCK
;
; Unlock the lock
L -^BOP(90355,"IP-MCK")
Q
;
CHQ ;Set the Monitor Stop flag and quit
S BOPTOP=+$G(^BOP(90355,1,12))
I '$G(ZTQUEUED) W !!,"Background Monitor Queued."
Q
QUEFILE ;Schedule Transaction Filer
S ZTRTN="GO^BOPRNEW1",ZTDESC=$G(BOPWHO)_" Interface Filer"
G QUE
QUESEND ;Schedule Transmit Tasks
I 'BOPIP!'BOPOCK!'BOPIP G ERROR
S ZTRTN="GO^BOPT1",ZTDESC=$G(BOPWHO)_" Queue Transmitter"
F I="BOPDIV","BOPOCK","BOPIP" S ZTSAVE(I)=""
G QUE
QUEREC ;Schedule Standard Receiver
I 'BOPLSOC!'BOPIP G ERROR
S ZTRTN="GO^BOPRNEW",ZTDESC=$G(BOPWHO)_" TCP/IP HL-7 Receiver"
S ZTSAVE("BOPDIV")="",ZTSAVE("BOPLSOC")="",ZTSAVE("BOPIP")=""
G QUE
QUEMCK ;Schedule the Interface
S ZTRTN="GO^BOPRMC",ZTDESC=$G(BOPWHO)_" / BOP Interface Receiver"
G QUE
CHK(X) ;Do not schedule another task if one is already running
N ZTSK S ZTSK=$P($G(^BOP(90355,1,4)),U,3)
I 'ZTSK Q 0
D STAT^%ZTLOAD I $G(ZTSK(0)),$G(ZTSK(1))=1 Q 1
Q 0
ENQUE ;BOP Start Monitor option (BOP MONITOR)
Q:$$CHK() S $P(^BOP(90355,1,12),U,1)=0 D MON,QUE,DIE
Q
DIE Q:'$G(ZTSK) N DA,DIE,DR S DA=1,DIE=90355,DR="4.2///"_ZTSK D ^DIE
Q
QUE S ZTDTH=$$NOW^XLFDT
QUEA S ZTIO="" D ^%ZTLOAD
Q
TASK ;For Monitor option
D ENQUE
W !!,"Task #"_$S($G(ZTSK):ZTSK,1:$P($G(^BOP(90355,1,4)),U,3))
W " has been scheduled to start the Monitor."
Q
ENQUE2 ;Schedule task to run Monitor according to field 4.1, "Monitor
;Rescheduling Frequency", in file 90355, "BOP Site Parameters".
Q:$$CHK() S X=$P($G(^BOP(90355,1,4)),U,2) ;Reschedule frequency in seconds
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,,X)
S $P(^BOP(90355,1,12),U,1)=0 D MON,QUEA,DIE
Q
MON S ZTRTN="BOPMTR",ZTDESC="Start "_$G(BOPWHO)_" Monitor"
Q
ERROR ;Send message on error
S XMSUB=$G(BOPWHO)_" Site Parameters Problem",XMY(.5)=""
I $G(DUZ) S XMY(DUZ)=""
S XMTEXT="X(",X(1)="Review BOP Site Parameters."
S X(2)="The socket or IP address may be missing."
S X(3)="There may not be a Division defined."
D ^XMD
Q
JOBGO D INIT
F D CHECK H 120 Q:'$P($G(^BOP(90355,1,4)),U)!$G(BOPTOP)
Q
;The following tag is to be "jobbed" out manually if
;a site desires to start a monitor that runs all of the time.
JOB N ZTIO,ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTSK
S ZTIO="",ZTDTH=$H,ZTRTN="JOBGO^BOPMTR",ZTDESC="BOP MONITOR"
D ^%ZTLOAD
Q
INIT ;Initialize an environment
D GETENV^%ZOSV S DIQUIET=1 D DT^DICRW
Q
BOPMTR ;IHS/ILC/ALG/CIA/PLS - ILC Job Monitor;16-Aug-2005 10:56;SM
+1 ;;1.0;AUTOMATED DISPENSING INTERFACE;**1**;Jul 26, 2005
+2 ;This routine should be started immediately when MUMPs is started
+3 ;Consider it to run in the Automatic partition startup at reboot.
+4 NEW V,X,Y,QFLG
+5 DO INIT
+6 SET BOPWHO=$$INTFACE^BOPTU(1)
+7 SET BOPWHO=$SELECT(BOPWHO="O":"Omnicell",1:"Pyxis")
+8 ;
+9 ;Stop the Monitor running / Schedule Monitor Task
START IF '$PIECE($GET(^BOP(90355,1,4)),U)
GOTO ENQUE2
DO ENQUE2
+1 ;
CHECK ;Start a Listener/Sender pair for each Facility
+1 ;
+2 ;Make sure another monitor is not running and hold lock if not
+3 KILL BOPTOP
LOCK ^BOP(90355,"L","MONITOR"):1
IF '$TEST
SET BOPTOP=1
QUIT
+4 ;
+5 SET BOPI=0
FOR
SET BOPI=$ORDER(^BOP(90355,1,3,BOPI))
IF BOPI<1
QUIT
Begin DoDot:1
+6 SET BOPD0=$GET(^BOP(90355,1,3,BOPI,0))
IF 'BOPD0
QUIT
IF '$PIECE(BOPD0,U,2)
QUIT
+7 SET (V,BOPDIV)=$PIECE(BOPD0,U)
SET BOPIP=$PIECE(BOPD0,U,3)
+8 SET BOPOCK=$PIECE(BOPD0,U,4)
SET BOPLSOC=$PIECE(BOPD0,U,5)
+9 SET BOPPCPU=$PIECE(BOPD0,U,7)
+10 LOCK +^BOP(90355,"S",V):1
IF $TEST
DO QUESEND
LOCK -^BOP(90355,"S",V)
+11 ;
+12 LOCK +^BOP(90355,"L",V):1
IF $TEST
DO QUEREC
LOCK -^BOP(90355,"L",V)
End DoDot:1
+13 ;
+14 ;Check to see if HL-7 messages are being processed.
+15 LOCK +^BOP(90355.1,"FILER"):1
IF '$TEST
GOTO CHQ
+16 ;
+17 ;Check queue for records that require processing - Start Task?
+18 ;Must be a "Filable" Transaction. $P(^BOP(90355.1,X,99),U)=1
+19 ;Transaction ready to process. $P(^BOP(90355.1,X,99),U,2)=0
+20 SET (QFLG,X)=0
FOR
SET X=$ORDER(^BOP(90355.1,"AC",0,X))
IF 'X!QFLG
QUIT
Begin DoDot:1
+21 SET Y=$GET(^BOP(90355.1,X,99))
+22 IF Y
IF $PIECE(Y,U)=1
IF '$PIECE(Y,U,2)
DO QUEFILE
SET QFLG=1
End DoDot:1
FQ ;
+1 LOCK -^BOP(90355.1,"FILER")
+2 ;
+3 ;Start the BOP interface
+4 ;
+5 ; Quit if the STOP flag is set
+6 IF '$PIECE($GET(^BOP(90355,1,"IP-MCK")),U,2)
GOTO CHQ
+7 ;
+8 ; Quit if not active
+9 IF $LENGTH($PIECE($GET(^BOP(90355,1,"IP-MCK")),U))=0
GOTO CHQ
+10 ;
+11 ; Quit if the interface is already running -- Lock lock
+12 LOCK +^BOP(90355,"IP-MCK"):3
IF '$TEST
GOTO CHQ
+13 ;
+14 ; Schedule the interface
+15 DO QUEMCK
+16 ;
+17 ; Unlock the lock
+18 LOCK -^BOP(90355,"IP-MCK")
+19 QUIT
+20 ;
CHQ ;Set the Monitor Stop flag and quit
+1 SET BOPTOP=+$GET(^BOP(90355,1,12))
+2 IF '$GET(ZTQUEUED)
WRITE !!,"Background Monitor Queued."
+3 QUIT
QUEFILE ;Schedule Transaction Filer
+1 SET ZTRTN="GO^BOPRNEW1"
SET ZTDESC=$GET(BOPWHO)_" Interface Filer"
+2 GOTO QUE
QUESEND ;Schedule Transmit Tasks
+1 IF 'BOPIP!'BOPOCK!'BOPIP
GOTO ERROR
+2 SET ZTRTN="GO^BOPT1"
SET ZTDESC=$GET(BOPWHO)_" Queue Transmitter"
+3 FOR I="BOPDIV","BOPOCK","BOPIP"
SET ZTSAVE(I)=""
+4 GOTO QUE
QUEREC ;Schedule Standard Receiver
+1 IF 'BOPLSOC!'BOPIP
GOTO ERROR
+2 SET ZTRTN="GO^BOPRNEW"
SET ZTDESC=$GET(BOPWHO)_" TCP/IP HL-7 Receiver"
+3 SET ZTSAVE("BOPDIV")=""
SET ZTSAVE("BOPLSOC")=""
SET ZTSAVE("BOPIP")=""
+4 GOTO QUE
QUEMCK ;Schedule the Interface
+1 SET ZTRTN="GO^BOPRMC"
SET ZTDESC=$GET(BOPWHO)_" / BOP Interface Receiver"
+2 GOTO QUE
CHK(X) ;Do not schedule another task if one is already running
+1 NEW ZTSK
SET ZTSK=$PIECE($GET(^BOP(90355,1,4)),U,3)
+2 IF 'ZTSK
QUIT 0
+3 DO STAT^%ZTLOAD
IF $GET(ZTSK(0))
IF $GET(ZTSK(1))=1
QUIT 1
+4 QUIT 0
ENQUE ;BOP Start Monitor option (BOP MONITOR)
+1 IF $$CHK()
QUIT
SET $PIECE(^BOP(90355,1,12),U,1)=0
DO MON
DO QUE
DO DIE
+2 QUIT
DIE IF '$GET(ZTSK)
QUIT
NEW DA,DIE,DR
SET DA=1
SET DIE=90355
SET DR="4.2///"_ZTSK
DO ^DIE
+1 QUIT
QUE SET ZTDTH=$$NOW^XLFDT
QUEA SET ZTIO=""
DO ^%ZTLOAD
+1 QUIT
TASK ;For Monitor option
+1 DO ENQUE
+2 WRITE !!,"Task #"_$SELECT($GET(ZTSK):ZTSK,1:$PIECE($GET(^BOP(90355,1,4)),U,3))
+3 WRITE " has been scheduled to start the Monitor."
+4 QUIT
ENQUE2 ;Schedule task to run Monitor according to field 4.1, "Monitor
+1 ;Rescheduling Frequency", in file 90355, "BOP Site Parameters".
+2 ;Reschedule frequency in seconds
IF $$CHK()
QUIT
SET X=$PIECE($GET(^BOP(90355,1,4)),U,2)
+3 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,,X)
+4 SET $PIECE(^BOP(90355,1,12),U,1)=0
DO MON
DO QUEA
DO DIE
+5 QUIT
MON SET ZTRTN="BOPMTR"
SET ZTDESC="Start "_$GET(BOPWHO)_" Monitor"
+1 QUIT
ERROR ;Send message on error
+1 SET XMSUB=$GET(BOPWHO)_" Site Parameters Problem"
SET XMY(.5)=""
+2 IF $GET(DUZ)
SET XMY(DUZ)=""
+3 SET XMTEXT="X("
SET X(1)="Review BOP Site Parameters."
+4 SET X(2)="The socket or IP address may be missing."
+5 SET X(3)="There may not be a Division defined."
+6 DO ^XMD
+7 QUIT
JOBGO DO INIT
+1 FOR
DO CHECK
HANG 120
IF '$PIECE($GET(^BOP(90355,1,4)),U)!$GET(BOPTOP)
QUIT
+2 QUIT
+3 ;The following tag is to be "jobbed" out manually if
+4 ;a site desires to start a monitor that runs all of the time.
JOB NEW ZTIO,ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTSK
+1 SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTRTN="JOBGO^BOPMTR"
SET ZTDESC="BOP MONITOR"
+2 DO ^%ZTLOAD
+3 QUIT
INIT ;Initialize an environment
+1 DO GETENV^%ZOSV
SET DIQUIET=1
DO DT^DICRW
+2 QUIT
