source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSOUT.m@ 1766

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

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1HLCSOUT ;ALB/JRP - OUTGOING FILER;2/25/97 ;11/15/2000 09:38
2 ;;1.6;HEALTH LEVEL SEVEN;**25,30,62**;Oct 13, 1995
3STARTOUT ;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
Note: See TracBrowser for help on using the repository browser.