- HLTF ;AISC/SAW,JRP-Create/Process Message Text File Entries ;08/05/2011 14:37
- ;;1.6;HEALTH LEVEL SEVEN;**1,19,43,55,109,120,122,142,157**;Oct 13, 1995;Build 8
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- Q
- ;
- 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
- ;
- ; patch HL*1.6*122: MPI-client/server start
- F L +^HL(772,+$G(X)):10 Q:$T H 1
- ; patch HL*1.6*142: MPI-client/server start
- N COUNT,FLAG
- S FLAG=0
- F COUNT=1:1:15 D Q:FLAG H COUNT
- . Q:'($D(^HL(772,X,0))#2)
- . Q:($G(^HL(772,X,0))']"")
- . S FLAG=1
- ; patch HL*1.6*142: MPI-client/server end
- Q:'$G(^HL(772,X,0)) 0
- L -^HL(772,+$G(X))
- ; patch HL*1.6*122: MPI-client/server end
- ;
- 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
- ;
- ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
- ; OUT, IN, and ACK to HLTF2 routine.
- ;
- D OUT^HLTF2($G(HLDA),$G(HLMID),$G(HLMTN))
- Q
- ;
- IN(HLMTN,HLMID,HLTIME) ;File Data in Message Text File for Incoming Message
- ;Version 1.5 Interface Only
- ;
- ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
- ; OUT, IN, and ACK to HLTF2 routine.
- ;
- D IN^HLTF2($G(HLMTN),$G(HLMID),$G(HLTIME))
- Q
- ;
- ACK(HLMSA,HLIO,HLDA) ;Process 'ACK' Message Type - Version 1.5 Interface Only
- ;
- ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
- ; OUT, IN, and ACK to HLTF2 routine.
- ;
- D ACK^HLTF2($G(HLMSA),$G(HLIO),$G(HLDA))
- 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*157 start, supports Linux/xinetd
- N HLOSYS
- S HLOSYS=$$OS^%ZOSV
- ; I OS'["DSM",OS'["OpenM" D
- I OS'["DSM",(OS'["OpenM")!((OS["OpenM")&(HLOSYS'["VMS")&(HLOSYS'["UNIX")) D
- .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
- ;
- ; patch HL*1.6*122: MPI-client/server start
- F L +^HL(772,IEN):10 Q:$T H 1
- S ^HL(772,IEN,0)=$G(FLD01)_"^"
- I $L($G(FLD01)) S ^HL(772,"B",FLD01,IEN)=""
- L -^HL(772,IEN)
- ; patch HL*1.6*122: MPI-client/server end
- ;
- 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*157 start, supports Linux/xinetd
- N HLOSYS
- S HLOSYS=$$OS^%ZOSV
- ; I OS'["DSM",OS'["OpenM" D
- I OS'["DSM",(OS'["OpenM")!((OS["OpenM")&(HLOSYS'["VMS")&(HLOSYS'["UNIX")) D
- .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
- ;
- ; patch HL*1.6*122: MPI-client/server start
- F L +^HLMA(IEN):10 Q:$T H 1
- S ^HLMA(IEN,0)=$G(FLD01)_"^"
- I $L($G(FLD01)) S ^HLMA("B",FLD01,IEN)=""
- L -^HLMA(IEN)
- ; patch HL*1.6*122: MPI-client/server end
- ;
- Q IEN
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLTF 7660 printed Feb 18, 2025@23:26:16 Page 2
- HLTF ;AISC/SAW,JRP-Create/Process Message Text File Entries ;08/05/2011 14:37
- +1 ;;1.6;HEALTH LEVEL SEVEN;**1,19,43,55,109,120,122,142,157**;Oct 13, 1995;Build 8
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 QUIT
- +5 ;
- 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 ;
- +3 ; patch HL*1.6*122: MPI-client/server start
- +4 FOR
- LOCK +^HL(772,+$GET(X)):10
- if $TEST
- QUIT
- HANG 1
- +5 ; patch HL*1.6*142: MPI-client/server start
- +6 NEW COUNT,FLAG
- +7 SET FLAG=0
- +8 FOR COUNT=1:1:15
- Begin DoDot:1
- +9 if '($DATA(^HL(772,X,0))#2)
- QUIT
- +10 if ($GET(^HL(772,X,0))']"")
- QUIT
- +11 SET FLAG=1
- End DoDot:1
- if FLAG
- QUIT
- HANG COUNT
- +12 ; patch HL*1.6*142: MPI-client/server end
- +13 if '$GET(^HL(772,X,0))
- QUIT 0
- +14 LOCK -^HL(772,+$GET(X))
- +15 ; patch HL*1.6*122: MPI-client/server end
- +16 ;
- +17 NEW DA,DD,DO,DIC,DIE,DR,HLDA,HLCNT,HLJ,Y
- +18 SET DIC="^HLMA("
- SET DIC(0)="L"
- +19 FOR HLCNT=0:1
- Begin DoDot:1
- +20 ; 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
- +21 ;***If we didn't get a record in 773, need to do something
- +22 IF Y<0
- QUIT 0
- +23 SET HLDA=+Y
- SET HLMID=$$MAID(HLDA,$GET(HLMID))
- +24 QUIT HLDA
- +25 ;
- 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 ;
- +3 ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
- +4 ; OUT, IN, and ACK to HLTF2 routine.
- +5 ;
- +6 DO OUT^HLTF2($GET(HLDA),$GET(HLMID),$GET(HLMTN))
- +7 QUIT
- +8 ;
- IN(HLMTN,HLMID,HLTIME) ;File Data in Message Text File for Incoming Message
- +1 ;Version 1.5 Interface Only
- +2 ;
- +3 ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
- +4 ; OUT, IN, and ACK to HLTF2 routine.
- +5 ;
- +6 DO IN^HLTF2($GET(HLMTN),$GET(HLMID),$GET(HLTIME))
- +7 QUIT
- +8 ;
- ACK(HLMSA,HLIO,HLDA) ;Process 'ACK' Message Type - Version 1.5 Interface Only
- +1 ;
- +2 ; patch HL*1.6*122: HLTF routine splitted, moves sub-routines,
- +3 ; OUT, IN, and ACK to HLTF2 routine.
- +4 ;
- +5 DO ACK^HLTF2($GET(HLMSA),$GET(HLIO),$GET(HLDA))
- +6 QUIT
- +7 ;
- 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 ; patch HL*1.6*157 start, supports Linux/xinetd
- +10 NEW HLOSYS
- +11 SET HLOSYS=$$OS^%ZOSV
- +12 ; I OS'["DSM",OS'["OpenM" D
- +13 IF OS'["DSM"
- IF (OS'["OpenM")!((OS["OpenM")&(HLOSYS'["VMS")&(HLOSYS'["UNIX"))
- Begin DoDot:1
- +14 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
- +15 IF '$TEST
- Begin DoDot:1
- +16 FOR