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