source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSIN.m@ 1006

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

revised back to 6/30/08 version

File size: 4.1 KB
Line 
1HLCSIN ;ALB/JRP - INCOMING FILER;01-MAY-95 ;11/15/2000 09:37
2 ;;1.6;HEALTH LEVEL SEVEN;**2,30,14,19,62,109,115**;Oct 13, 1995
3STARTIN ;Main entry point for incoming background filer
4 ;Create/find entry denoting this filer in the INCOMING FILER TASK
5 ; NUMBER multiple (field #20) of the HL COMMUNICATION SERVER PARAMETER
6 ; file (#869.3)
7 ;N HLOGLINK,HLNODE,HLPARENT,HLST1,TMP ; These vbls aren't used!
8 N HLFLG,HLEXIT,HLPTRFLR
9 S HLPTRFLR=+$$CRTFLR^HLCSUTL1(ZTSK,"IN")
10 ;Loop through Logical Links and check for incoming messages
11 S HLEXIT=0
12 F D Q:HLEXIT
13 . S HLFLG=0
14 . D DEFACK(.HLPTRFLR,.HLFLG,.HLEXIT) Q:HLEXIT
15 . D ACKNOW(.HLPTRFLR,.HLFLG,.HLEXIT) Q:HLEXIT
16 . Q:HLFLG
17 . I $$HDIFF^XLFDT($H,$G(HLPTRFLR("LASTDEL")),2)>3600 D Q
18 . . S HLPTRFLR("LASTDEL")=$H ; maintain queue sizes
19 . . D DELQUE(.HLPTRFLR,.HLEXIT) ; no more than once an hour.
20 . H 5
21 . D CHKUPD(.HLPTRFLR,.HLEXIT) Q:HLEXIT
22 S ZTSTOP=1 ;Asked to stop
23 D DELFLR^HLCSUTL1(HLPTRFLR,"IN") ;Delete entry denoting this filer
24 S ZTREQ="@"
25 Q
26DEFACK(HLPTRFLR,HLFLG,HLEXIT) ; Process TCP links with a deferred response
27 N HLXX,HLD0,HLPCT
28 S HLXX=0
29 F S HLXX=$O(^HLMA("AC","I",HLXX)) Q:'HLXX D Q:HLEXIT
30 . D CHKUPD(.HLPTRFLR,.HLEXIT) Q:HLEXIT
31 . ; HL*1.6*109
32 . L +^HLMA("AC","I",HLXX):0 Q:'$T ;*109*Does another filer have this?
33 . S HLD0=0,HLFLG=1
34 . ; HL*1.6*109 changes in for loop below, and post-quit code placed
35 . ; on following lines.
36 . S HLPCT=0 ; Counter whether filer should stop every 100th entry.
37 .;**109 - insure queue last processed at least 2 seconds ago
38 . I ($$HDIFF^XLFDT($H,$G(^XTMP("HL7-AC","I",HLXX)),2)<2) L -^HLMA("AC","I",HLXX) Q
39 . F S HLD0=$O(^HLMA("AC","I",HLXX,HLD0)) Q:'HLD0!(HLEXIT) D
40 . . S HLPCT=HLPCT+1
41 . . I '(HLPCT#100) D CHKUPD(.HLPTRFLR,.HLEXIT) Q:HLEXIT
42 . . L +^HLMA(HLD0):0 Q:'$T
43 . . I '$$CHECKAC("I",HLXX,HLD0) L -^HLMA(HLD0) Q ;-> Quit if not a valid AC xref
44 . . D DEFACK^HLTP3(HLXX,HLD0)
45 . . D DEQUE^HLCSREP(HLXX,"I",HLD0)
46 . . L -^HLMA(HLD0)
47 . ;**109 -add dt/tm stamp to time queue last processed
48 . S ^XTMP("HL7-AC","I",HLXX)=$H
49 . ;**109 -unlock the queue
50 . L -^HLMA("AC","I",HLXX)
51 Q
52 ;
53CHECKAC(WAY,IEN870,IEN773) ; If AC xref shouldn't exist, kill it...
54 ;
55 ; Check status and if 3 (processed) kill XREF...
56 I $P($G(^HLMA(+IEN773,"P")),U)=3 D QUIT "" ;->
57 . D DEQUE^HLCSREP(IEN870,WAY,IEN773)
58 ;
59 ; Add other checks here in the future...
60 ;
61 Q 1
62 ;
63ACKNOW(HLPTRFLR,HLFLG,HLEXIT) ; Process Logical Link's IN-queue for received message
64 N HLXX,HLD0,HLD1
65 S HLXX=0
66 F S HLXX=$O(^HLCS(870,"AISTAT","P",HLXX)) Q:'HLXX D Q:HLEXIT
67 . D CHKUPD(.HLPTRFLR,.HLEXIT) Q:HLEXIT
68 .; HL*1.6*109
69 . L +^HLCS(870,HLXX,"INFILER"):0 Q:'$T ;Does another filer have this?
70 . F D CHKUPD(.HLPTRFLR,.HLEXIT) Q:HLEXIT S HLD0=$$DEQUEUE^HLCSQUE(HLXX,"IN") Q:+HLD0<0 D
71 . . ;Make sure message is ready to be received
72 . . S HLFLG=1
73 . . S HLD1=$P(HLD0,"^",2)
74 . . S HLD0=+HLD0 ; At this point, HLD0=HLXX
75 . . I $P($G(^HLCS(870,HLD0,1,HLD1,0)),"^",3)'="A" D Q
76 . . . D MONITOR^HLCSDR2("D",2,HLD0,HLD1,"IN") ;Set status to DONE
77 . . D RECEIVE^HLMA0(HLD0,HLD1) ;Process received message
78 . . D MONITOR^HLCSDR2("D",2,HLD0,HLD1,"IN") ;Set status to DONE
79 . I HLD0<0,$D(^HLCS(870,"AISTAT","P",HLXX)) D
80 . . S HLD1=0 ; Make sure there aren't any loose xrefs hanging around.
81 . . F S HLD1=$O(^HLCS(870,"AISTAT","P",HLXX,HLD1)) Q:'HLD1 D
82 . . . ;I '$D(^HLCS(870,HLXX,1,HLD1,0)) K ^HLCS(870,"AISTAT","P",HLXX,HLD1)
83 . . . I $P($G(^HLCS(870,HLXX,1,HLD1,0)),U,2)'="P" K ^HLCS(870,"AISTAT","P",HLXX,HLD1)
84 . L -^HLCS(870,HLXX,"INFILER")
85 Q
86DELQUE(HLPTRFLR,HLEXIT) ; Delete messages outside the 'queue size' window.
87 N HLDIR,HLXX,HLFRONT
88 S HLDIR=1,HLXX=0
89 F S HLXX=$O(^HLCS(870,HLXX)) Q:'HLXX D Q:HLEXIT
90 . D CHKUPD(.HLPTRFLR,.HLEXIT) Q:HLEXIT
91 . L +^HLCS(870,HLXX,"IN QUEUE FRONT POINTER"):0 Q:'$T
92 . S HLFRONT=$G(^HLCS(870,HLXX,"IN QUEUE FRONT POINTER"))
93 . L -^HLCS(870,HLXX,"IN QUEUE FRONT POINTER")
94 . D DELETE^HLCSQUE1(HLXX,HLDIR,HLFRONT)
95 Q
96CHKUPD(HLPTRFLR,HLEXIT) ;
97 Q:$$HDIFF^XLFDT($H,$G(HLPTRFLR("LASTUP")),2)<15
98 D SETFLRDH^HLCSUTL1(HLPTRFLR,"IN") ; Update LAST KNOWN $H (field #.03) for filer
99 S HLPTRFLR("LASTUP")=$H
100 D CHK4STOP^HLCSUTL2(HLPTRFLR,"IN",.HLEXIT) Q:HLEXIT
101 Q
Note: See TracBrowser for help on using the repository browser.