Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSIN.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSIN.m
r613 r623 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 1 HLCSIN ;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 3 STARTIN ;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 26 DEFACK(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 ; 53 CHECKAC(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 ; 63 ACKNOW(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 86 DELQUE(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 96 CHKUPD(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 TracChangeset
for help on using the changeset viewer.
