50 lines
1.4 KiB
Mathematica
50 lines
1.4 KiB
Mathematica
HLCSMM1 ;ISC-SF/JC - HL7 PROTOCOL FOR MAILMAN ;07/07/99 17:43
|
|
;;1.6;HEALTH LEVEL SEVEN;**35,49**;Oct 13, 1995
|
|
INIT ;
|
|
N HLNOW,HLDOUT0,HLDOUT1
|
|
Q:'$D(HLDP)
|
|
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
|
|
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
|