Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLTF

HLTF.m

Go to the documentation of this file. 
  1. 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
  1. FILE ;Create Entries in files 772 and 773 for Version 1.5 Interface Only
  1.  D CREATE(,.HLDA,.HLDT,.HLDT1)
  1.  Q
  1. CREATE(HLMID,MTIEN,HLDT,HLDT1) ;Create entries in Message Text (#772)
  1.  ;
  1.  ;Input  : HLMID = Variable in which value of message ID will be
  1.  ;                 returned (pass by reference)
  1.  ;         MTIEN = Variable in which IEN of Message Text file entry
  1.  ;                 will be returned (pass by reference)
  1.  ;         HLDT = Variable in which current date/time in FM internal
  1.  ;                format will be returned (pass by reference)
  1.  ;         HLDT1 = Variable in which current date/time in HL7 format
  1.  ;                 will be returned (pass by reference)
  1.  ;
  1.  ;Output : See above
  1.  ;
  1.  ;Notes  : If HLDT has a value [upon entry], the created entries will
  1.  ;         be given that value for their date/time (value of .01)
  1.  ;       : Current date/time used if HLDT is not passed or invalid
  1.  ;
  1.  ;Make entry in Message Administration file
  1.  N Y
  1.  S HLDT=$G(HLDT)
  1.  D MT(.HLDT)
  1.  S Y=$$CHNGMID(MTIEN,.HLMID),HLDT1=$$HLDATE^HLFNC(HLDT)
  1.  Q
  1. TCP(HLMID,MTIEN,HLDT) ;create new message in 772 & 773 entries
  1.  ;used for incoming messages and outgoing responses
  1.  ;Input  : HLMID = Variable in which value of message ID will be
  1.  ;                 returned (pass by reference)
  1.  ;         MTIEN = Variable in which IEN of file 773 entry
  1.  ;                 will be returned (pass by reference)
  1.  ;         HLDT = Variable in which current date/time in FM internal
  1.  ;                format will be returned (pass by reference)
  1.  ;
  1.  S HLDT=$G(HLDT),HLMID=$G(HLMID)
  1.  D MT(.HLDT)
  1.  S MTIEN=$$MA(MTIEN,.HLMID)
  1.  Q
  1.  ;
  1. MT(HLX) ;Create entry in Message Text file (#772)
  1.  ;
  1.  ;Input  : HLX = Date/time entry in file should be given (value of .01)
  1.  ;               Defaults to current date/time
  1.  ;
  1.  ;Output : HLDT = Date/time of created entry (value of .01)
  1.  ;       : HLDT1 = HLDT in HL7 format
  1.  ;
  1.  ;Notes  : HLX must be in FileMan format (default value used if not)
  1.  ;       : HLDT will be in FileMan format
  1.  ;       : MTIEN is ien in file 772
  1.  ;
  1.  ;Check for input
  1.  S HLX=$G(HLX)
  1.  ;Declare variables
  1.  N DIC,DD,DO,HLCNT,HLJ,X,Y
  1.  F HLCNT=0:1 D  Q:Y>0  H HLCNT
  1.  . I (HLX'?7N.1".".6N) S HLX=$$NOW^XLFDT
  1.  . S DIC="^HL(772,",DIC(0)="L",(HLDT,X)=HLX
  1.  . S Y=$$STUB772(X) ; This call substituted for D FILE^DICN by HL*1.6*109
  1.  . ;Entry not created - try again
  1.  . I Y<0 S HLX="" Q
  1.  . S MTIEN=+Y
  1.  ;***If we didn't get a record in 772, need to do something
  1.  I Y<0 Q
  1.  S HLDT1=$$HLDATE^HLFNC(HLDT)
  1.  Q
  1.  ;add to Message Admin file #773
  1. MA(X,HLMID) ;X=ien in file 772, HLMID=msg. id (passed by ref.)
  1.  ;return ien in file 773
  1.  Q:'$G(^HL(772,X,0)) 0
  1.  N DA,DD,DO,DIC,DIE,DR,HLDA,HLCNT,HLJ,Y
  1.  S DIC="^HLMA(",DIC(0)="L"
  1.  F HLCNT=0:1 D  Q:Y>0  H HLCNT
  1.  . S Y=$$STUB773(X) ; This call substituted for D FILE^DICN by HL*1.6*109
  1.  ;***If we didn't get a record in 773, need to do something
  1.  I Y<0 Q 0
  1.  S HLDA=+Y,HLMID=$$MAID(HLDA,$G(HLMID))
  1.  Q HLDA
  1.  ;
  1. MAID(Y,HLMID) ;Determine message ID (if needed) & store message ID
  1.  ;Y=ien in 773, HLMID=id,  Output message id
  1.  N HLJ
  1.  ;need to have id contain institution number to make unique
  1.  S:$G(HLMID)="" HLMID=+$P($$PARAM^HLCS2,U,6)_Y
  1.  S HLJ(773,Y_",",2)=HLMID
  1.  D FILE^HLDIE("","HLJ","","MAID","HLTF") ;HL*1.6*109
  1.  Q HLMID
  1.  ;
  1. CHNGMID(PTRMT,NEWID) ;Change message ID for entry in Message Text file
  1.  ;Input  : PTRMT - Pointer to entry in Message Text file (#772)
  1.  ;         NEWID - New message ID
  1.  ;Output : 0 = Success
  1.  ;         -1^ErrorText = Error/Bad input
  1.  ;
  1.  ;Check input
  1.  S PTRMT=+$G(PTRMT)
  1.  S NEWID=$G(NEWID)
  1.  Q:('$D(^HL(772,PTRMT,0))) "-1^Did not pass valid pointer to Message Text file (#772)"
  1.  N HLJ
  1.  I $G(NEWID)="" S NEWID=+$P($$PARAM^HLCS2,U,6)_PTRMT
  1.  S HLJ(772,PTRMT_",",6)=NEWID
  1.  D FILE^HLDIE("","HLJ","","CHNGMID","HLTF") ; HL*1.6*109
  1.  Q 0
  1.  ;
  1. OUT(HLDA,HLMID,HLMTN) ;File Data in Message Text File for Outgoing Message
  1.  ;Version 1.5 Interface Only
  1.  Q:'$D(HLFS)
  1.  ;
  1.  I HLMTN="ACK"!(HLMTN="MCF")!(HLMTN="ORR") Q:'$D(HLMSA)  D ACK(HLMSA,"I") Q
  1.  ;
  1.  ;-- if message contained MSA find inbound message
  1.  I $D(HLMSA),$D(HLNDAP),$P(HLMSA,HLFS,3)]"" D
  1.  . N HLDAI
  1.  . S HLDAI=0
  1.  . 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")
  1.  . I 'HLDAI K HLDAI
  1.  ;
  1.  D STUFF^HLTF0("O")
  1.  ;
  1.  N HLAC S HLAC=$S($D(HLERR):4,'$P(HLNDAP0,"^",10):1,1:2) D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
  1.  D:$D(HLCHAR) STATS^HLTF0(HLDA,HLCHAR,$G(HLEVN))
  1.  ;
  1.  ;-- update status if MSA and found inbound message
  1.  I $D(HLMSA),$D(HLDAI) D
  1.  .N HLERR,HLMSG I $P(HLMSA,HLFS,4)]"" S HLERR=$P(HLMSA,HLFS,4)
  1.  .S HLAC=$P(HLMSA,HLFS,2)
  1.  .I HLAC'="AA" S HLMSG=$S(HLAC="AR":"Application Reject",HLAC="AE":"Application Error",1:"")_" - "_HLERR
  1.  .S HLAC=$S(HLAC'="AA":4,1:3) D STATUS^HLTF0(HLDAI,HLAC,$G(HLMSG))
  1.  Q
  1.  ;
  1. IN(HLMTN,HLMID,HLTIME) ;File Data in Message Text File for Incoming Message
  1.  ;Version 1.5 Interface Only
  1.  Q:'$D(HLFS)
  1.  I HLMTN="ACK"!(HLMTN="MCF")!(HLMTN="ORR") Q:'$D(HLMSA)  D ACK(HLMSA,"O",$G(HLDA)) Q
  1.  ;
  1.  N HLDAI S HLDA=0
  1.  I $D(HLNDAP),HLMID]"" D
  1.  .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")
  1.  .I HLDA D
  1.  ..S HLDT=+$P($G(^HL(772,HLDA,0)),"^"),HLDT1=$$HLDATE^HLFNC(HLDT)
  1.  ..K ^HL(772,HLDA,"IN")
  1.  .I $D(HLMSA),$P(HLMSA,HLFS,3)]"" D
  1.  ..S HLDAI=0
  1.  ..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")
  1.  ..I 'HLDAI K HLDAI
  1.  ;
  1.  I 'HLDA D CREATE(.HLMID,.HLDA,.HLDT,.HLDT1) K HLZ
  1.  ;
  1.  D STUFF^HLTF0("I")
  1.  N HLAC S HLAC=$S($D(HLERR):4,1:1) D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
  1.  ;
  1.  D MERGE15^HLTF1("G",HLDA,"HLR",HLTIME)
  1.  ;
  1.  I '$D(HLERR),$D(HLMSA),$D(HLDAI) D
  1.  .N HLAC,HLERR,HLMSG I $P(HLMSA,HLFS,4)]"" S HLERR=$P(HLMSA,HLFS,4)
  1.  .S HLAC=$P(HLMSA,HLFS,2) I HLAC'="AA" S HLMSG=$S(HLAC="AR":"Application Reject",1:"Application Error")_" - "_HLERR
  1.  .S HLAC=$S(HLAC'="AA":4,1:3) D STATUS^HLTF0(HLDAI,HLAC,$G(HLMSG))
  1.  Q
  1.  ;
  1. 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.
  1.  ; For an ack from DHCP (original message from remote system) then
  1.  ; HLIO should be "I" so that the correct inbound message is ack-ed. For
  1.  ; an inbound ack (original message outbound from DHCP) HLIO should be
  1.  ; "O". This distinction must be made due to the possible duplicate
  1.  ; message ids from a bi-direction interface.
  1.  ;
  1.  ; Input : MSA - MSA from ACK message.
  1.  ;         HLIO - Either "I" or "O" : See note above.
  1.  ;Output : None
  1.  ;
  1.  N HLAC,HLMIDI
  1.  ;-- set up required vars
  1.  S HLAC=$P(HLMSA,HLFS,2),HLMIDI=$P(HLMSA,HLFS,3)
  1.  ;-- quit
  1.  Q:HLMIDI']""!(HLAC']"")!('$D(HLNDAP))
  1.  ;-- find message to ack
  1.  I '$G(HLDA) S HLDA=0 D
  1.  . 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)
  1.  ;-- quit if no message
  1.  Q:'$D(^HL(772,+HLDA,0))
  1.  ;-- check for error
  1.  I $P(HLMSA,HLFS,4)]"" N HLERR S HLERR=$P(HLMSA,HLFS,4)
  1.  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
  1.  ;-- update status
  1.  S HLAC=$S(HLMTN="MCF":2,HLAC'="AA":4,1:3)
  1.  D STATUS^HLTF0(HLDA,HLAC,$G(HLMSG))
  1.  Q
  1.  ;
  1. 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.
  1.  ;Inputs:
  1.  ;  OS (optional), the value of ^%ZOSF("OS")
  1.  ;  FLD01 (optional), the value for the .01 field
  1.  ;Output - the function returns the ien of the newly created record
  1.  ;
  1.  N IEN
  1.  I '$L($G(OS)) N OS S OS=$G(^%ZOSF("OS"))
  1.  ;
  1.  ; patch HL*1.6*120, protect Else command
  1.  ; I OS'["DSM",OS'["OpenM" D
  1.  I OS'["DSM",OS'["OpenM" D  I 1
  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
  1.  E  D
  1.  .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
  1.  S ^HL(772,IEN,0)=$G(FLD01)_"^"
  1.  I $L($G(FLD01)) S ^HL(772,"B",FLD01,IEN)=""
  1.  Q IEN
  1.  ;
  1. STUB773(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.
  1.  ;Inputs:
  1.  ;  OS (optional), the value of ^%ZOSF("OS")
  1.  ;  FLD01 (optional), the value for the .01 field
  1.  ;Output - the function returns the ien of the newly created record
  1.  ;
  1.  N IEN
  1.  I '$L($G(OS)) N OS S OS=$G(^%ZOSF("OS"))
  1.  ;
  1.  ; patch HL*1.6*120, protect Else command
  1.  ; I OS'["DSM",OS'["OpenM" D
  1.  I OS'["DSM",OS'["OpenM" D  I 1
  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
  1.  E  D
  1.  .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
  1.  S ^HLMA(IEN,0)=$G(FLD01)_"^"
  1.  I $L($G(FLD01)) S ^HLMA("B",FLD01,IEN)=""
  1.  Q IEN