HLCSMM1 ;ISC-SF/JC - HL7 PROTOCOL FOR MAILMAN ;03/15/2011
;;1.6;HEALTH LEVEL SEVEN;**35,49,153**;Oct 13, 1995;Build 11
;Per VHA Directive 2004-038, this routine should not be modified.
INIT ;
N HLNOW,HLDOUT0,HLDOUT1
Q:'$D(HLDP)
;
;**P153 START CJM
L +^HLCS(870,HLDP,"OUT","MAILMAN CLIENT"):30 Q:'$T
;**P153 END CJM
;
D NOW^%DTC S HLNOW=%
UPDT ;Update link info
F L +^HLCS(870,HLDP,0):DTIME Q:$T H 1
S ZTSK=$G(ZTSK)
I ZTSK="" S HLTRACE=""
S DIE="^HLCS(870,",DA=HLDP
S DR="9////^S X=HLNOW;10////@;14////0;3////MM;18////@"
I ZTSK S DR=DR_";11////^S X=ZTSK"
D ^DIE K DIE,DA,DR
L -^HLCS(870,HLDP,0)
LOOP ;Begin send loop
S STOP=0
F H 1 D START Q:STOP
;
;**P153 START CJM
D STATUS("SHUTDOWN")
L -^HLCS(870,HLDP,"OUT","MAILMAN CLIENT")
;**P153 END CJM
Q
START ;
S HLNXST="IDLE"
D TRACE^HLCSDR2,STATUS(HLNXST)
S HLDOUT0=$$DEQUEUE^HLCSQUE(HLDP,"OUT")
S HLDOUT1=$P(HLDOUT0,U,2),HLDOUT0=+HLDOUT0
I HLDOUT0'<0 D
.S HLNXST="WRITING" D TRACE^HLCSDR2,STATUS(HLNXST)
.D EN^HLCSMM(HLDOUT0,HLDOUT1)
I $D(HLTRACE) U IO(0) W !,"Type 'Q' to quit: " R X:1 I $G(X)'=""&("Qq"[X) D
.F L +^HLCS(870,HLDP,0):DTIME Q:$T H 1
.S $P(^HLCS(870,HLDP,0),U,15)=1
.L -^HLCS(870,HLDP,0)
D STOP
Q
STATUS(HLNXST) ;Status update
F L +^HLCS(870,HLDP,0):DTIME Q:$T H 1
I $G(HLNXST)]"",$P(^HLCS(870,HLDP,0),U,5)=HLNXST L -^HLCS(870,HLDP,0) Q
S $P(^HLCS(870,HLDP,0),U,5)=HLNXST
L -^HLCS(870,HLDP,0)
D STOP
Q
STOP ;Check for Shutdown request
D NOW^%DTC
F L +^HLCS(870,HLDP,0):DTIME Q:$T H 1
I $P(^HLCS(870,HLDP,0),U,15)'=1 L -^HLCS(870,HLDP,0) Q
S STOP=1,HLNXST="SHUTDOWN"
S DIE="^HLCS(870,",DA=HLDP
S DR="4///^S X=HLNXST;10////^S X=%;9////@;11////@"
D ^DIE K DIE,DA,DR
L -^HLCS(870,HLDP,0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCSMM1 1773 printed Dec 13, 2024@01:56:44 Page 2
HLCSMM1 ;ISC-SF/JC - HL7 PROTOCOL FOR MAILMAN ;03/15/2011
+1 ;;1.6;HEALTH LEVEL SEVEN;**35,49,153**;Oct 13, 1995;Build 11
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
INIT ;
+1 NEW HLNOW,HLDOUT0,HLDOUT1
+2 if '$DATA(HLDP)
QUIT
+3 ;
+4 ;**P153 START CJM
+5 LOCK +^HLCS(870,HLDP,"OUT","MAILMAN CLIENT"):30
if '$TEST
QUIT
+6 ;**P153 END CJM
+7 ;
+8 DO NOW^%DTC
SET HLNOW=%
UPDT ;Update link info
+1 FOR
LOCK +^HLCS(870,HLDP,0):DTIME
if $TEST
QUIT
HANG 1
+2 SET ZTSK=$GET(ZTSK)
+3 IF ZTSK=""
SET HLTRACE=""
+4 SET DIE="^HLCS(870,"
SET DA=HLDP
+5 SET DR="9////^S X=HLNOW;10////@;14////0;3////MM;18////@"
+6 IF ZTSK
SET DR=DR_";11////^S X=ZTSK"
+7 DO ^DIE
KILL DIE,DA,DR
+8 LOCK -^HLCS(870,HLDP,0)
LOOP ;Begin send loop
+1 SET STOP=0
+2 FOR
HANG 1
DO START
if STOP
QUIT
+3 ;
+4 ;**P153 START CJM
+5 DO STATUS("SHUTDOWN")
+6 LOCK -^HLCS(870,HLDP,"OUT","MAILMAN CLIENT")
+7 ;**P153 END CJM
+8 QUIT
START ;
+1 SET HLNXST="IDLE"
+2 DO TRACE^HLCSDR2
DO STATUS(HLNXST)
+3 SET HLDOUT0=$$DEQUEUE^HLCSQUE(HLDP,"OUT")
+4 SET HLDOUT1=$PIECE(HLDOUT0,U,2)
SET HLDOUT0=+HLDOUT0
+5 IF HLDOUT0'<0
Begin DoDot:1
+6 SET HLNXST="WRITING"
DO TRACE^HLCSDR2
DO STATUS(HLNXST)
+7 DO EN^HLCSMM(HLDOUT0,HLDOUT1)
End DoDot:1
+8 IF $DATA(HLTRACE)
USE IO(0)
WRITE !,"Type 'Q' to quit: "
READ X:1
IF $GET(X)'=""&("Qq"[X)
Begin DoDot:1
+9 FOR
LOCK +^HLCS(870,HLDP,0):DTIME
if $TEST
QUIT
HANG 1
+10 SET $PIECE(^HLCS(870,HLDP,0),U,15)=1
+11 LOCK -^HLCS(870,HLDP,0)
End DoDot:1
+12 DO STOP
+13 QUIT
STATUS(HLNXST) ;Status update
+1 FOR
LOCK +^HLCS(870,HLDP,0):DTIME
if $TEST
QUIT
HANG 1
+2 IF $GET(HLNXST)]""
IF $PIECE(^HLCS(870,HLDP,0),U,5)=HLNXST
LOCK -^HLCS(870,HLDP,0)
QUIT
+3 SET $PIECE(^HLCS(870,HLDP,0),U,5)=HLNXST
+4 LOCK -^HLCS(870,HLDP,0)
+5 DO STOP
+6 QUIT
STOP ;Check for Shutdown request
+1 DO NOW^%DTC
+2 FOR
LOCK +^HLCS(870,HLDP,0):DTIME
if $TEST
QUIT
HANG 1
+3 IF $PIECE(^HLCS(870,HLDP,0),U,15)'=1
LOCK -^HLCS(870,HLDP,0)
QUIT
+4 SET STOP=1
SET HLNXST="SHUTDOWN"
+5 SET DIE="^HLCS(870,"
SET DA=HLDP
+6 SET DR="4///^S X=HLNXST;10////^S X=%;9////@;11////@"
+7 DO ^DIE
KILL DIE,DA,DR
+8 LOCK -^HLCS(870,HLDP,0)
+9 QUIT
