PRCHJS04 ;OI&T/KCL - IFCAP/ECMS INTERFACE 2237 MSG BUILD SEND;7/2/12
;;5.1;IFCAP;**167**;Oct 20, 2000;Build 17
;Per VHA Directive 2004-38, this routine should not be modified.
;
OMNO07(PRCWRK,PRCER) ;Build/Send HL7 OMN^O07 message
;This function builds a single HL7 OMN^O07 message containing a
;2237 transaction and queues it for transmission to eCMS using HLO APIs.
;
; Supported ICR:
; #5818 - Obtain the TCP/IP PORT (OPTIMIZED) field for a record
; in the HL LOGICAL LINK (#870) file using $$PORT2^HLOTLNK.
;
; Input:
; PRCWRK - (required) name of work global containing 2237 data elements
;
; Output:
; Function value - on success, returns IEN of the message in the HLO
; MESSAGES (#778) file. Returns 0 on failure.
; PRCER - (optional) on failure, an error message is returned,
; pass by ref
;
N PRCPARMS ;HLO input parameters
N PRCWHOTO ;HLO send to parameters
N PRCMSG ;HLO workspace used to build message
N PRCIDX ;line items subscript
N PRCRSLT ;function result
;
S PRCRSLT=0
;
;start building a single HL7 msg
S PRCPARMS("MESSAGE TYPE")="OMN"
S PRCPARMS("EVENT")="O07"
S PRCPARMS("FIELD SEPARATOR")="|"
S PRCPARMS("ENCODING CHARACTERS")="^~\&"
S PRCPARMS("MESSAGE STRUCTURE")="OMN_O07"
S PRCPARMS("VERSION")=2.5
S PRCPARMS("ACCEPT ACK TYPE")="AL" ;commit ACKs are required to be returned
S PRCPARMS("APP ACK TYPE")="AL" ;application ACKs are required to be returned
S PRCPARMS("SENDING APPLICATION")="PRCHJ_IFCAP_2237_SEND"
I '$$NEWMSG^HLOAPI(.PRCPARMS,.PRCMSG,.PRCER) Q PRCRSLT
;
;build NTE segs for 2237 Special Remarks, Justification, and Comments
I '$$NTE^PRCHJS06(PRCWRK,.PRCMSG,.PRCER) Q PRCRSLT
;
;loop thru 2237 line items and build the optional Order Group segs:
; {(ORDER)ORC,{[TQ1]}RQD,RQ1,[ZA1],{NTE}}
S PRCIDX=0
F S PRCIDX=$O(@PRCWRK@(PRCIDX)) Q:'(+$G(PRCIDX))!($G(PRCER)]"") D
. ;
. ;build ORC seg
. I '$$ORC^PRCHJS05(PRCWRK,.PRCMSG,.PRCER) Q
. ;
. ;if delivery schedule(s) for item, build TQ1 seg(s)
. I $O(@PRCWRK@(PRCIDX,0)) D
. . I '$$TQ1^PRCHJS05(PRCWRK,.PRCMSG,PRCIDX,.PRCER) Q
. Q:$G(PRCER)]""
. ;
. ;build RQD seg
. I '$$RQD^PRCHJS05(PRCWRK,.PRCMSG,PRCIDX,.PRCER) Q
. ;
. ;build RQ1 seg
. I '$$RQ1^PRCHJS05(PRCWRK,.PRCMSG,PRCIDX,.PRCER) Q
. ;
. ;build ZA1 seg
. I '$$ZA1^PRCHJS05(PRCWRK,.PRCMSG,PRCIDX,.PRCER) Q
. ;
. ;build NTE seg(s)
. I '$$NTEITEM^PRCHJS05(PRCWRK,.PRCMSG,PRCIDX,.PRCER) Q
;
;quit if error encountered building Order Group segs
Q:$G(PRCER)]"" PRCRSLT
;
;build ZZ1 seg
I '$$ZZ1^PRCHJS06(PRCWRK,.PRCMSG,.PRCER) Q PRCRSLT
;
;build ZZ2 seg
I '$$ZZ2^PRCHJS06(PRCWRK,.PRCMSG,.PRCER) Q PRCRSLT
;
;build ZZ3 seg
I '$$ZZ3^PRCHJS06(PRCWRK,.PRCMSG,.PRCER) Q PRCRSLT
;
;send a single HL7 msg
S PRCWHOTO("RECEIVING APPLICATION")="PRCHJ_ECMS_2237_SEND"
S PRCWHOTO("STATION NUMBER")=200 ;allow VIE box to route msg to Austin (eCMS)
;set these 2 params to allow HLO to send msg to VIE box
S PRCWHOTO("MIDDLEWARE LINK NAME")="PRCHJ_ECMS" ;name of logical link for the interface engine
S PRCWHOTO("PORT")=$$PORT2^HLOTLNK("PRCHJ_ECMS") ;get port from logical link record
I PRCWHOTO("PORT")']"" S PRCER="Unable to obtain HLO port from logical link record" Q PRCRSLT
S PRCRSLT=$$SENDONE^HLOAPI1(.PRCMSG,.PRCPARMS,.PRCWHOTO,.PRCER) ;returns msg ien, 0 on failure
;
Q PRCRSLT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHJS04 3465 printed Apr 09, 2024@21:08 Page 2
PRCHJS04 ;OI&T/KCL - IFCAP/ECMS INTERFACE 2237 MSG BUILD SEND;7/2/12
+1 ;;5.1;IFCAP;**167**;Oct 20, 2000;Build 17
+2 ;Per VHA Directive 2004-38, this routine should not be modified.
+3 ;
OMNO07(PRCWRK,PRCER) ;Build/Send HL7 OMN^O07 message
+1 ;This function builds a single HL7 OMN^O07 message containing a
+2 ;2237 transaction and queues it for transmission to eCMS using HLO APIs.
+3 ;
+4 ; Supported ICR:
+5 ; #5818 - Obtain the TCP/IP PORT (OPTIMIZED) field for a record
+6 ; in the HL LOGICAL LINK (#870) file using $$PORT2^HLOTLNK.
+7 ;
+8 ; Input:
+9 ; PRCWRK - (required) name of work global containing 2237 data elements
+10 ;
+11 ; Output:
+12 ; Function value - on success, returns IEN of the message in the HLO
+13 ; MESSAGES (#778) file. Returns 0 on failure.
+14 ; PRCER - (optional) on failure, an error message is returned,
+15 ; pass by ref
+16 ;
+17 ;HLO input parameters
NEW PRCPARMS
+18 ;HLO send to parameters
NEW PRCWHOTO
+19 ;HLO workspace used to build message
NEW PRCMSG
+20 ;line items subscript
NEW PRCIDX
+21 ;function result
NEW PRCRSLT
+22 ;
+23 SET PRCRSLT=0
+24 ;
+25 ;start building a single HL7 msg
+26 SET PRCPARMS("MESSAGE TYPE")="OMN"
+27 SET PRCPARMS("EVENT")="O07"
+28 SET PRCPARMS("FIELD SEPARATOR")="|"
+29 SET PRCPARMS("ENCODING CHARACTERS")="^~\&"
+30 SET PRCPARMS("MESSAGE STRUCTURE")="OMN_O07"
+31 SET PRCPARMS("VERSION")=2.5
+32 ;commit ACKs are required to be returned
SET PRCPARMS("ACCEPT ACK TYPE")="AL"
+33 ;application ACKs are required to be returned
SET PRCPARMS("APP ACK TYPE")="AL"
+34 SET PRCPARMS("SENDING APPLICATION")="PRCHJ_IFCAP_2237_SEND"
+35 IF '$$NEWMSG^HLOAPI(.PRCPARMS,.PRCMSG,.PRCER)
QUIT PRCRSLT
+36 ;
+37 ;build NTE segs for 2237 Special Remarks, Justification, and Comments
+38 IF '$$NTE^PRCHJS06(PRCWRK,.PRCMSG,.PRCER)
QUIT PRCRSLT
+39 ;
+40 ;loop thru 2237 line items and build the optional Order Group segs:
+41 ; {(ORDER)ORC,{[TQ1]}RQD,RQ1,[ZA1],{NTE}}
+42 SET PRCIDX=0
+43 FOR
SET PRCIDX=$ORDER(@PRCWRK@(PRCIDX))
if '(+$GET(PRCIDX))!($GET(PRCER)]"")
QUIT
Begin DoDot:1
+44 ;
+45 ;build ORC seg
+46 IF '$$ORC^PRCHJS05(PRCWRK,.PRCMSG,.PRCER)
QUIT
+47 ;
+48 ;if delivery schedule(s) for item, build TQ1 seg(s)
+49 IF $ORDER(@PRCWRK@(PRCIDX,0))
Begin DoDot:2
+50 IF '$$TQ1^PRCHJS05(PRCWRK,.PRCMSG,PRCIDX,.PRCER)
QUIT
End DoDot:2
+51 if $GET(PRCER)]""
QUIT
+52 ;
+53 ;build RQD seg
+54 IF '$$RQD^PRCHJS05(PRCWRK,.PRCMSG,PRCIDX,.PRCER)
QUIT
+55 ;
+56 ;build RQ1 seg
+57 IF '$$RQ1^PRCHJS05(PRCWRK,.PRCMSG,PRCIDX,.PRCER)
QUIT
+58 ;
+59 ;build ZA1 seg
+60 IF '$$ZA1^PRCHJS05(PRCWRK,.PRCMSG,PRCIDX,.PRCER)
QUIT
+61 ;
+62 ;build NTE seg(s)
+63 IF '$$NTEITEM^PRCHJS05(PRCWRK,.PRCMSG,PRCIDX,.PRCER)
QUIT
End DoDot:1
+64 ;
+65 ;quit if error encountered building Order Group segs
+66 if $GET(PRCER)]""
QUIT PRCRSLT
+67 ;
+68 ;build ZZ1 seg
+69 IF '$$ZZ1^PRCHJS06(PRCWRK,.PRCMSG,.PRCER)
QUIT PRCRSLT
+70 ;
+71 ;build ZZ2 seg
+72 IF '$$ZZ2^PRCHJS06(PRCWRK,.PRCMSG,.PRCER)
QUIT PRCRSLT
+73 ;
+74 ;build ZZ3 seg
+75 IF '$$ZZ3^PRCHJS06(PRCWRK,.PRCMSG,.PRCER)
QUIT PRCRSLT
+76 ;
+77 ;send a single HL7 msg
+78 SET PRCWHOTO("RECEIVING APPLICATION")="PRCHJ_ECMS_2237_SEND"
+79 ;allow VIE box to route msg to Austin (eCMS)
SET PRCWHOTO("STATION NUMBER")=200
+80 ;set these 2 params to allow HLO to send msg to VIE box
+81 ;name of logical link for the interface engine
SET PRCWHOTO("MIDDLEWARE LINK NAME")="PRCHJ_ECMS"
+82 ;get port from logical link record
SET PRCWHOTO("PORT")=$$PORT2^HLOTLNK("PRCHJ_ECMS")
+83 IF PRCWHOTO("PORT")']""
SET PRCER="Unable to obtain HLO port from logical link record"
QUIT PRCRSLT
+84 ;returns msg ien, 0 on failure
SET PRCRSLT=$$SENDONE^HLOAPI1(.PRCMSG,.PRCPARMS,.PRCWHOTO,.PRCER)
+85 ;
+86 QUIT PRCRSLT
