| 1 | HLCSIN ;ALB/JRP - INCOMING FILER;01-MAY-95 ;03/17/2008 17:15
|
|---|
| 2 | ;;1.6;HEALTH LEVEL SEVEN;**2,30,14,19,62,109,115,122,140**;Oct 13, 1995;Build 5
|
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | STARTIN ;Main entry point for incoming background filer
|
|---|
| 5 | ;Create/find entry denoting this filer in the INCOMING FILER TASK
|
|---|
| 6 | ; NUMBER multiple (field #20) of the HL COMMUNICATION SERVER PARAMETER
|
|---|
| 7 | ; file (#869.3)
|
|---|
| 8 | N HLFLG,HLEXIT,HLPTRFLR
|
|---|
| 9 | ;
|
|---|
| 10 | ; patch HL*1.6*122
|
|---|
| 11 | ;; N HLDUZ,DUZ ; patch HL*1.6*122 TEST v2: DUZ code removed
|
|---|
| 12 | N HLDUZ
|
|---|
| 13 | S HLDUZ=+$G(DUZ)
|
|---|
| 14 | ;
|
|---|
| 15 | S HLPTRFLR=+$$CRTFLR^HLCSUTL1(ZTSK,"IN")
|
|---|
| 16 | ;Loop through Logical Links and check for incoming messages
|
|---|
| 17 | S HLEXIT=0
|
|---|
| 18 | ; patch HL*1.6*122 TEST v2: DUZ code removed
|
|---|
| 19 | ; patch HL*1.6*122, set DUZ for application proxy user
|
|---|
| 20 | ;; D PROXY^HLCSTCP4
|
|---|
| 21 | S HLPTRFLR("$J")=$J
|
|---|
| 22 | F D Q:HLEXIT
|
|---|
| 23 | . S HLFLG=0
|
|---|
| 24 | . D DEFACK(.HLPTRFLR,.HLFLG,.HLEXIT) Q:HLEXIT
|
|---|
| 25 | . D ACKNOW(.HLPTRFLR,.HLFLG,.HLEXIT) Q:HLEXIT
|
|---|
| 26 | . Q:HLFLG
|
|---|
| 27 | . I $$HDIFF^XLFDT($H,$G(HLPTRFLR("LASTDEL")),2)>3600 D Q
|
|---|
| 28 | . . S HLPTRFLR("LASTDEL")=$H ; maintain queue sizes
|
|---|
| 29 | . . D DELQUE(.HLPTRFLR,.HLEXIT) ; no more than once an hour.
|
|---|
| 30 | . ; patch HL*1.6*122
|
|---|
| 31 | . ; H 5
|
|---|
| 32 | . H 1
|
|---|
| 33 | . D CHKUPD(.HLPTRFLR,.HLEXIT) Q:HLEXIT
|
|---|
| 34 | S ZTSTOP=1 ;Asked to stop
|
|---|
| 35 | D DELFLR^HLCSUTL1(HLPTRFLR,"IN") ;Delete entry denoting this filer
|
|---|
| 36 | S ZTREQ="@"
|
|---|
| 37 | Q
|
|---|
| 38 | DEFACK(HLPTRFLR,HLFLG,HLEXIT) ; Process TCP links with a deferred response
|
|---|
| 39 | N HLXX,HLD0,HLPCT
|
|---|
| 40 | S HLXX=0
|
|---|
| 41 | F S HLXX=$O(^HLMA("AC","I",HLXX)) Q:'HLXX D Q:HLEXIT
|
|---|
| 42 | . ; HL*1.6*122, check the in-queue stop flag
|
|---|
| 43 | . Q:$P($G(^HLCS(870,HLXX,0)),"^",9)
|
|---|
| 44 | . D CHKUPD(.HLPTRFLR,.HLEXIT) Q:HLEXIT
|
|---|
| 45 | . ; patch HL*1.6*109: Does another filer have this?
|
|---|
| 46 | . ; L +^HLMA("AC","I",HLXX):0 Q:'$T
|
|---|
| 47 | . ; patch HL*1.6*140 - change the lock node, it conflicts with
|
|---|
| 48 | . ; lock defined in routine, HLCSREP.
|
|---|
| 49 | . ; L +^HLMA("AC","I",HLXX):2 Q:'$T ; patch HL*1.6*122
|
|---|
| 50 | . L +^HLMA("IN-FILER","AC","I",HLXX):2 Q:'$T ; patch HL*1.6*122
|
|---|
| 51 | . S HLD0=0,HLFLG=1
|
|---|
| 52 | . ; HL*1.6*109 changes in for loop below, and post-quit code placed
|
|---|
| 53 | . ; on following lines.
|
|---|
| 54 | . S HLPCT=0 ; Counter whether filer should stop every 100th entry.
|
|---|
| 55 | .;**109 - insure queue last processed at least 2 seconds ago
|
|---|
| 56 | . ; patch HL*1.6*140
|
|---|
| 57 | . ; I ($$HDIFF^XLFDT($H,$G(^XTMP("HL7-AC","I",HLXX)),2)<2) L -^HLMA("AC","I",HLXX) Q
|
|---|
| 58 | . I ($$HDIFF^XLFDT($H,$G(^XTMP("HL7-AC","I",HLXX)),2)<2) L -^HLMA("IN-FILER","AC","I",HLXX) Q
|
|---|
| 59 | . F S HLD0=$O(^HLMA("AC","I",HLXX,HLD0)) Q:'HLD0!(HLEXIT) D
|
|---|
| 60 | .. ; patch HL*1.6*122 start
|
|---|
| 61 | .. ; patch HL*1.6*122 TEST v2: DUZ code removed
|
|---|
| 62 | .. ; DUZ comparison/reset for application proxy user
|
|---|
| 63 | .. ;; D HLDUZ^HLCSTCP4
|
|---|
| 64 | .. D HLDUZ2^HLCSTCP4
|
|---|
| 65 | .. ; protect HLDUZ
|
|---|
| 66 | .. N HLDUZ
|
|---|
| 67 | .. S HLPCT=HLPCT+1
|
|---|
| 68 | .. I '(HLPCT#100) D CHKUPD(.HLPTRFLR,.HLEXIT) Q:HLEXIT
|
|---|
| 69 | .. ; L +^HLMA(HLD0):0 Q:'$T
|
|---|
| 70 | .. F L +^HLMA(HLD0):30 Q:$T H 1
|
|---|
| 71 | .. I '$$CHECKAC("I",HLXX,HLD0) L -^HLMA(HLD0) Q ;-> Quit if not a valid AC xref
|
|---|
| 72 | .. D DEFACK^HLTP3(HLXX,HLD0)
|
|---|
| 73 | .. D DEQUE^HLCSREP(HLXX,"I",HLD0)
|
|---|
| 74 | .. L -^HLMA(HLD0)
|
|---|
| 75 | . ; patch HL*1.6*122 end
|
|---|
| 76 | . ;**109 -add dt/tm stamp to time queue last processed
|
|---|
| 77 | . S ^XTMP("HL7-AC","I",HLXX)=$H
|
|---|
| 78 | . ;**109 -unlock the queue
|
|---|
| 79 | . ; patch HL*1.6*140
|
|---|
| 80 | . ; L -^HLMA("AC","I",HLXX)
|
|---|
| 81 | . L -^HLMA("IN-FILER","AC","I",HLXX)
|
|---|
| 82 | Q
|
|---|
| 83 | ;
|
|---|
| 84 | CHECKAC(WAY,IEN870,IEN773) ; If AC xref shouldn't exist, kill it...
|
|---|
| 85 | ;
|
|---|
| 86 | ; Check status and if 3 (processed) kill XREF...
|
|---|
| 87 | I $P($G(^HLMA(+IEN773,"P")),U)=3 D QUIT "" ;->
|
|---|
| 88 | . D DEQUE^HLCSREP(IEN870,WAY,IEN773)
|
|---|
| 89 | ;
|
|---|
| 90 | ; Add other checks here in the future...
|
|---|
| 91 | ;
|
|---|
| 92 | Q 1
|
|---|
| 93 | ;
|
|---|
| 94 | ACKNOW(HLPTRFLR,HLFLG,HLEXIT) ; Process Logical Link's IN-queue for received message
|
|---|
| 95 | N HLXX,HLD0,HLD1
|
|---|
| 96 | S HLXX=0
|
|---|
| 97 | F S HLXX=$O(^HLCS(870,"AISTAT","P",HLXX)) Q:'HLXX D Q:HLEXIT
|
|---|
| 98 | . ; HL*1.6*122, check the in-queue stop flag
|
|---|
| 99 | . Q:$P($G(^HLCS(870,HLXX,0)),"^",9)
|
|---|
| 100 | . D CHKUPD(.HLPTRFLR,.HLEXIT) Q:HLEXIT
|
|---|
| 101 | . ; HL*1.6*109: Does another filer have this?
|
|---|
| 102 | . ; L +^HLCS(870,HLXX,"INFILER"):0 Q:'$T
|
|---|
| 103 | . L +^HLCS(870,HLXX,"INFILER"):2 Q:'$T ; patch HL*1.6*122
|
|---|
| 104 | . F D CHKUPD(.HLPTRFLR,.HLEXIT) Q:HLEXIT S HLD0=$$DEQUEUE^HLCSQUE(HLXX,"IN") Q:+HLD0<0 D
|
|---|
| 105 | .. ;
|
|---|
| 106 | .. ; patch HL*1.6*122 start
|
|---|
| 107 | .. ; clean variables except Kernel related variables
|
|---|
| 108 | .. D
|
|---|
| 109 | ... ; protect variables defined in STARTIN^HLCSIN
|
|---|
| 110 | ... N HLFLG,HLEXIT,HLPTRFLR
|
|---|
| 111 | ... N HLDUZ
|
|---|
| 112 | ... ; protect variables defined in ACKNOW^HLCSIN
|
|---|
| 113 | ... N HLXX,HLD0,HLD1
|
|---|
| 114 | ... D KILL^XUSCLEAN
|
|---|
| 115 | .. ;
|
|---|
| 116 | .. ; patch HL*1.6*122 TEST v2: DUZ code removed
|
|---|
| 117 | .. ; DUZ comparison/reset for application proxy user
|
|---|
| 118 | .. ;; D HLDUZ^HLCSTCP4
|
|---|
| 119 | .. D HLDUZ2^HLCSTCP4
|
|---|
| 120 | .. ; protect HLDUZ
|
|---|
| 121 | .. N HLDUZ
|
|---|
| 122 | .. ;Make sure message is ready to be received
|
|---|
| 123 | .. S HLFLG=1
|
|---|
| 124 | .. S HLD1=$P(HLD0,"^",2)
|
|---|
| 125 | .. S HLD0=+HLD0 ; At this point, HLD0=HLXX
|
|---|
| 126 | .. I $P($G(^HLCS(870,HLD0,1,HLD1,0)),"^",3)'="A" D Q
|
|---|
| 127 | ... D MONITOR^HLCSDR2("D",2,HLD0,HLD1,"IN") ;Set status to DONE
|
|---|
| 128 | .. D RECEIVE^HLMA0(HLD0,HLD1) ;Process received message
|
|---|
| 129 | .. D MONITOR^HLCSDR2("D",2,HLD0,HLD1,"IN") ;Set status to DONE
|
|---|
| 130 | . ; patch HL*1.6*122 end
|
|---|
| 131 | . I HLD0<0,$D(^HLCS(870,"AISTAT","P",HLXX)) D
|
|---|
| 132 | . . S HLD1=0 ; Make sure there aren't any loose xrefs hanging around.
|
|---|
| 133 | . . F S HLD1=$O(^HLCS(870,"AISTAT","P",HLXX,HLD1)) Q:'HLD1 D
|
|---|
| 134 | . . . ;I '$D(^HLCS(870,HLXX,1,HLD1,0)) K ^HLCS(870,"AISTAT","P",HLXX,HLD1)
|
|---|
| 135 | . . . I $P($G(^HLCS(870,HLXX,1,HLD1,0)),U,2)'="P" K ^HLCS(870,"AISTAT","P",HLXX,HLD1)
|
|---|
| 136 | . L -^HLCS(870,HLXX,"INFILER")
|
|---|
| 137 | Q
|
|---|
| 138 | DELQUE(HLPTRFLR,HLEXIT) ; Delete messages outside the 'queue size' window.
|
|---|
| 139 | N HLDIR,HLXX,HLFRONT
|
|---|
| 140 | S HLDIR=1,HLXX=0
|
|---|
| 141 | F S HLXX=$O(^HLCS(870,HLXX)) Q:'HLXX D Q:HLEXIT
|
|---|
| 142 | . D CHKUPD(.HLPTRFLR,.HLEXIT) Q:HLEXIT
|
|---|
| 143 | . ; patch HL*1.6*122, comment out, no need to lock
|
|---|
| 144 | . ; L +^HLCS(870,HLXX,"IN QUEUE FRONT POINTER"):0 Q:'$T
|
|---|
| 145 | . S HLFRONT=$G(^HLCS(870,HLXX,"IN QUEUE FRONT POINTER"))
|
|---|
| 146 | . ; patch HL*1.6*122, comment out
|
|---|
| 147 | . ; L -^HLCS(870,HLXX,"IN QUEUE FRONT POINTER")
|
|---|
| 148 | . D DELETE^HLCSQUE1(HLXX,HLDIR,HLFRONT)
|
|---|
| 149 | Q
|
|---|
| 150 | CHKUPD(HLPTRFLR,HLEXIT) ;
|
|---|
| 151 | Q:$$HDIFF^XLFDT($H,$G(HLPTRFLR("LASTUP")),2)<15
|
|---|
| 152 | D SETFLRDH^HLCSUTL1(HLPTRFLR,"IN") ; Update LAST KNOWN $H (field #.03) for filer
|
|---|
| 153 | S HLPTRFLR("LASTUP")=$H
|
|---|
| 154 | D CHK4STOP^HLCSUTL2(HLPTRFLR,"IN",.HLEXIT) Q:HLEXIT
|
|---|
| 155 | Q
|
|---|
