- HLTP1 ;AISC/SAW-Transaction Processor Module (Cont'd) ;09/13/2006
- ;;1.6;HEALTH LEVEL SEVEN;**34,47,91,133**;Oct 13, 1995;Build 13
- ;Per VHA Directive 2004-038, this routine should not be modified.
- GENACK(HLMIDA,HLMTIENA,HLEIDS,HLARYTYP,HLFORMAT,HLRESLTA,HLP) ;
- ;Entry point to generate an acknowledgement message
- ;
- ;This is a subroutine call with parameter passing. It returns a value
- ;in the variable HLRESLTA of null if no error occurs, or the following
- ;two piece value if an error occurs: error code^error description
- ;
- ;Required Input Parameters
- ; HLMIDA = Message ID of aknowledgement message
- ; HLMTIENA = IEN of entry in Message Text file where acknowledgement
- ; message will be stored
- ; HLEIDS = IEN of subscriber protocol from the Protocol file
- ; HLARYTYP = Array type. One of the following codes:
- ; LM = local array containing a single message
- ; LB = local array containig a batch of messages
- ; GM = global array containing a single message
- ; GB = global array containing a batch of messages
- ; HLFORMAT = Format of array, 1 for pre-formatted in HL7 format,
- ; otherwise 0
- ;NOTE: The variable HLRESLTA must be passed by reference
- ; HLRESLTA = The variable that will be returned to the calling
- ; application as descibed above
- ;Optional Parameters
- ; HLP("SECURITY") = A 1 to 40 character string
- ; HLP("GROUTINE") = The M code to execute to generate the
- ; acknowledgement message
- ; HLP("MSACK") = 1 if this acknowledgment message is being
- ; generated by the Messaging System
- ; HLP("NAMESPACE") = Passed in by application namespace - HL*1.6*91
- ;
- S HLRESLTA=""
- ;
- ;Check for required parameters
- I '$G(HLMIDA)!('$G(HLMTIENA))!('$G(HLEIDS))!($G(HLARYTYP)']"")!($G(HLFORMAT)']"") S HLRESLTA="7^"_$G(^HL(771.7,7,0))_" at GENACK^HLTP1 entry point" G EXIT
- ;Extract data from file 101 and store in separate variables
- D EVENT^HLUTIL1(HLEIDS,770,.HLN)
- S HLSAN=$P($G(^HL(771,+$P(HLN(770),"^",2),0)),"^"),HLQ=""""""
- S HLP("MSGTYPE")=$E(HLARYTYP,2)
- ;Update zero node of Message Text file
- D UPDATE^HLTF0(HLMTIENA,HLP("MTIENS"),"O",HLEIDS,"",$P(HLN(770),"^",2),"",$P($G(^HL(772,HLP("MTIENS"),0)),"^",8),"",.HLP)
- ;Update status to Being Generated
- D STATUS^HLTF0(HLMTIENA,8)
- ;Check that local/global array exists and store in Message Text file
- ; if pre-compiled
- I HLFORMAT D I (+$G(HLRESLTA)) D STATUS^HLTF0(HLMTIENA,4,+HLRESLTA) G EXIT
- .I $E(HLARYTYP)="G" D
- ..I $O(^TMP("HLA",$J,0))']"" S HLRESLTA="8^"_$G(^HL(771.7,8,0)) Q
- ..D MERGE^HLTF1("G",HLMTIENA,"HLA")
- .I $E(HLARYTYP)="L" D
- ..I $O(HLA("HLA",0))']"" S HLRESLTA="8^"_$G(^HL(771.7,8,0)) Q
- ..D MERGE^HLTF1("L",HLMTIENA,"HLA")
- ;If array is not pre-compiled, call message generation routine
- I 'HLFORMAT N HLERR D I $D(HLERR) S HLRESLTA="9^"_HLERR D STATUS^HLTF0(HLMTIENA,4,9,HLERR) G EXIT
- .S HLP("GROUTINE")=HLP("GROUTINE")_"("_HLMIDA_","_HLMTIENA_","_HLQ_HLARYTYP_HLQ_","_HLSAN_","_$P($G(^HL(771.2,$P(HLN(770),"^",3),0)),"^")_","_$P($G(^HL(779.001,$P(HLN(770),"^",4),0)),"^")_","_HLQ_$TR($P(HLN(770),"^",6),"id","ID")_HLQ_")"
- .X HLP("GROUTINE")
- ;Invoke communication server module to send message to subscribers
- K HLARYTYP,HLFORMAT,HLQ
- D SENDACK^HLCS(HLMTIENA,HLP("EID"),HLEIDS,.HLRESLTA) ;,$G(HLP("MSACK")))
- EXIT K HLQ,HLSAN
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLTP1 3452 printed Feb 18, 2025@23:26:23 Page 2
- HLTP1 ;AISC/SAW-Transaction Processor Module (Cont'd) ;09/13/2006
- +1 ;;1.6;HEALTH LEVEL SEVEN;**34,47,91,133**;Oct 13, 1995;Build 13
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- GENACK(HLMIDA,HLMTIENA,HLEIDS,HLARYTYP,HLFORMAT,HLRESLTA,HLP) ;
- +1 ;Entry point to generate an acknowledgement message
- +2 ;
- +3 ;This is a subroutine call with parameter passing. It returns a value
- +4 ;in the variable HLRESLTA of null if no error occurs, or the following
- +5 ;two piece value if an error occurs: error code^error description
- +6 ;
- +7 ;Required Input Parameters
- +8 ; HLMIDA = Message ID of aknowledgement message
- +9 ; HLMTIENA = IEN of entry in Message Text file where acknowledgement
- +10 ; message will be stored
- +11 ; HLEIDS = IEN of subscriber protocol from the Protocol file
- +12 ; HLARYTYP = Array type. One of the following codes:
- +13 ; LM = local array containing a single message
- +14 ; LB = local array containig a batch of messages
- +15 ; GM = global array containing a single message
- +16 ; GB = global array containing a batch of messages
- +17 ; HLFORMAT = Format of array, 1 for pre-formatted in HL7 format,
- +18 ; otherwise 0
- +19 ;NOTE: The variable HLRESLTA must be passed by reference
- +20 ; HLRESLTA = The variable that will be returned to the calling
- +21 ; application as descibed above
- +22 ;Optional Parameters
- +23 ; HLP("SECURITY") = A 1 to 40 character string
- +24 ; HLP("GROUTINE") = The M code to execute to generate the
- +25 ; acknowledgement message
- +26 ; HLP("MSACK") = 1 if this acknowledgment message is being
- +27 ; generated by the Messaging System
- +28 ; HLP("NAMESPACE") = Passed in by application namespace - HL*1.6*91
- +29 ;
- +30 SET HLRESLTA=""
- +31 ;
- +32 ;Check for required parameters
- +33 IF '$GET(HLMIDA)!('$GET(HLMTIENA))!('$GET(HLEIDS))!($GET(HLARYTYP)']"")!($GET(HLFORMAT)']"")
- SET HLRESLTA="7^"_$GET(^HL(771.7,7,0))_" at GENACK^HLTP1 entry point"
- GOTO EXIT
- +34 ;Extract data from file 101 and store in separate variables
- +35 DO EVENT^HLUTIL1(HLEIDS,770,.HLN)
- +36 SET HLSAN=$PIECE($GET(^HL(771,+$PIECE(HLN(770),"^",2),0)),"^")
- SET HLQ=""""""
- +37 SET HLP("MSGTYPE")=$EXTRACT(HLARYTYP,2)
- +38 ;Update zero node of Message Text file
- +39 DO UPDATE^HLTF0(HLMTIENA,HLP("MTIENS"),"O",HLEIDS,"",$PIECE(HLN(770),"^",2),"",$PIECE($GET(^HL(772,HLP("MTIENS"),0)),"^",8),"",.HLP)
- +40 ;Update status to Being Generated
- +41 DO STATUS^HLTF0(HLMTIENA,8)
- +42 ;Check that local/global array exists and store in Message Text file
- +43 ; if pre-compiled
- +44 IF HLFORMAT
- Begin DoDot:1
- +45 IF $EXTRACT(HLARYTYP)="G"
- Begin DoDot:2
- +46 IF $ORDER(^TMP("HLA",$JOB,0))']""
- SET HLRESLTA="8^"_$GET(^HL(771.7,8,0))
- QUIT
- +47 DO MERGE^HLTF1("G",HLMTIENA,"HLA")
- End DoDot:2
- +48 IF $EXTRACT(HLARYTYP)="L"
- Begin DoDot:2
- +49 IF $ORDER(HLA("HLA",0))']""
- SET HLRESLTA="8^"_$GET(^HL(771.7,8,0))
- QUIT
- +50 DO MERGE^HLTF1("L",HLMTIENA,"HLA")
- End DoDot:2
- End DoDot:1
- IF (+$GET(HLRESLTA))
- DO STATUS^HLTF0(HLMTIENA,4,+HLRESLTA)
- GOTO EXIT
- +51 ;If array is not pre-compiled, call message generation routine
- +52 IF 'HLFORMAT
- NEW HLERR
- Begin DoDot:1
- +53 SET HLP("GROUTINE")=HLP("GROUTINE")_"("_HLMIDA_","_HLMTIENA_","_HLQ_HLARYTYP_HLQ_","_HLSAN_","_$PIECE($GET(^HL(771.2,$PIECE(HLN(770),"^",3),0)),"^")_","_$PIECE(...
- ... $GET(^HL(779.001,$PIECE(HLN(770),"^",4),0)),"^")_","_HLQ_$TRANSLATE($PIECE(HLN(770),"^",6),"id","ID")_HLQ_")"
- +54 XECUTE HLP("GROUTINE")
- End DoDot:1
- IF $DATA(HLERR)
- SET HLRESLTA="9^"_HLERR
- DO STATUS^HLTF0(HLMTIENA,4,9,HLERR)
- GOTO EXIT
- +55 ;Invoke communication server module to send message to subscribers
- +56 KILL HLARYTYP,HLFORMAT,HLQ
- +57 ;,$G(HLP("MSACK")))
- DO SENDACK^HLCS(HLMTIENA,HLP("EID"),HLEIDS,.HLRESLTA)
- EXIT KILL HLQ,HLSAN
- +1 QUIT