| [613] | 1 | HLCSOUT ;ALB/JRP - OUTGOING FILER;2/25/97 ;11/15/2000 09:38
|
|---|
| 2 | ;;1.6;HEALTH LEVEL SEVEN;**25,30,62**;Oct 13, 1995
|
|---|
| 3 | STARTOUT ;Main entry point for outgoing background filer
|
|---|
| 4 | ;Create/find entry denoting this filer in the OUTGOING FILER TASK
|
|---|
| 5 | ; NUMBER multiple (field #30) of the HL COMMUNICATION SERVER PARAMETER
|
|---|
| 6 | ; file (#869.3)
|
|---|
| 7 | ;N TMP ; These vbls are not used!
|
|---|
| 8 | N HLPTRFLR,HLPTRLL,HLCSLOOP,HLEXIT,HLXX,HLNODE,HLOGLINK,HLPARENT
|
|---|
| 9 | N HLHDRBLD,HLERROR,HLHDR,HLD0,HLD1,HLST1
|
|---|
| 10 | S HLPTRFLR=+$$CRTFLR^HLCSUTL1(ZTSK,"OUT")
|
|---|
| 11 | ;Check if any outgoing messages are in the pending transmission queue
|
|---|
| 12 | S (HLPTRLL,HLCSLOOP,HLEXIT)=0
|
|---|
| 13 | F S HLPTRLL=+$O(^HL(772,"A-XMIT-OUT",HLPTRLL)) D Q:HLEXIT
|
|---|
| 14 | . D CHK4STOP^HLCSUTL2(HLPTRFLR,"OUT",.HLEXIT) Q:HLEXIT
|
|---|
| 15 | . ;Update LAST KNOWN $H (field #.03) for filer every 200th iteration
|
|---|
| 16 | . D:'(HLCSLOOP#200) SETFLRDH^HLCSUTL1(HLPTRFLR,"OUT")
|
|---|
| 17 | . ;Increment loop counter (reset to 0 when greater than 1000)
|
|---|
| 18 | . S HLCSLOOP=HLCSLOOP+1 S:HLCSLOOP>1000 HLCSLOOP=0
|
|---|
| 19 | . I 'HLPTRLL H 1 Q
|
|---|
| 20 | . S HLXX=+$O(^HL(772,"A-XMIT-OUT",HLPTRLL,0)) ;Pending messages?
|
|---|
| 21 | . I 'HLXX H 1 Q ;No pending messages
|
|---|
| 22 | . L +^HL(772,HLXX,0):1 I ('$T) H 1 Q ;Lock main node of Message Text
|
|---|
| 23 | . ;Make sure status hasn't changed
|
|---|
| 24 | . I '$D(^HL(772,"AF",1,HLXX)) L -^HL(772,HLXX,0) Q
|
|---|
| 25 | . ;Get Logical Link and parent message
|
|---|
| 26 | . ; Set status to ERROR DURING TRANSMISSION if not present
|
|---|
| 27 | . S HLNODE=^HL(772,HLXX,0)
|
|---|
| 28 | . S HLOGLINK=$P(HLNODE,"^",11)
|
|---|
| 29 | . I HLOGLINK'>0 D Q
|
|---|
| 30 | . . D STATUS^HLTF0(HLXX,4,"","Logical Link not available")
|
|---|
| 31 | . . L -^HL(772,HLXX,0)
|
|---|
| 32 | . S HLPARENT=$P(HLNODE,"^",8)
|
|---|
| 33 | . I HLPARENT'>0!'$G(^HL(772,HLPARENT,0)) D Q
|
|---|
| 34 | . . D STATUS^HLTF0(HLXX,4,"","Parent Message not available")
|
|---|
| 35 | . . L -^HL(772,HLXX,0)
|
|---|
| 36 | . ;Build message header or batch header
|
|---|
| 37 | . S HLHDRBLD=$P(^HL(772,HLPARENT,0),U,14)
|
|---|
| 38 | . I "^B^M^F^"'[(U_HLHDRBLD_U) D Q
|
|---|
| 39 | . . D STATUS^HLTF0(HLXX,4,"","Message Type (field #772,14) Error")
|
|---|
| 40 | . . L -^HL(772,HLXX,0)
|
|---|
| 41 | . S HLERROR=""
|
|---|
| 42 | . I HLHDRBLD="M" D HEADER^HLCSHDR(HLXX,.HLERROR)
|
|---|
| 43 | . I HLHDRBLD'="M" D BHSHDR^HLCSHDR(HLXX) S:$E(HLHDR(1),1,2)="-1" HLERROR=$P(HLHDR(1),"^",2)
|
|---|
| 44 | . ;If error set status ERROR DURING TRANSMISSION
|
|---|
| 45 | . I $G(HLERROR)'="" D STATUS^HLTF0(HLXX,4) L -^HL(772,HLXX,0) Q
|
|---|
| 46 | . S HLD0=$$ENQUEUE^HLCSQUE(HLOGLINK,"OUT")
|
|---|
| 47 | . ;If error set status ERROR DURING TRANSMISSION
|
|---|
| 48 | . I +HLD0<0 D STATUS^HLTF0(HLXX,4) L -^HL(772,HLXX,0) Q
|
|---|
| 49 | . S HLD1=$P(HLD0,"^",2)
|
|---|
| 50 | . S HLD0=+HLD0
|
|---|
| 51 | . ;Move Message Header and Message Text to file 870
|
|---|
| 52 | . D MERGEOUT^HLTF2(HLPARENT,HLD0,HLD1,"HLHDR")
|
|---|
| 53 | . K HLHDR
|
|---|
| 54 | . D MONITOR^HLCSDR2("P",2,HLD0,HLD1,"OUT") ;Status in queue to "PENDING"
|
|---|
| 55 | . ;Determine status, default to "Awaiting Ack"
|
|---|
| 56 | . S HLST1=$$FNDSTAT^HLUTIL3(HLXX) S:'HLST1 HLST1=2
|
|---|
| 57 | . D STATUS^HLTF0(HLXX,HLST1) ;Update status
|
|---|
| 58 | . L -^HL(772,HLXX,0) ;Unlock main node of Message Text
|
|---|
| 59 | . ;Update LAST KNOWN $H (field #.03) for filer
|
|---|
| 60 | . D SETFLRDH^HLCSUTL1(HLPTRFLR,"OUT")
|
|---|
| 61 | S ZTSTOP=1 ;Asked to stop
|
|---|
| 62 | D DELFLR^HLCSUTL1(HLPTRFLR,"OUT") ;Delete entry denoting this filer
|
|---|
| 63 | S ZTREQ="@"
|
|---|
| 64 | Q
|
|---|
