- HLTP0 ;AISC/SAW,JRP - Transaction Processor Module (Cont'd) ;11/19/97 11:13
- ;;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLTP0 3362 printed Feb 18, 2025@23:26:21 Page 2
- HLTP0 ;AISC/SAW,JRP - Transaction Processor Module (Cont'd) ;11/19/97 11:13
- +1 ;;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