HLTF ;AISC/SAW,JRP-Create/Process Message Text File Entries ;01/23/06 12:56
;;1.6;HEALTH LEVEL SEVEN;**1,19,43,55,109,120**;Oct 13, 1995;Build 12
FILE ;Create Entries in files 772 and 773 for Version 1.5 Interface Only
D CREATE(,.HLDA,.HLDT,.HLDT1)
Q
CREATE(HLMID,MTIEN,HLDT,HLDT1) ;Create entries in Message Text (#772)
;
;Input : HLMID = Variable in which value of message ID will be
; returned (pass by reference)
; MTIEN = Variable in which IEN of Message Text file entry
; will be returned (pass by reference)
; HLDT = Variable in which current date/time in FM internal
; format will be returned (pass by reference)
; HLDT1 = Variable in which current date/time in HL7 format
; will be returned (pass by reference)
;
;Output : See above
;
;Notes : If HLDT has a value [upon entry], the created entries will
; be given that value for their date/time (value of .01)
; : Current date/time used if HLDT is not passed or invalid
;
;Make entry in Message Administration file
N Y
S HLDT=$G(HLDT)
D MT(.HLDT)
S Y=$$CHNGMID(MTIEN,.HLMID),HLDT1=$$HLDATE^HLFNC(HLDT)
Q
TCP(HLMID,MTIEN,HLDT) ;create new message in 772 & 773 entries
;used for incoming messages and outgoing responses
;Input : HLMID = Variable in which value of message ID will be
; returned (pass by reference)
; MTIEN = Variable in which IEN of file 773 entry
; will be returned (pass by reference)
; HLDT = Variable in which current date/time in FM internal
; format will be returned (pass by reference)
;
S HLDT=$G(HLDT),HLMID=$G(HLMID)
D MT(.HLDT)
S MTIEN=$$MA(MTIEN,.HLMID)
Q
;
MT(HLX) ;Create entry in Message Text file (#772)
;
;Input : HLX = Date/time entry in file should be given (value of .01)
; Defaults to current date/time
;
;Output : HLDT = Date/time of created entry (value of .01)
; : HLDT1 = HLDT in HL7 format
;
;Notes : HLX must be in FileMan format (default value used if not)
; : HLDT will be in FileMan format
; : MTIEN is ien in file 772
;
;Check for input
S HLX=$G(HLX)
;Declare variables
N DIC,DD,DO,HLCNT,HLJ,X,Y
F HLCNT=0:1 D Q:Y>0 H HLCNT
. I (HLX'?7N.1".".6N) S HLX=$$NOW^XLFDT
. S DIC="^HL(772,",DIC(0)="L",(HLDT,X)=HLX
. S Y=$$STUB772(X) ; This call substituted for D FILE^DICN by HL*1.6*109
. ;Entry not created - try again
. I Y<0 S HLX="" Q
. S MTIEN=+Y
;***If we didn't get a record in 772, need to do something
I Y<0 Q
S HLDT1=$$HLDATE^HLFNC(HLDT)
Q
;add to Message Admin file #773
MA(X,HLMID) ;X=ien in file 772, HLMID=msg. id (passed by ref.)
;return ien in file 773
Q:'$G(^HL(772,X,0)) 0
N DA,DD,DO,DIC,DIE,DR,HLDA,HLCNT,HLJ,Y
S DIC="^HLMA(",DIC(0)="L"
F HLCNT=0:1 D Q:Y>0 H HLCNT
. S Y=$$STUB773(X) ; This call substituted for D FILE^DICN by HL*1.6*109
;***If we didn't get a record in 773, need to do something
I Y<0 Q 0
S HLDA=+Y,HLMID=$$MAID(HLDA,$G(HLMID))
Q HLDA
;
MAID(Y,HLMID) ;Determine message ID (if needed) & store message ID
;Y=ien in 773, HLMID=id, Output message id
N HLJ
;need to have id contain institution number to make unique
S:$G(HLMID)="" HLMID=+$P($$PARAM^HLCS2,U,6)_Y
S HLJ(773,Y_",",2)=HLMID
D FILE^HLDIE("","HLJ","","MAID","HLTF") ;HL*1.6*109
Q HLMID
;
CHNGMID(PTRMT,NEWID) ;Change message ID for entry in Message Text file
;Input : PTRMT - Pointer to entry in Message Text file (#772)
; NEWID - New message ID
;Output : 0 = Success
; -1^ErrorText = Error/Bad input
;
;Check input
S PTRMT=+$G(PTRMT)
S NEWID=$G(NEWID)
Q:('$D(^HL(772,PTRMT,0))) "-1^Did not pass valid pointer to Message Text file (#772)"
N HLJ
I $G(NEWID)="" S NEWID=+$P($$PARAM^HLCS2,U,6)_PTRMT
S HLJ(772,PTRMT_",",6)=NEWID
D FILE^HLDIE("","HLJ","","CHNGMID","HLTF") ; HL*1.6*109
Q 0
;
OUT(HLDA,HLMID,HLMTN) ;File Data in Message Text File for Outgoing Message
;Version 1.5 Interface Only
Q:'$D(HLFS)
;
I HLMTN="ACK"!(HLMTN="MCF")!(HLMTN="ORR") Q:'$D(HLMSA) D ACK(HLMSA,"I") Q
;
;-- if message contained MSA find inbound message
I $D(HLMSA),$D(HLNDAP),$P(HLMSA,HLFS,3)]"" D
. N HLDAI
. S HLDAI=0
. F S HLDAI=$O(^HL(772,"AH",+$P($G(HLNDAP0),U,12),$P(HLMSA,HLFS,3),HLDAI)) Q:'HLDAI!($P($G(^HL(772,+HLDAI,0)),U,4)="I")
. I 'HLDAI K HLDAI
;
D STUFF^HLTF0("O")
;
N HLAC S HLAC=$S($D(HLERR):4,'$P(HLNDAP0,"^",10):1,1:2) D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
D:$D(HLCHAR) STATS^HLTF0(HLDA,HLCHAR,$G(HLEVN))
;
;-- update status if MSA and found inbound message
I $D(HLMSA),$D(HLDAI) D
.N HLERR,HLMSG I $P(HLMSA,HLFS,4)]"" S HLERR=$P(HLMSA,HLFS,4)
.S HLAC=$P(HLMSA,HLFS,2)
.I HLAC'="AA" S HLMSG=$S(HLAC="AR":"Application Reject",HLAC="AE":"Application Error",1:"")_" - "_HLERR
.S HLAC=$S(HLAC'="AA":4,1:3) D STATUS^HLTF0(HLDAI,HLAC,$G(HLMSG))
Q
;
IN(HLMTN,HLMID,HLTIME) ;File Data in Message Text File for Incoming Message
;Version 1.5 Interface Only
Q:'$D(HLFS)
I HLMTN="ACK"!(HLMTN="MCF")!(HLMTN="ORR") Q:'$D(HLMSA) D ACK(HLMSA,"O",$G(HLDA)) Q
;
N HLDAI S HLDA=0
I $D(HLNDAP),HLMID]"" D
.F S HLDA=+$O(^HL(772,"AH",+$P($G(HLNDAP0),U,12),HLMID,HLDA)) Q:'HLDA!($P($G(^HL(772,+HLDA,0)),U,4)="I")
.I HLDA D
..S HLDT=+$P($G(^HL(772,HLDA,0)),"^"),HLDT1=$$HLDATE^HLFNC(HLDT)
..K ^HL(772,HLDA,"IN")
.I $D(HLMSA),$P(HLMSA,HLFS,3)]"" D
..S HLDAI=0
..F S HLDAI=$O(^HL(772,"AH",+$P($G(HLNDAP0),U,12),$P(HLMSA,HLFS,3),HLDAI)) Q:'HLDAI!($P($G(^HL(772,+HLDAI,0)),U,4)="O")
..I 'HLDAI K HLDAI
;
I 'HLDA D CREATE(.HLMID,.HLDA,.HLDT,.HLDT1) K HLZ
;
D STUFF^HLTF0("I")
N HLAC S HLAC=$S($D(HLERR):4,1:1) D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
;
D MERGE15^HLTF1("G",HLDA,"HLR",HLTIME)
;
I '$D(HLERR),$D(HLMSA),$D(HLDAI) D
.N HLAC,HLERR,HLMSG I $P(HLMSA,HLFS,4)]"" S HLERR=$P(HLMSA,HLFS,4)
.S HLAC=$P(HLMSA,HLFS,2) I HLAC'="AA" S HLMSG=$S(HLAC="AR":"Application Reject",1:"Application Error")_" - "_HLERR
.S HLAC=$S(HLAC'="AA":4,1:3) D STATUS^HLTF0(HLDAI,HLAC,$G(HLMSG))
Q
;
ACK(HLMSA,HLIO,HLDA) ;Process 'ACK' Message Type - Version 1.5 Interface Only
; To determine the correct message to link the ACK, HLIO is used.
; For an ack from DHCP (original message from remote system) then
; HLIO should be "I" so that the correct inbound message is ack-ed. For
; an inbound ack (original message outbound from DHCP) HLIO should be
; "O". This distinction must be made due to the possible duplicate
; message ids from a bi-direction interface.
;
; Input : MSA - MSA from ACK message.
; HLIO - Either "I" or "O" : See note above.
;Output : None
;
N HLAC,HLMIDI
;-- set up required vars
S HLAC=$P(HLMSA,HLFS,2),HLMIDI=$P(HLMSA,HLFS,3)
;-- quit
Q:HLMIDI']""!(HLAC']"")!('$D(HLNDAP))
;-- find message to ack
I '$G(HLDA) S HLDA=0 D
. F S HLDA=+$O(^HL(772,"AH",+$P($G(HLNDAP0),U,12),HLMIDI,HLDA)) Q:'HLDA!($P($G(^HL(772,+HLDA,0)),U,4)=HLIO)
;-- quit if no message
Q:'$D(^HL(772,+HLDA,0))
;-- check for error
I $P(HLMSA,HLFS,4)]"" N HLERR S HLERR=$P(HLMSA,HLFS,4)
I $D(HLERR),'$D(HLMSG) N HLMSG S HLMSG="Error During Receipt of Acknowledgement Message"_$S(HLAC="AR":" - Application Reject",HLAC="AE":" - Application Error",1:"")_" - "_HLERR
;-- update status
S HLAC=$S(HLMTN="MCF":2,HLAC'="AA":4,1:3)
D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
Q
;
STUB772(FLD01,OS) ;
;This function creates a new stub record in file 772. The Stub record may consist of only the 0 node with a value of "^". If a value is passed in for the .01 field it will be included in the 0 node and its "B" x-ref set.
;Inputs:
; OS (optional), the value of ^%ZOSF("OS")
; FLD01 (optional), the value for the .01 field
;Output - the function returns the ien of the newly created record
;
N IEN
I '$L($G(OS)) N OS S OS=$G(^%ZOSF("OS"))
;
; patch HL*1.6*120, protect Else command
; I OS'["DSM",OS'["OpenM" D
I OS'["DSM",OS'["OpenM" D I 1
.F L +^HLCS(869.3,1,772):10 S IEN=+$G(^HLCS(869.3,1,772))+1,^HLCS(869.3,1,772)=IEN S:$D(^HL(772,IEN)) IEN=0,^HLCS(869.3,1,772)=($O(^HL(772,":"),-1)\1) L -^HLCS(869.3,1,772) Q:IEN
E D
.F S IEN=$I(^HLCS(869.3,1,772),1) S:$D(^HL(772,IEN)) IEN=0,^HLCS(869.3,1,772)=($O(^HL(772,":"),-1)\1) Q:IEN
S ^HL(772,IEN,0)=$G(FLD01)_"^"
I $L($G(FLD01)) S ^HL(772,"B",FLD01,IEN)=""
Q IEN
;
STUB773(FLD01,OS) ;
;This function creates a new stub record in file 772. The Stub record may consist of only the 0 node with a value of "^". If a value is passed in for the .01 field it will be included in the 0 node and its "B" x-ref set.
;Inputs:
; OS (optional), the value of ^%ZOSF("OS")
; FLD01 (optional), the value for the .01 field
;Output - the function returns the ien of the newly created record
;
N IEN
I '$L($G(OS)) N OS S OS=$G(^%ZOSF("OS"))
;
; patch HL*1.6*120, protect Else command
; I OS'["DSM",OS'["OpenM" D
I OS'["DSM",OS'["OpenM" D I 1
.F L +^HLCS(869.3,1,773):10 S IEN=+$G(^HLCS(869.3,1,773))+1,^HLCS(869.3,1,773)=IEN S:$D(^HLMA(IEN)) IEN=0,^HLCS(869.3,1,773)=($O(^HLMA(":"),-1)\1) L -^HLCS(869.3,1,773) Q:IEN
E D
.F S IEN=$I(^HLCS(869.3,1,773),1) S:$D(^HLMA(IEN)) IEN=0,^HLCS(869.3,1,773)=($O(^HLMA(":"),-1)\1) Q:IEN
S ^HLMA(IEN,0)=$G(FLD01)_"^"
I $L($G(FLD01)) S ^HLMA("B",FLD01,IEN)=""
Q IEN
HLTF ;AISC/SAW,JRP-Create/Process Message Text File Entries ;01/23/06 12:56
+1 ;;1.6;HEALTH LEVEL SEVEN;**1,19,43,55,109,120**;Oct 13, 1995;Build 12
FILE ;Create Entries in files 772 and 773 for Version 1.5 Interface Only
+1 DO CREATE(,.HLDA,.HLDT,.HLDT1)
+2 QUIT
CREATE(HLMID,MTIEN,HLDT,HLDT1) ;Create entries in Message Text (#772)
+1 ;
+2 ;Input : HLMID = Variable in which value of message ID will be
+3 ; returned (pass by reference)
+4 ; MTIEN = Variable in which IEN of Message Text file entry
+5 ; will be returned (pass by reference)
+6 ; HLDT = Variable in which current date/time in FM internal
+7 ; format will be returned (pass by reference)
+8 ; HLDT1 = Variable in which current date/time in HL7 format
+9 ; will be returned (pass by reference)
+10 ;
+11 ;Output : See above
+12 ;
+13 ;Notes : If HLDT has a value [upon entry], the created entries will
+14 ; be given that value for their date/time (value of .01)
+15 ; : Current date/time used if HLDT is not passed or invalid
+16 ;
+17 ;Make entry in Message Administration file
+18 NEW Y
+19 SET HLDT=$GET(HLDT)
+20 DO MT(.HLDT)
+21 SET Y=$$CHNGMID(MTIEN,.HLMID)
SET HLDT1=$$HLDATE^HLFNC(HLDT)
+22 QUIT
TCP(HLMID,MTIEN,HLDT) ;create new message in 772 & 773 entries
+1 ;used for incoming messages and outgoing responses
+2 ;Input : HLMID = Variable in which value of message ID will be
+3 ; returned (pass by reference)
+4 ; MTIEN = Variable in which IEN of file 773 entry
+5 ; will be returned (pass by reference)
+6 ; HLDT = Variable in which current date/time in FM internal
+7 ; format will be returned (pass by reference)
+8 ;
+9 SET HLDT=$GET(HLDT)
SET HLMID=$GET(HLMID)
+10 DO MT(.HLDT)
+11 SET MTIEN=$$MA(MTIEN,.HLMID)
+12 QUIT
+13 ;
MT(HLX) ;Create entry in Message Text file (#772)
+1 ;
+2 ;Input : HLX = Date/time entry in file should be given (value of .01)
+3 ; Defaults to current date/time
+4 ;
+5 ;Output : HLDT = Date/time of created entry (value of .01)
+6 ; : HLDT1 = HLDT in HL7 format
+7 ;
+8 ;Notes : HLX must be in FileMan format (default value used if not)
+9 ; : HLDT will be in FileMan format
+10 ; : MTIEN is ien in file 772
+11 ;
+12 ;Check for input
+13 SET HLX=$GET(HLX)
+14 ;Declare variables
+15 NEW DIC,DD,DO,HLCNT,HLJ,X,Y
+16 FOR HLCNT=0:1
Begin DoDot:1
+17 IF (HLX'?7N.1".".6N)
SET HLX=$$NOW^XLFDT
+18 SET DIC="^HL(772,"
SET DIC(0)="L"
SET (HLDT,X)=HLX
+19 ; This call substituted for D FILE^DICN by HL*1.6*109
SET Y=$$STUB772(X)
+20 ;Entry not created - try again
+21 IF Y<0
SET HLX=""
QUIT
+22 SET MTIEN=+Y
End DoDot:1
IF Y>0
QUIT
HANG HLCNT
+23 ;***If we didn't get a record in 772, need to do something
+24 IF Y<0
QUIT
+25 SET HLDT1=$$HLDATE^HLFNC(HLDT)
+26 QUIT
+27 ;add to Message Admin file #773
MA(X,HLMID) ;X=ien in file 772, HLMID=msg. id (passed by ref.)
+1 ;return ien in file 773
+2 IF '$GET(^HL(772,X,0))
QUIT 0
+3 NEW DA,DD,DO,DIC,DIE,DR,HLDA,HLCNT,HLJ,Y
+4 SET DIC="^HLMA("
SET DIC(0)="L"
+5 FOR HLCNT=0:1
Begin DoDot:1
+6 ; This call substituted for D FILE^DICN by HL*1.6*109
SET Y=$$STUB773(X)
End DoDot:1
IF Y>0
QUIT
HANG HLCNT
+7 ;***If we didn't get a record in 773, need to do something
+8 IF Y<0
QUIT 0
+9 SET HLDA=+Y
SET HLMID=$$MAID(HLDA,$GET(HLMID))
+10 QUIT HLDA
+11 ;
MAID(Y,HLMID) ;Determine message ID (if needed) & store message ID
+1 ;Y=ien in 773, HLMID=id, Output message id
+2 NEW HLJ
+3 ;need to have id contain institution number to make unique
+4 IF $GET(HLMID)=""
SET HLMID=+$PIECE($$PARAM^HLCS2,U,6)_Y
+5 SET HLJ(773,Y_",",2)=HLMID
+6 ;HL*1.6*109
DO FILE^HLDIE("","HLJ","","MAID","HLTF")
+7 QUIT HLMID
+8 ;
CHNGMID(PTRMT,NEWID) ;Change message ID for entry in Message Text file
+1 ;Input : PTRMT - Pointer to entry in Message Text file (#772)
+2 ; NEWID - New message ID
+3 ;Output : 0 = Success
+4 ; -1^ErrorText = Error/Bad input
+5 ;
+6 ;Check input
+7 SET PTRMT=+$GET(PTRMT)
+8 SET NEWID=$GET(NEWID)
+9 IF ('$DATA(^HL(772,PTRMT,0)))
QUIT "-1^Did not pass valid pointer to Message Text file (#772)"
+10 NEW HLJ
+11 IF $GET(NEWID)=""
SET NEWID=+$PIECE($$PARAM^HLCS2,U,6)_PTRMT
+12 SET HLJ(772,PTRMT_",",6)=NEWID
+13 ; HL*1.6*109
DO FILE^HLDIE("","HLJ","","CHNGMID","HLTF")
+14 QUIT 0
+15 ;
OUT(HLDA,HLMID,HLMTN) ;File Data in Message Text File for Outgoing Message
+1 ;Version 1.5 Interface Only
+2 IF '$DATA(HLFS)
QUIT
+3 ;
+4 IF HLMTN="ACK"!(HLMTN="MCF")!(HLMTN="ORR")
IF '$DATA(HLMSA)
QUIT
DO ACK(HLMSA,"I")
QUIT
+5 ;
+6 ;-- if message contained MSA find inbound message
+7 IF $DATA(HLMSA)
IF $DATA(HLNDAP)
IF $PIECE(HLMSA,HLFS,3)]""
Begin DoDot:1
+8 NEW HLDAI
+9 SET HLDAI=0
+10 FOR
SET HLDAI=$ORDER(^HL(772,"AH",+$PIECE($GET(HLNDAP0),U,12),$PIECE(HLMSA,HLFS,3),HLDAI))
IF 'HLDAI!($PIECE($GET(^HL(772,+HLDAI,0)),U,4)="I")
QUIT
+11 IF 'HLDAI
KILL HLDAI
End DoDot:1
+12 ;
+13 DO STUFF^HLTF0("O")
+14 ;
+15 NEW HLAC
SET HLAC=$SELECT($DATA(HLERR):4,'$PIECE(HLNDAP0,"^",10):1,1:2)
DO STATUS^HLTF0(HLDA,HLAC,$GET(HLMSG))
+16 IF $DATA(HLCHAR)
DO STATS^HLTF0(HLDA,HLCHAR,$GET(HLEVN))
+17 ;
+18 ;-- update status if MSA and found inbound message
+19 IF $DATA(HLMSA)
IF $DATA(HLDAI)
Begin DoDot:1
+20 NEW HLERR,HLMSG
IF $PIECE(HLMSA,HLFS,4)]""
SET HLERR=$PIECE(HLMSA,HLFS,4)
+21 SET HLAC=$PIECE(HLMSA,HLFS,2)
+22 IF HLAC'="AA"
SET HLMSG=$SELECT(HLAC="AR":"Application Reject",HLAC="AE":"Application Error",1:"")_" - "_HLERR
+23 SET HLAC=$SELECT(HLAC'="AA":4,1:3)
DO STATUS^HLTF0(HLDAI,HLAC,$GET(HLMSG))
End DoDot:1
+24 QUIT
+25 ;
IN(HLMTN,HLMID,HLTIME) ;File Data in Message Text File for Incoming Message
+1 ;Version 1.5 Interface Only
+2 IF '$DATA(HLFS)
QUIT
+3 IF HLMTN="ACK"!(HLMTN="MCF")!(HLMTN="ORR")
IF '$DATA(HLMSA)
QUIT
DO ACK(HLMSA,"O",$GET(HLDA))
QUIT
+4 ;
+5 NEW HLDAI
SET HLDA=0
+6 IF $DATA(HLNDAP)
IF HLMID]""
Begin DoDot:1
+7 FOR
SET HLDA=+$ORDER(^HL(772,"AH",+$PIECE($GET(HLNDAP0),U,12),HLMID,HLDA))
IF 'HLDA!($PIECE($GET(^HL(772,+HLDA,0)),U,4)="I")
QUIT
+8 IF HLDA
Begin DoDot:2
+9 SET HLDT=+$PIECE($GET(^HL(772,HLDA,0)),"^")
SET HLDT1=$$HLDATE^HLFNC(HLDT)
+10 KILL ^HL(772,HLDA,"IN")
End DoDot:2
+11 IF $DATA(HLMSA)
IF $PIECE(HLMSA,HLFS,3)]""
Begin DoDot:2
+12 SET HLDAI=0
+13 FOR
SET HLDAI=$ORDER(^HL(772,"AH",+$PIECE($GET(HLNDAP0),U,12),$PIECE(HLMSA,HLFS,3),HLDAI))
IF 'HLDAI!($PIECE($GET(^HL(772,+HLDAI,0)),U,4)="O")
QUIT
+14 IF 'HLDAI
KILL HLDAI
End DoDot:2
End DoDot:1
+15 ;
+16 IF 'HLDA
DO CREATE(.HLMID,.HLDA,.HLDT,.HLDT1)
KILL HLZ
+17 ;
+18 DO STUFF^HLTF0("I")
+19 NEW HLAC
SET HLAC=$SELECT($DATA(HLERR):4,1:1)
DO STATUS^HLTF0(HLDA,HLAC,$GET(HLMSG))
+20 ;
+21 DO MERGE15^HLTF1("G",HLDA,"HLR",HLTIME)
+22 ;
+23 IF '$DATA(HLERR)
IF $DATA(HLMSA)
IF $DATA(HLDAI)
Begin DoDot:1
+24 NEW HLAC,HLERR,HLMSG
IF $PIECE(HLMSA,HLFS,4)]""
SET HLERR=$PIECE(HLMSA,HLFS,4)
+25 SET HLAC=$PIECE(HLMSA,HLFS,2)
IF HLAC'="AA"
SET HLMSG=$SELECT(HLAC="AR":"Application Reject",1:"Application Error")_" - "_HLERR
+26 SET HLAC=$SELECT(HLAC'="AA":4,1:3)
DO STATUS^HLTF0(HLDAI,HLAC,$GET(HLMSG))
End DoDot:1
+27 QUIT
+28 ;
ACK(HLMSA,HLIO,HLDA) ;Process 'ACK' Message Type - Version 1.5 Interface Only
+1 ; To determine the correct message to link the ACK, HLIO is used.
+2 ; For an ack from DHCP (original message from remote system) then
+3 ; HLIO should be "I" so that the correct inbound message is ack-ed. For
+4 ; an inbound ack (original message outbound from DHCP) HLIO should be
+5 ; "O". This distinction must be made due to the possible duplicate
+6 ; message ids from a bi-direction interface.
+7 ;
+8 ; Input : MSA - MSA from ACK message.
+9 ; HLIO - Either "I" or "O" : See note above.
+10 ;Output : None
+11 ;
+12 NEW HLAC,HLMIDI
+13 ;-- set up required vars
+14 SET HLAC=$PIECE(HLMSA,HLFS,2)
SET HLMIDI=$PIECE(HLMSA,HLFS,3)
+15 ;-- quit
+16 IF HLMIDI']""!(HLAC']"")!('$DATA(HLNDAP))
QUIT
+17 ;-- find message to ack
+18 IF '$GET(HLDA)
SET HLDA=0
Begin DoDot:1
+19 FOR
SET HLDA=+$ORDER(^HL(772,"AH",+$PIECE($GET(HLNDAP0),U,12),HLMIDI,HLDA))
IF 'HLDA!($PIECE($GET(^HL(772,+HLDA,0)),U,4)=HLIO)
QUIT
End DoDot:1
+20 ;-- quit if no message
+21 IF '$DATA(^HL(772,+HLDA,0))
QUIT
+22 ;-- check for error
+23 IF $PIECE(HLMSA,HLFS,4)]""
NEW HLERR
SET HLERR=$PIECE(HLMSA,HLFS,4)
+24 IF $DATA(HLERR)
IF '$DATA(HLMSG)
NEW HLMSG
SET HLMSG="Error During Receipt of Acknowledgement Message"_$SELECT(HLAC="AR":" - Application Reject",HLAC="AE":" - Application Error",1:"")_" - "_HLERR
+25 ;-- update status
+26 SET HLAC=$SELECT(HLMTN="MCF":2,HLAC'="AA":4,1:3)
+27 DO STATUS^HLTF0(HLDA,HLAC,$GET(HLMSG))
+28 QUIT
+29 ;
STUB772(FLD01,OS) ;
+1 ;This function creates a new stub record in file 772. The Stub record may consist of only the 0 node with a value of "^". If a value is passed in for the .01 field it will be included in the 0 node and its "B" x-ref set.
+2 ;Inputs:
+3 ; OS (optional), the value of ^%ZOSF("OS")
+4 ; FLD01 (optional), the value for the .01 field
+5 ;Output - the function returns the ien of the newly created record
+6 ;
+7 NEW IEN
+8 IF '$LENGTH($GET(OS))
NEW OS
SET OS=$GET(^%ZOSF("OS"))
+9 ;
+10 ; patch HL*1.6*120, protect Else command
+11 ; I OS'["DSM",OS'["OpenM" D
+12 IF OS'["DSM"
IF OS'["OpenM"
Begin DoDot:1
+13 FOR
LOCK +^HLCS(869.3,1,772):10
SET IEN=+$GET(^HLCS(869.3,1,772))+1
SET ^HLCS(869.3,1,772)=IEN
IF $DATA(^HL(772,IEN))
SET IEN=0
SET ^HLCS(869.3,1,772)=($ORDER(^HL(772,":"),-1)\1)
LOCK -^HLCS(869.3,1,772)
IF IEN
QUIT
End DoDot:1
IF 1
+14 IF '$TEST
Begin DoDot:1
+15 FOR
