HLTP3A ;SFIRMFO/RSD - Transaction Processor for TCP- INIT ;10/31/2008 11:01
;;1.6;HEALTH LEVEL SEVEN;**109,142**;Oct 13, 1995;Build 17
;Per VHA Directive 2004-038, this routine should not be modified.
;
;split from hltp3
Q
INIT ;initialize variables, get MSA & header, returns HLRESLT if error
N HLJ
;
K HLRESLT,HL
S HLMTIENS=+X,HLMTIEN=+$P(X,U,2),HLMSA=$$MSA^HLTP3(HLMTIEN)
;
;get header and validate
; patch HL*1.6*142: locking code for MPI-client/server
F L +^HLMA(HLMTIENS,"MSH"):10 Q:$T H 1
F COUNT=1:1:15 Q:$G(^HLMA(HLMTIENS,"MSH",1,0))]"" H COUNT
M HLHDRO=^HLMA(HLMTIENS,"MSH")
L -^HLMA(HLMTIENS,"MSH")
;HLMSA is by ref., for a batch msg HLMSA will be setup in HLTPCK2
D CHK^HLTPCK2(.HLHDRO,.HL,.HLMSA)
;Update Message Administration file #773, for incoming message
;3=trans type, 20=status
K HLJ
S X="HLJ(773,"""_HLMTIENS_","")",@X@(3)="I",@X@(20)=9
;HL=error #^error text, 21=date process, 22=error msg, 23=error type
S:$G(HL) @X@(20)=4,@X@(21)=$$NOW^XLFDT,@X@(22)=$P(HL,U,2),@X@(23)=+HL
;8=protocol, 13=sending app
S:$G(HL("EIDS")) @X@(8)=HL("EIDS") S:$G(HL("SAP")) @X@(13)=HL("SAP")
;14=receiving app, 12=acknowledgement to
S:$G(HL("RAP")) @X@(14)=HL("RAP") S:$G(HL("MTIENS")) @X@(12)=HL("MTIENS")
;6=initial message, 7=logical link
S:$G(HLTCPI) @X@(6)=HLTCPI S @X@(7)=HLDP
;
;15=message type, 16=event type
S:$G(HL("MTP")) @X@(15)=HL("MTP") S:$G(HL("ETP")) @X@(16)=HL("ETP")
;HL*1.6*109 S:$G(HL("MTP_ETP")) @X@(17)=HL("MTP_ETP")
D FILE^HLDIE("","HLJ","","INIT-1","HLTP3A") ;HL*1.6*109
;Update Message Text file #772
;4=trans type
K HLJ S X="HLJ(772,"""_HLMTIEN_","")",@X@(4)="I"
;10=event protocol
S:$G(HL("EID")) @X@(10)=HL("EID")
D FILE^HLDIE("","HLJ","","INIT-2","HLTP3A") ; HL*1.6*109
;set HLRESLT to error
S:HL'="" HLRESLT=HL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLTP3A 1839 printed Dec 13, 2024@02:00:02 Page 2
HLTP3A ;SFIRMFO/RSD - Transaction Processor for TCP- INIT ;10/31/2008 11:01
+1 ;;1.6;HEALTH LEVEL SEVEN;**109,142**;Oct 13, 1995;Build 17
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;split from hltp3
+5 QUIT
INIT ;initialize variables, get MSA & header, returns HLRESLT if error
+1 NEW HLJ
+2 ;
+3 KILL HLRESLT,HL
+4 SET HLMTIENS=+X
SET HLMTIEN=+$PIECE(X,U,2)
SET HLMSA=$$MSA^HLTP3(HLMTIEN)
+5 ;
+6 ;get header and validate
+7 ; patch HL*1.6*142: locking code for MPI-client/server
+8 FOR
LOCK +^HLMA(HLMTIENS,"MSH"):10
if $TEST
QUIT
HANG 1
+9 FOR COUNT=1:1:15
if $GET(^HLMA(HLMTIENS,"MSH",1,0))]""
QUIT
HANG COUNT
+10 MERGE HLHDRO=^HLMA(HLMTIENS,"MSH")
+11 LOCK -^HLMA(HLMTIENS,"MSH")
+12 ;HLMSA is by ref., for a batch msg HLMSA will be setup in HLTPCK2
+13 DO CHK^HLTPCK2(.HLHDRO,.HL,.HLMSA)
+14 ;Update Message Administration file #773, for incoming message
+15 ;3=trans type, 20=status
+16 KILL HLJ
+17 SET X="HLJ(773,"""_HLMTIENS_","")"
SET @X@(3)="I"
SET @X@(20)=9
+18 ;HL=error #^error text, 21=date process, 22=error msg, 23=error type
+19 if $GET(HL)
SET @X@(20)=4
SET @X@(21)=$$NOW^XLFDT
SET @X@(22)=$PIECE(HL,U,2)
SET @X@(23)=+HL
+20 ;8=protocol, 13=sending app
+21 if $GET(HL("EIDS"))
SET @X@(8)=HL("EIDS")
if $GET(HL("SAP"))
SET @X@(13)=HL("SAP")
+22 ;14=receiving app, 12=acknowledgement to
+23 if $GET(HL("RAP"))
SET @X@(14)=HL("RAP")
if $GET(HL("MTIENS"))
SET @X@(12)=HL("MTIENS")
+24 ;6=initial message, 7=logical link
+25 if $GET(HLTCPI)
SET @X@(6)=HLTCPI
SET @X@(7)=HLDP
+26 ;
+27 ;15=message type, 16=event type
+28 if $GET(HL("MTP"))
SET @X@(15)=HL("MTP")
if $GET(HL("ETP"))
SET @X@(16)=HL("ETP")
+29 ;HL*1.6*109 S:$G(HL("MTP_ETP")) @X@(17)=HL("MTP_ETP")
+30 ;HL*1.6*109
DO FILE^HLDIE("","HLJ","","INIT-1","HLTP3A")
+31 ;Update Message Text file #772
+32 ;4=trans type
+33 KILL HLJ
SET X="HLJ(772,"""_HLMTIEN_","")"
SET @X@(4)="I"
+34 ;10=event protocol
+35 if $GET(HL("EID"))
SET @X@(10)=HL("EID")
+36 ; HL*1.6*109
DO FILE^HLDIE("","HLJ","","INIT-2","HLTP3A")
+37 ;set HLRESLT to error
+38 if HL'=""
SET HLRESLT=HL
+39 QUIT
