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

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