Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLCSMM1

HLCSMM1.m

Go to the documentation of this file.
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