source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSMM1.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1HLCSMM1 ;ISC-SF/JC - HL7 PROTOCOL FOR MAILMAN ;07/07/99 17:43
2 ;;1.6;HEALTH LEVEL SEVEN;**35,49**;Oct 13, 1995
3INIT ;
4 N HLNOW,HLDOUT0,HLDOUT1
5 Q:'$D(HLDP)
6 D NOW^%DTC S HLNOW=%
7UPDT ;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)
16LOOP ;Begin send loop
17 S STOP=0
18 F H 1 D START Q:STOP
19START ;
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
33STATUS(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
40STOP ;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
Note: See TracBrowser for help on using the repository browser.