Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLCSIN

HLCSIN.m

Go to the documentation of this file. 
  1. HLCSIN ;ALB/JRP - INCOMING FILER;01-MAY-95 ;11/15/2000  09:37
  1.  ;;1.6;HEALTH LEVEL SEVEN;**2,30,14,19,62,109,115**;Oct 13, 1995
  1. STARTIN ;Main entry point for incoming background filer
  1.  ;Create/find entry denoting this filer in the INCOMING FILER TASK
  1.  ; NUMBER multiple (field #20) of the HL COMMUNICATION SERVER PARAMETER
  1.  ; file (#869.3)
  1.  ;N HLOGLINK,HLNODE,HLPARENT,HLST1,TMP ; These vbls aren't used!
  1.  N HLFLG,HLEXIT,HLPTRFLR
  1.  S HLPTRFLR=+$$CRTFLR^HLCSUTL1(ZTSK,"IN")
  1.  ;Loop through Logical Links and check for incoming messages
  1.  S HLEXIT=0
  1.  F  D  Q:HLEXIT
  1.  . S HLFLG=0
  1.  . D DEFACK(.HLPTRFLR,.HLFLG,.HLEXIT) Q:HLEXIT
  1.  . D ACKNOW(.HLPTRFLR,.HLFLG,.HLEXIT) Q:HLEXIT
  1.  . Q:HLFLG
  1.  . I $$HDIFF^XLFDT($H,$G(HLPTRFLR("LASTDEL")),2)>3600 D  Q
  1.  . . S HLPTRFLR("LASTDEL")=$H    ; maintain queue sizes
  1.  . . D DELQUE(.HLPTRFLR,.HLEXIT) ; no more than once an hour.
  1.  . H 5
  1.  . D CHKUPD(.HLPTRFLR,.HLEXIT) Q:HLEXIT
  1.  S ZTSTOP=1 ;Asked to stop
  1.  D DELFLR^HLCSUTL1(HLPTRFLR,"IN") ;Delete entry denoting this filer
  1.  S ZTREQ="@"
  1.  Q
  1. DEFACK(HLPTRFLR,HLFLG,HLEXIT) ; Process TCP links with a deferred response
  1.  N HLXX,HLD0,HLPCT
  1.  S HLXX=0
  1.  F  S HLXX=$O(^HLMA("AC","I",HLXX)) Q:'HLXX  D  Q:HLEXIT
  1.  . D CHKUPD(.HLPTRFLR,.HLEXIT) Q:HLEXIT
  1.  . ; HL*1.6*109
  1.  . L +^HLMA("AC","I",HLXX):0 Q:'$T  ;*109*Does another filer have this?
  1.  . S HLD0=0,HLFLG=1
  1.  . ; HL*1.6*109 changes in for loop below, and post-quit code placed
  1.  . ; on following lines.
  1.  . S HLPCT=0 ; Counter whether filer should stop every 100th entry.
  1.  .;**109 - insure queue last processed at least 2 seconds ago
  1.  . I ($$HDIFF^XLFDT($H,$G(^XTMP("HL7-AC","I",HLXX)),2)<2) L -^HLMA("AC","I",HLXX) Q
  1.  . F  S HLD0=$O(^HLMA("AC","I",HLXX,HLD0)) Q:'HLD0!(HLEXIT)  D
  1.  . . S HLPCT=HLPCT+1
  1.  . . I '(HLPCT#100) D CHKUPD(.HLPTRFLR,.HLEXIT) Q:HLEXIT
  1.  . . L +^HLMA(HLD0):0 Q:'$T
  1.  . . I '$$CHECKAC("I",HLXX,HLD0) L -^HLMA(HLD0) Q  ;-> Quit if not a valid AC xref
  1.  . . D DEFACK^HLTP3(HLXX,HLD0)
  1.  . . D DEQUE^HLCSREP(HLXX,"I",HLD0)
  1.  . . L -^HLMA(HLD0)
  1.  . ;**109 -add dt/tm stamp to time queue last processed
  1.  . S ^XTMP("HL7-AC","I",HLXX)=$H
  1.  . ;**109 -unlock the queue
  1.  . L -^HLMA("AC","I",HLXX)
  1.  Q
  1.  ;
  1. CHECKAC(WAY,IEN870,IEN773) ; If AC xref shouldn't exist, kill it...
  1.  ;
  1.  ; Check status and if 3 (processed) kill XREF...
  1.  I $P($G(^HLMA(+IEN773,"P")),U)=3 D  QUIT "" ;->
  1.  .  D DEQUE^HLCSREP(IEN870,WAY,IEN773)
  1.  ;
  1.  ; Add other checks here in the future...
  1.  ;
  1.  Q 1
  1.  ;
  1. ACKNOW(HLPTRFLR,HLFLG,HLEXIT) ; Process Logical Link's IN-queue for received message
  1.  N HLXX,HLD0,HLD1
  1.  S HLXX=0
  1.  F  S HLXX=$O(^HLCS(870,"AISTAT","P",HLXX)) Q:'HLXX  D  Q:HLEXIT
  1.  . D CHKUPD(.HLPTRFLR,.HLEXIT) Q:HLEXIT
  1.  .; HL*1.6*109
  1.  . L +^HLCS(870,HLXX,"INFILER"):0 Q:'$T  ;Does another filer have this?
  1.  . F  D CHKUPD(.HLPTRFLR,.HLEXIT) Q:HLEXIT  S HLD0=$$DEQUEUE^HLCSQUE(HLXX,"IN") Q:+HLD0<0  D
  1.  . . ;Make sure message is ready to be received
  1.  . . S HLFLG=1
  1.  . . S HLD1=$P(HLD0,"^",2)
  1.  . . S HLD0=+HLD0 ; At this point, HLD0=HLXX
  1.  . . I $P($G(^HLCS(870,HLD0,1,HLD1,0)),"^",3)'="A" D  Q
  1.  . . . D MONITOR^HLCSDR2("D",2,HLD0,HLD1,"IN") ;Set status to DONE
  1.  . . D RECEIVE^HLMA0(HLD0,HLD1) ;Process received message
  1.  . . D MONITOR^HLCSDR2("D",2,HLD0,HLD1,"IN") ;Set status to DONE
  1.  . I HLD0<0,$D(^HLCS(870,"AISTAT","P",HLXX)) D
  1.  . . S HLD1=0 ; Make sure there aren't any loose xrefs hanging around.
  1.  . . F  S HLD1=$O(^HLCS(870,"AISTAT","P",HLXX,HLD1)) Q:'HLD1  D
  1.  . . . ;I '$D(^HLCS(870,HLXX,1,HLD1,0)) K ^HLCS(870,"AISTAT","P",HLXX,HLD1)
  1.  . . . I $P($G(^HLCS(870,HLXX,1,HLD1,0)),U,2)'="P" K ^HLCS(870,"AISTAT","P",HLXX,HLD1)
  1.  . L -^HLCS(870,HLXX,"INFILER")
  1.  Q
  1. DELQUE(HLPTRFLR,HLEXIT) ; Delete messages outside the 'queue size' window.
  1.  N HLDIR,HLXX,HLFRONT
  1.  S HLDIR=1,HLXX=0
  1.  F  S HLXX=$O(^HLCS(870,HLXX)) Q:'HLXX  D  Q:HLEXIT
  1.  . D CHKUPD(.HLPTRFLR,.HLEXIT) Q:HLEXIT
  1.  . L +^HLCS(870,HLXX,"IN QUEUE FRONT POINTER"):0 Q:'$T
  1.  . S HLFRONT=$G(^HLCS(870,HLXX,"IN QUEUE FRONT POINTER"))
  1.  . L -^HLCS(870,HLXX,"IN QUEUE FRONT POINTER")
  1.  . D DELETE^HLCSQUE1(HLXX,HLDIR,HLFRONT)
  1.  Q
  1. CHKUPD(HLPTRFLR,HLEXIT) ;
  1.  Q:$$HDIFF^XLFDT($H,$G(HLPTRFLR("LASTUP")),2)<15
  1.  D SETFLRDH^HLCSUTL1(HLPTRFLR,"IN") ; Update LAST KNOWN $H (field #.03) for filer
  1.  S HLPTRFLR("LASTUP")=$H
  1.  D CHK4STOP^HLCSUTL2(HLPTRFLR,"IN",.HLEXIT) Q:HLEXIT
  1.  Q