HLCSOUT.m

HLCSOUT ;ALB/JRP - OUTGOING FILER;2/25/97 ;11/15/2000  09:38 [ 04/02/2003   8:38 AM ]

 ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003

 ;;1.6;HEALTH LEVEL SEVEN;**25,30,62**;Oct 13, 1995

STARTOUT ;Main entry point for outgoing background filer

 ;Create/find entry denoting this filer in the OUTGOING FILER TASK

 ; NUMBER multiple (field #30) of the HL COMMUNICATION SERVER PARAMETER

 ; file (#869.3)

 ;N TMP ; These vbls are not used!

 N HLPTRFLR,HLPTRLL,HLCSLOOP,HLEXIT,HLXX,HLNODE,HLOGLINK,HLPARENT

 N HLHDRBLD,HLERROR,HLHDR,HLD0,HLD1,HLST1

 S HLPTRFLR=+$$CRTFLR^HLCSUTL1(ZTSK,"OUT")

 ;Check if any outgoing messages are in the pending transmission queue

 S (HLPTRLL,HLCSLOOP,HLEXIT)=0

 F  S HLPTRLL=+$O(^HL(772,"A-XMIT-OUT",HLPTRLL)) D  Q:HLEXIT

 . D CHK4STOP^HLCSUTL2(HLPTRFLR,"OUT",.HLEXIT) Q:HLEXIT

 . ;Update LAST KNOWN $H (field #.03) for filer every 200th iteration

 . D:'(HLCSLOOP#200) SETFLRDH^HLCSUTL1(HLPTRFLR,"OUT")

 . ;Increment loop counter (reset to 0 when greater than 1000)

 . S HLCSLOOP=HLCSLOOP+1 S:HLCSLOOP>1000 HLCSLOOP=0

 . I 'HLPTRLL H 1 Q

 . S HLXX=+$O(^HL(772,"A-XMIT-OUT",HLPTRLL,0)) ;Pending messages?

 . I 'HLXX H 1 Q  ;No pending messages

 . L +^HL(772,HLXX,0):1 I ('$T) H 1 Q  ;Lock main node of Message Text

 . ;Make sure status hasn't changed

 . I '$D(^HL(772,"AF",1,HLXX)) L -^HL(772,HLXX,0) Q

 . ;Get Logical Link and parent message

 . ; Set status to ERROR DURING TRANSMISSION if not present

 . S HLNODE=^HL(772,HLXX,0)

 . S HLOGLINK=$P(HLNODE,"^",11)

 . I HLOGLINK'>0 D  Q

 . . D STATUS^HLTF0(HLXX,4,"","Logical Link not available")

 . . L -^HL(772,HLXX,0)

 . S HLPARENT=$P(HLNODE,"^",8)

 . I HLPARENT'>0!'$G(^HL(772,HLPARENT,0)) D  Q

 . . D STATUS^HLTF0(HLXX,4,"","Parent Message not available")

 . . L -^HL(772,HLXX,0)

 . ;Build message header or batch header

 . S HLHDRBLD=$P(^HL(772,HLPARENT,0),U,14)

 . I "^B^M^F^"'[(U_HLHDRBLD_U) D  Q

 . . D STATUS^HLTF0(HLXX,4,"","Message Type (field #772,14) Error")

 . . L -^HL(772,HLXX,0)

 . S HLERROR=""

 . I HLHDRBLD="M" D HEADER^HLCSHDR(HLXX,.HLERROR)

 . I HLHDRBLD'="M" D BHSHDR^HLCSHDR(HLXX) S:$E(HLHDR(1),1,2)="-1" HLERROR=$P(HLHDR(1),"^",2)

 . ;If error set status ERROR DURING TRANSMISSION

 . I $G(HLERROR)'="" D STATUS^HLTF0(HLXX,4) L -^HL(772,HLXX,0) Q

 . S HLD0=$$ENQUEUE^HLCSQUE(HLOGLINK,"OUT")

 . ;If error set status ERROR DURING TRANSMISSION

 . I +HLD0<0 D STATUS^HLTF0(HLXX,4) L -^HL(772,HLXX,0) Q

 . S HLD1=$P(HLD0,"^",2)

 . S HLD0=+HLD0

 . ;Move Message Header and Message Text to file 870

 . D MERGEOUT^HLTF2(HLPARENT,HLD0,HLD1,"HLHDR")

 . K HLHDR

 . D MONITOR^HLCSDR2("P",2,HLD0,HLD1,"OUT") ;Status in queue to "PENDING"

 . ;Determine status, default to "Awaiting Ack"

 . S HLST1=$$FNDSTAT^HLUTIL3(HLXX) S:'HLST1 HLST1=2

 . D STATUS^HLTF0(HLXX,HLST1) ;Update status

 . L -^HL(772,HLXX,0) ;Unlock main node of Message Text

 . ;Update LAST KNOWN $H (field #.03) for filer

 . D SETFLRDH^HLCSUTL1(HLPTRFLR,"OUT")

 S ZTSTOP=1 ;Asked to stop

 D DELFLR^HLCSUTL1(HLPTRFLR,"OUT") ;Delete entry denoting this filer

 S ZTREQ="@"

 Q

HLCSOUT   ;ALB/JRP - OUTGOING FILER;2/25/97 ;11/15/2000  09:38 [ 04/02/2003   8:38 AM ]

 +1       ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003

 +2       ;;1.6;HEALTH LEVEL SEVEN;**25,30,62**;Oct 13, 1995

STARTOUT  ;Main entry point for outgoing background filer

 +1       ;Create/find entry denoting this filer in the OUTGOING FILER TASK

 +2       ; NUMBER multiple (field #30) of the HL COMMUNICATION SERVER PARAMETER

 +3       ; file (#869.3)

 +4       ;N TMP ; These vbls are not used!

 +5        NEW HLPTRFLR,HLPTRLL,HLCSLOOP,HLEXIT,HLXX,HLNODE,HLOGLINK,HLPARENT

 +6        NEW HLHDRBLD,HLERROR,HLHDR,HLD0,HLD1,HLST1

 +7        SET HLPTRFLR=+$$CRTFLR^HLCSUTL1(ZTSK,"OUT")

 +8       ;Check if any outgoing messages are in the pending transmission queue

 +9        SET (HLPTRLL,HLCSLOOP,HLEXIT)=0

 +10       FOR 

               SET HLPTRLL=+$ORDER(^HL(772,"A-XMIT-OUT",HLPTRLL))

               Begin DoDot:1

 +11               DO CHK4STOP^HLCSUTL2(HLPTRFLR,"OUT",.HLEXIT)

                   IF HLEXIT

                       QUIT 

 +12      ;Update LAST KNOWN $H (field #.03) for filer every 200th iteration

 +13               IF '(HLCSLOOP#200)

                       DO SETFLRDH^HLCSUTL1(HLPTRFLR,"OUT")

 +14      ;Increment loop counter (reset to 0 when greater than 1000)

 +15               SET HLCSLOOP=HLCSLOOP+1

                   IF HLCSLOOP>1000

                       SET HLCSLOOP=0

 +16               IF 'HLPTRLL

                       HANG 1

                       QUIT 

 +17      ;Pending messages?

                   SET HLXX=+$ORDER(^HL(772,"A-XMIT-OUT",HLPTRLL,0))

 +18      ;No pending messages

                   IF 'HLXX

                       HANG 1

                       QUIT 

 +19      ;Lock main node of Message Text

                   LOCK +^HL(772,HLXX,0):1

                   IF ('$TEST)

                       HANG 1

                       QUIT 

 +20      ;Make sure status hasn't changed

 +21               IF '$DATA(^HL(772,"AF",1,HLXX))

                       LOCK -^HL(772,HLXX,0)

                       QUIT 

 +22      ;Get Logical Link and parent message

 +23      ; Set status to ERROR DURING TRANSMISSION if not present

 +24               SET HLNODE=^HL(772,HLXX,0)

 +25               SET HLOGLINK=$PIECE(HLNODE,"^",11)

 +26               IF HLOGLINK'>0

                       Begin DoDot:2

 +27                       DO STATUS^HLTF0(HLXX,4,"","Logical Link not available")

 +28                       LOCK -^HL(772,HLXX,0)

                       End DoDot:2

                       QUIT 

 +29               SET HLPARENT=$PIECE(HLNODE,"^",8)

 +30               IF HLPARENT'>0!'$GET(^HL(772,HLPARENT,0))

                       Begin DoDot:2

 +31                       DO STATUS^HLTF0(HLXX,4,"","Parent Message not available")

 +32                       LOCK -^HL(772,HLXX,0)

                       End DoDot:2

                       QUIT 

 +33      ;Build message header or batch header

 +34               SET HLHDRBLD=$PIECE(^HL(772,HLPARENT,0),U,14)

 +35               IF "^B^M^F^"'[(U_HLHDRBLD_U)

                       Begin DoDot:2

 +36                       DO STATUS^HLTF0(HLXX,4,"","Message Type (field #772,14) Error")

 +37                       LOCK -^HL(772,HLXX,0)

                       End DoDot:2

                       QUIT 

 +38               SET HLERROR=""

 +39               IF HLHDRBLD="M"

                       DO HEADER^HLCSHDR(HLXX,.HLERROR)

 +40               IF HLHDRBLD'="M"

                       DO BHSHDR^HLCSHDR(HLXX)

                       IF $EXTRACT(HLHDR(1),1,2)="-1"

                           SET HLERROR=$PIECE(HLHDR(1),"^",2)

 +41      ;If error set status ERROR DURING TRANSMISSION

 +42               IF $GET(HLERROR)'=""

                       DO STATUS^HLTF0(HLXX,4)

                       LOCK -^HL(772,HLXX,0)

                       QUIT 

 +43               SET HLD0=$$ENQUEUE^HLCSQUE(HLOGLINK,"OUT")

 +44      ;If error set status ERROR DURING TRANSMISSION

 +45               IF +HLD0<0

                       DO STATUS^HLTF0(HLXX,4)

                       LOCK -^HL(772,HLXX,0)

                       QUIT 

 +46               SET HLD1=$PIECE(HLD0,"^",2)

 +47               SET HLD0=+HLD0

 +48      ;Move Message Header and Message Text to file 870

 +49               DO MERGEOUT^HLTF2(HLPARENT,HLD0,HLD1,"HLHDR")

 +50               KILL HLHDR

 +51      ;Status in queue to "PENDING"

                   DO MONITOR^HLCSDR2("P",2,HLD0,HLD1,"OUT")

 +52      ;Determine status, default to "Awaiting Ack"

 +53               SET HLST1=$$FNDSTAT^HLUTIL3(HLXX)

                   IF 'HLST1

                       SET HLST1=2

 +54      ;Update status

                   DO STATUS^HLTF0(HLXX,HLST1)

 +55      ;Unlock main node of Message Text

                   LOCK -^HL(772,HLXX,0)

 +56      ;Update LAST KNOWN $H (field #.03) for filer

 +57               DO SETFLRDH^HLCSUTL1(HLPTRFLR,"OUT")

               End DoDot:1

               IF HLEXIT

                   QUIT 

 +58      ;Asked to stop

           SET ZTSTOP=1

 +59      ;Delete entry denoting this filer

           DO DELFLR^HLCSUTL1(HLPTRFLR,"OUT")

 +60       SET ZTREQ="@"

 +61       QUIT