HLTP0 ;AISC/SAW,JRP - Transaction Processor Module (Cont'd) ;11/19/97 11:13 [ 04/02/2003 8:38 AM ]
;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003
;;1.6;HEALTH LEVEL SEVEN;**25,37**;Oct 13, 1995
PROCESS(HLMTIEN,HLLD0,HLLD1,HLRESLT) ;Process an incoming message
;
;INPUT : HLMTIEN - One of two values
; 1) Pointer to entry in MESSAGE TEXT file (#772)
; that requires processing (internal message)
; 2) Pointer to entry in MESSAGE TEXT file (#772)
; that external message will be placed into
; HLLD0 - One of three values
; 1) Pointer to LOGICAL LINK file (#870) that
; contains the message
; 2) 'XM' if the message was received through MailMan
; 3) 'DHCP' if the message is from an internal
; application
; HLLD1 - Pointer to entry in IN QUEUE multiple (#19) of
; the LOGICAL LINK file (#870)
; - Only used for messages received through the
; LOGICAL LINK file (#870)
; HLRESLT - Variable to return error text in (pass by reference)
;OUTPUT : On successful completion, HLRESLT will be set to NULL
; On error, HLRESLT will be set to ErrorCode^ErrorText
;
;Check parameters
S HLRESLT="7^"_$G(^HL(771.7,7,0))_" at PROCESS^HLTP0 entry point"
Q:('$G(HLMTIEN))
S HLLD0=$G(HLLD0)
Q:(HLLD0="")
Q:((HLLD0'="XM")&(HLLD0'="DHCP")&('$D(^HLCS(870,+HLLD0,0))))
S HLLD1=+$G(HLLD1)
Q:((+HLLD0)&('$D(^HLCS(870,+HLLD0,1,HLLD1,0))))
S HLRESLT=""
N HLEXROU,CHARCNT,EVNTCNT,HDRFND,FLDSPRTR,LINE,TEXT,SEGNAME,HDRTYPE
N HLENROU,HLNEXT,HLNODE,HLPROU,HLQUIT,HLMTIENS
;
;Prepare to process internal message
I (HLLD0="DHCP") D Q:(HLRESLT'="")
.;Determine statistics for message
.S LINE=0
.S TEXT=""
.S HDRFND=0
.S CHARCNT=0
.S EVNTCNT=0
.S HLMSA=""
.S HLHDR=""
.S SEGNAME=""
.S HDRTYPE=""
.;Order through message text
.F S LINE=+$O(^HL(772,HLMTIEN,"IN",LINE)) Q:('LINE) D
..S TEXT=$G(^HL(772,HLMTIEN,"IN",LINE,0))
..;Determine if header found yet (skip lines until it is)
..S:"FHS,BHS,MSH"[$E(TEXT,1,3) HDRFND=1
..Q:('HDRFND)
..;Increment character count
..S CHARCNT=CHARCNT+$L(TEXT)
..;Get segment name
..S SEGNAME=$E(TEXT,1,3)
..;If header segment, process it and set HLHDR equal to it
..I "FHS,BHS,MSH"[SEGNAME D
...I (HLHDR="") S HLHDR=TEXT,FLDSPRTR=$E(TEXT,4),HDRTYPE=SEGNAME
...S $P(TEXT,FLDSPRTR,8)=""
...S:(SEGNAME="MSH") EVNTCNT=EVNTCNT+1
..;If acknowledgement segment, set HLMSA equal to it
..S:((SEGNAME="MSA")&(HLMSA="")&(HDRTYPE="MSH")) HLMSA=TEXT
.;Update statistics
.D STATS^HLTF0(HLMTIEN,CHARCNT,EVNTCNT)
.S:(HLHDR="") HLRESLT="12^"_$G(^HL(771.7,12,0))
;
;Prepare to process external message
I (HLLD0'="DHCP") D Q:(HLRESLT'="")
.;Store message in Message Text file
.D MERGEIN^HLTF2(HLLD0,$S($G(HLLD1):HLLD1,1:""),HLMTIEN,.HLHDR,.HLMSA)
. ; for batch message
.I $D(HLMSA),$P(HLMSA,$E(HLHDR,4),2)="" S HLMSA=""
.S:('$D(HLHDR)) HLRESLT="12^"_$G(^HL(771.7,12,0))
;
;Process message
D ^HLTP01
;
;Update status of subscriber message
I (HLMTIENS) D STATUS^HLTF0(HLMTIENS,$S(HLRESLT:4,1:3),$S(HLRESLT:+HLRESLT,1:""),$S($D(HLERR):HLERR,HLRESLT:$P(HLRESLT,"^",2),1:""))
;
;Execute exit action of client protocol
X:$G(HLEXROU)]"" HLEXROU
Q
HLTP0 ;AISC/SAW,JRP - Transaction Processor Module (Cont'd) ;11/19/97 11:13 [ 04/02/2003 8:38 AM ]
+1 ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003
+2 ;;1.6;HEALTH LEVEL SEVEN;**25,37**;Oct 13, 1995
PROCESS(HLMTIEN,HLLD0,HLLD1,HLRESLT) ;Process an incoming message
+1 ;
+2 ;INPUT : HLMTIEN - One of two values
+3 ; 1) Pointer to entry in MESSAGE TEXT file (#772)
+4 ; that requires processing (internal message)
+5 ; 2) Pointer to entry in MESSAGE TEXT file (#772)
+6 ; that external message will be placed into
+7 ; HLLD0 - One of three values
+8 ; 1) Pointer to LOGICAL LINK file (#870) that
+9 ; contains the message
+10 ; 2) 'XM' if the message was received through MailMan
+11 ; 3) 'DHCP' if the message is from an internal
+12 ; application
+13 ; HLLD1 - Pointer to entry in IN QUEUE multiple (#19) of
+14 ; the LOGICAL LINK file (#870)
+15 ; - Only used for messages received through the
+16 ; LOGICAL LINK file (#870)
+17 ; HLRESLT - Variable to return error text in (pass by reference)
+18 ;OUTPUT : On successful completion, HLRESLT will be set to NULL
+19 ; On error, HLRESLT will be set to ErrorCode^ErrorText
+20 ;
+21 ;Check parameters
+22 SET HLRESLT="7^"_$GET(^HL(771.7,7,0))_" at PROCESS^HLTP0 entry point"
+23 IF ('$GET(HLMTIEN))
QUIT
+24 SET HLLD0=$GET(HLLD0)
+25 IF (HLLD0="")
QUIT
+26 IF ((HLLD0'="XM")&(HLLD0'="DHCP")&('$DATA(^HLCS(870,+HLLD0,0))))
QUIT
+27 SET HLLD1=+$GET(HLLD1)
+28 IF ((+HLLD0)&('$DATA(^HLCS(870,+HLLD0,1,HLLD1,0))))
QUIT
+29 SET HLRESLT=""
+30 NEW HLEXROU,CHARCNT,EVNTCNT,HDRFND,FLDSPRTR,LINE,TEXT,SEGNAME,HDRTYPE
+31 NEW HLENROU,HLNEXT,HLNODE,HLPROU,HLQUIT,HLMTIENS
+32 ;
+33 ;Prepare to process internal message
+34 IF (HLLD0="DHCP")
Begin DoDot:1
+35 ;Determine statistics for message
+36 SET LINE=0
+37 SET TEXT=""
+38 SET HDRFND=0
+39 SET CHARCNT=0
+40 SET EVNTCNT=0
+41 SET HLMSA=""
+42 SET HLHDR=""
+43 SET SEGNAME=""
+44 SET HDRTYPE=""
+45 ;Order through message text
+46 FOR
SET LINE=+$ORDER(^HL(772,HLMTIEN,"IN",LINE))
IF ('LINE)
QUIT
Begin DoDot:2
+47 SET TEXT=$GET(^HL(772,HLMTIEN,"IN",LINE,0))
+48 ;Determine if header found yet (skip lines until it is)
+49 IF "FHS,BHS,MSH"[$EXTRACT(TEXT,1,3)
SET HDRFND=1
+50 IF ('HDRFND)
QUIT
+51 ;Increment character count
+52 SET CHARCNT=CHARCNT+$LENGTH(TEXT)
+53 ;Get segment name
+54 SET SEGNAME=$EXTRACT(TEXT,1,3)
+55 ;If header segment, process it and set HLHDR equal to it
+56 IF "FHS,BHS,MSH"[SEGNAME
Begin DoDot:3
+57 IF (HLHDR="")
SET HLHDR=TEXT
SET FLDSPRTR=$EXTRACT(TEXT,4)
SET HDRTYPE=SEGNAME
+58 SET $PIECE(TEXT,FLDSPRTR,8)=""
+59 IF (SEGNAME="MSH")
SET EVNTCNT=EVNTCNT+1
End DoDot:3
+60 ;If acknowledgement segment, set HLMSA equal to it
+61 IF ((SEGNAME="MSA")&(HLMSA="")&(HDRTYPE="MSH"))
SET HLMSA=TEXT
End DoDot:2
+62 ;Update statistics
+63 DO STATS^HLTF0(HLMTIEN,CHARCNT,EVNTCNT)
+64 IF (HLHDR="")
SET HLRESLT="12^"_$GET(^HL(771.7,12,0))
End DoDot:1
IF (HLRESLT'="")
QUIT
+65 ;
+66 ;Prepare to process external message
+67 IF (HLLD0'="DHCP")
Begin DoDot:1
+68 ;Store message in Message Text file
+69 DO MERGEIN^HLTF2(HLLD0,$SELECT($GET(HLLD1):HLLD1,1:""),HLMTIEN,.HLHDR,.HLMSA)
+70 ; for batch message
+71 IF $DATA(HLMSA)
IF $PIECE(HLMSA,$EXTRACT(HLHDR,4),2)=""
SET HLMSA=""
+72 IF ('$DATA(HLHDR))
SET HLRESLT="12^"_$GET(^HL(771.7,12,0))
End DoDot:1
IF (HLRESLT'="")
QUIT
+73 ;
+74 ;Process message
+75 DO ^HLTP01
+76 ;
+77 ;Update status of subscriber message
+78 IF (HLMTIENS)
DO STATUS^HLTF0(HLMTIENS,$SELECT(HLRESLT:4,1:3),$SELECT(HLRESLT:+HLRESLT,1:""),$SELECT($DATA(HLERR):HLERR,HLRESLT:$PIECE(HLRESLT,"^",2),1:""))
+79 ;
+80 ;Execute exit action of client protocol
+81 IF $GET(HLEXROU)]""
XECUTE HLEXROU
+82 QUIT
