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