1 | HLCSMM1 ;ISC-SF/JC - HL7 PROTOCOL FOR MAILMAN ;07/07/99 17:43
|
---|
2 | ;;1.6;HEALTH LEVEL SEVEN;**35,49**;Oct 13, 1995
|
---|
3 | INIT ;
|
---|
4 | N HLNOW,HLDOUT0,HLDOUT1
|
---|
5 | Q:'$D(HLDP)
|
---|
6 | D NOW^%DTC S HLNOW=%
|
---|
7 | UPDT ;Update link info
|
---|
8 | F L +^HLCS(870,HLDP,0):DTIME Q:$T H 1
|
---|
9 | S ZTSK=$G(ZTSK)
|
---|
10 | I ZTSK="" S HLTRACE=""
|
---|
11 | S DIE="^HLCS(870,",DA=HLDP
|
---|
12 | S DR="9////^S X=HLNOW;10////@;14////0;3////MM;18////@"
|
---|
13 | I ZTSK S DR=DR_";11////^S X=ZTSK"
|
---|
14 | D ^DIE K DIE,DA,DR
|
---|
15 | L -^HLCS(870,HLDP,0)
|
---|
16 | LOOP ;Begin send loop
|
---|
17 | S STOP=0
|
---|
18 | F H 1 D START Q:STOP
|
---|
19 | START ;
|
---|
20 | S HLNXST="IDLE"
|
---|
21 | D TRACE^HLCSDR2,STATUS(HLNXST)
|
---|
22 | S HLDOUT0=$$DEQUEUE^HLCSQUE(HLDP,"OUT")
|
---|
23 | S HLDOUT1=$P(HLDOUT0,U,2),HLDOUT0=+HLDOUT0
|
---|
24 | I HLDOUT0'<0 D
|
---|
25 | .S HLNXST="WRITING" D TRACE^HLCSDR2,STATUS(HLNXST)
|
---|
26 | .D EN^HLCSMM(HLDOUT0,HLDOUT1)
|
---|
27 | I $D(HLTRACE) U IO(0) W !,"Type 'Q' to quit: " R X:1 I $G(X)'=""&("Qq"[X) D
|
---|
28 | .F L +^HLCS(870,HLDP,0):DTIME Q:$T H 1
|
---|
29 | .S $P(^HLCS(870,HLDP,0),U,15)=1
|
---|
30 | .L -^HLCS(870,HLDP,0)
|
---|
31 | D STOP
|
---|
32 | Q
|
---|
33 | STATUS(HLNXST) ;Status update
|
---|
34 | F L +^HLCS(870,HLDP,0):DTIME Q:$T H 1
|
---|
35 | I $G(HLNXST)]"",$P(^HLCS(870,HLDP,0),U,5)=HLNXST L -^HLCS(870,HLDP,0) Q
|
---|
36 | S $P(^HLCS(870,HLDP,0),U,5)=HLNXST
|
---|
37 | L -^HLCS(870,HLDP,0)
|
---|
38 | D STOP
|
---|
39 | Q
|
---|
40 | STOP ;Check for Shutdown request
|
---|
41 | D NOW^%DTC
|
---|
42 | F L +^HLCS(870,HLDP,0):DTIME Q:$T H 1
|
---|
43 | I $P(^HLCS(870,HLDP,0),U,15)'=1 L -^HLCS(870,HLDP,0) Q
|
---|
44 | S STOP=1,HLNXST="SHUTDOWN"
|
---|
45 | S DIE="^HLCS(870,",DA=HLDP
|
---|
46 | S DR="4///^S X=HLNXST;10////^S X=%;9////@;11////@"
|
---|
47 | D ^DIE K DIE,DA,DR
|
---|
48 | L -^HLCS(870,HLDP,0)
|
---|
49 | Q
|
---|