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

HLCSOUT.m

Go to the documentation of this file. 
  1. HLCSOUT ;ALB/JRP - OUTGOING FILER;2/25/97 ;11/15/2000  09:38 [ 04/02/2003   8:38 AM ]
  1.  ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003
  1.  ;;1.6;HEALTH LEVEL SEVEN;**25,30,62**;Oct 13, 1995
  1. STARTOUT ;Main entry point for outgoing background filer
  1.  ;Create/find entry denoting this filer in the OUTGOING FILER TASK
  1.  ; NUMBER multiple (field #30) of the HL COMMUNICATION SERVER PARAMETER
  1.  ; file (#869.3)
  1.  ;N TMP ; These vbls are not used!
  1.  N HLPTRFLR,HLPTRLL,HLCSLOOP,HLEXIT,HLXX,HLNODE,HLOGLINK,HLPARENT
  1.  N HLHDRBLD,HLERROR,HLHDR,HLD0,HLD1,HLST1
  1.  S HLPTRFLR=+$$CRTFLR^HLCSUTL1(ZTSK,"OUT")
  1.  ;Check if any outgoing messages are in the pending transmission queue
  1.  S (HLPTRLL,HLCSLOOP,HLEXIT)=0
  1.  F  S HLPTRLL=+$O(^HL(772,"A-XMIT-OUT",HLPTRLL)) D  Q:HLEXIT
  1.  . D CHK4STOP^HLCSUTL2(HLPTRFLR,"OUT",.HLEXIT) Q:HLEXIT
  1.  . ;Update LAST KNOWN $H (field #.03) for filer every 200th iteration
  1.  . D:'(HLCSLOOP#200) SETFLRDH^HLCSUTL1(HLPTRFLR,"OUT")
  1.  . ;Increment loop counter (reset to 0 when greater than 1000)
  1.  . S HLCSLOOP=HLCSLOOP+1 S:HLCSLOOP>1000 HLCSLOOP=0
  1.  . I 'HLPTRLL H 1 Q
  1.  . S HLXX=+$O(^HL(772,"A-XMIT-OUT",HLPTRLL,0)) ;Pending messages?
  1.  . I 'HLXX H 1 Q  ;No pending messages
  1.  . L +^HL(772,HLXX,0):1 I ('$T) H 1 Q  ;Lock main node of Message Text
  1.  . ;Make sure status hasn't changed
  1.  . I '$D(^HL(772,"AF",1,HLXX)) L -^HL(772,HLXX,0) Q
  1.  . ;Get Logical Link and parent message
  1.  . ; Set status to ERROR DURING TRANSMISSION if not present
  1.  . S HLNODE=^HL(772,HLXX,0)
  1.  . S HLOGLINK=$P(HLNODE,"^",11)
  1.  . I HLOGLINK'>0 D  Q
  1.  . . D STATUS^HLTF0(HLXX,4,"","Logical Link not available")
  1.  . . L -^HL(772,HLXX,0)
  1.  . S HLPARENT=$P(HLNODE,"^",8)
  1.  . I HLPARENT'>0!'$G(^HL(772,HLPARENT,0)) D  Q
  1.  . . D STATUS^HLTF0(HLXX,4,"","Parent Message not available")
  1.  . . L -^HL(772,HLXX,0)
  1.  . ;Build message header or batch header
  1.  . S HLHDRBLD=$P(^HL(772,HLPARENT,0),U,14)
  1.  . I "^B^M^F^"'[(U_HLHDRBLD_U) D  Q
  1.  . . D STATUS^HLTF0(HLXX,4,"","Message Type (field #772,14) Error")
  1.  . . L -^HL(772,HLXX,0)
  1.  . S HLERROR=""
  1.  . I HLHDRBLD="M" D HEADER^HLCSHDR(HLXX,.HLERROR)
  1.  . I HLHDRBLD'="M" D BHSHDR^HLCSHDR(HLXX) S:$E(HLHDR(1),1,2)="-1" HLERROR=$P(HLHDR(1),"^",2)
  1.  . ;If error set status ERROR DURING TRANSMISSION
  1.  . I $G(HLERROR)'="" D STATUS^HLTF0(HLXX,4) L -^HL(772,HLXX,0) Q
  1.  . S HLD0=$$ENQUEUE^HLCSQUE(HLOGLINK,"OUT")
  1.  . ;If error set status ERROR DURING TRANSMISSION
  1.  . I +HLD0<0 D STATUS^HLTF0(HLXX,4) L -^HL(772,HLXX,0) Q
  1.  . S HLD1=$P(HLD0,"^",2)
  1.  . S HLD0=+HLD0
  1.  . ;Move Message Header and Message Text to file 870
  1.  . D MERGEOUT^HLTF2(HLPARENT,HLD0,HLD1,"HLHDR")
  1.  . K HLHDR
  1.  . D MONITOR^HLCSDR2("P",2,HLD0,HLD1,"OUT") ;Status in queue to "PENDING"
  1.  . ;Determine status, default to "Awaiting Ack"
  1.  . S HLST1=$$FNDSTAT^HLUTIL3(HLXX) S:'HLST1 HLST1=2
  1.  . D STATUS^HLTF0(HLXX,HLST1) ;Update status
  1.  . L -^HL(772,HLXX,0) ;Unlock main node of Message Text
  1.  . ;Update LAST KNOWN $H (field #.03) for filer
  1.  . D SETFLRDH^HLCSUTL1(HLPTRFLR,"OUT")
  1.  S ZTSTOP=1 ;Asked to stop
  1.  D DELFLR^HLCSUTL1(HLPTRFLR,"OUT") ;Delete entry denoting this filer
  1.  S ZTREQ="@"
  1.  Q