MPIFRTC ;ALB/JRP-GET ICN FROM MPI USING REAL TIME CONNECTION ;21-JAN-1997
;;1.0; MASTER PATIENT INDEX VISTA ;**1**;30 Apr 99
;
GETICN(DFN) ;Get ICN from MPI using real time connection
;
;Input : DFN - Pointer to entry in PATIENT file (#2)
;Output : ICN = Success
; -1^Reason = Failure
;
;Check input
S DFN=+$G(DFN)
Q:('$D(^DPT(DFN,0))) "-1^Did not pass valid DFN"
;Declare variables
N DPTZERO,CREATED,USER,INFOARR,MSG2MPI,MSG2DHCP,TMP,ICN
S MSG2MPI="^TMP(""MPIFRTC"","_$J_",""MSG2MPI"")"
S MSG2DHCP="^TMP(""MPIFRTC"","_$J_",""MSG2DHCP"")"
S INFOARR="^TMP(""MPIFRTC"","_$J_",""INFOARR"")"
K @MSG2MPI,@MSG2DHCP,@INFOARR
;Determine user that created patient and date/time patient was created
S DPTZERO=$G(^DPT(DFN,0))
S USER=+$P(DPTZERO,"^",15)
S:('USER) USER=+$G(DUZ)
S CREATED=+$P(DPTZERO,"^",16)
S:('CREATED) CREATED=$$NOW^XLFDT()
;Set up extra info array for message builder
; - Event reason code (EVN segment, seq #4)
S @INFOARR@("REASON",1)=94
; - Operator (EVN segment, seq #5)
S @INFOARR@("USER")=$P($G(^VA(200,USER,0)),"^",1)
;Build MSH segment for ADT-A28 HL7 message
D BLDMSH("A28","MPI","200M",MSG2MPI,1)
;Build rest of ADT-A28 HL7 message
S TMP=$$BLDMSG^VAFCMSG1(DFN,"A28",CREATED,INFOARR,MSG2MPI,2)
;need to remove local ICN from PID segment
S $P(@MSG2MPI@(3),"^",3)="",$P(@MSG2MPI@(3),"^",4)=""
;Send ADT-A28 HL7 message to MPI using real time connection
S TMP=$$EN^HLCSAC("MPIVA DIR",MSG2MPI,MSG2DHCP)
Q:(TMP<0) TMP
;Process ADT-A31 HL7 message returned by MPI (contains ICN assignment)
S ICN=$$PROCESS^MPIFA31I(MSG2DHCP)
;Done - Clean up and return ICN
EX K @MSG2MPI,@MSG2DHCP,@INFOARR
Q ICN
;
BLDMSH(EVNTHL7,RCVAPP,RCVFAC,ARRAY,LINE) ;Build MSH segment for ADT
; HL7 message
;
;Input : EVNTHL7 - HL7 ADT event to build MSH segment for A28
; (Defaults to A28)
; RCVAPP - Text to use as RECEIVING APPLICATION (seq #5)
; RCVFAC - Text to use as RECEIVING FACILITY (seq #6)
; ARRAY - Array to store MSH segment in (full global reference)
; (Defaults to ^TMP("MPIFRTC",$J,"MSH"))
; LINE - Line number in ARRAY to store MSH segment in
; Can not be zero or negative number (defaults to 1)
;Output : None
; ARRAY() will be in the following format
; ARRAY(LINE) = MSH segment
; ARRAY(LINE,1) = First continuation node
; ARRAY(LINE,n) = Nth continuation node
;Notes : ARRAY(LINE) will be initialized (KILLed) on input
; : ARRAY(LINE) will not be defined on bad input
; : SENDING APPLICATION (seq #3) and SENDING FACILITY (seq #4)
; are based on the application attached to the PIMS ADT-xxx
; HL7 Server Protocol
;
;Check input
S EVNTHL7=$G(EVNTHL7)
S:(EVNTHL7="") EVNTHL7="A28"
S RCVAPP=$G(RCVAPP)
S RCVFAC=$G(RCVFAC)
S ARRAY=$G(ARRAY)
S:(ARRAY="") ARRAY="^TMP(""MPIFRTC"","_$J_",""MSH"")"
S LINE=+$G(LINE)
S:(LINE<1) LINE=1
;Declare variables
N HLEID,HL,TMPMSHAR
;Inintialize output array
K @ARRAY@(LINE)
;Get pointer to ADT-xxx HL7 Server Protocol
S HLEID=$$GETSRVR^VAFCMSG5(EVNTHL7)
;Initialize HL7 variables
D INIT^HLFNC2(HLEID,.HL)
;Build MSH segment for ADT-xxx HL7 message
D MSH^HLFNC2(.HL,"",.TMPMSHAR)
;Manually set RECEIVING APPLICATION (seq #5)
S $P(TMPMSHAR,HL("FS"),5)=RCVAPP
;Manually set RECEIVING FACILITY (seq #6)
S $P(TMPMSHAR,HL("FS"),6)=RCVFAC
;Move MSH segment into output array
S @ARRAY@(LINE)=TMPMSHAR
S HL=0
F S HL=+$O(MSH(HL)) Q:('HL) S @ARRAY@(LINE,HL)=TMPMSHAR(HL)
;Done
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFRTC 3651 printed Apr 09, 2024@21:13:06 Page 2
MPIFRTC ;ALB/JRP-GET ICN FROM MPI USING REAL TIME CONNECTION ;21-JAN-1997
+1 ;;1.0; MASTER PATIENT INDEX VISTA ;**1**;30 Apr 99
+2 ;
GETICN(DFN) ;Get ICN from MPI using real time connection
+1 ;
+2 ;Input : DFN - Pointer to entry in PATIENT file (#2)
+3 ;Output : ICN = Success
+4 ; -1^Reason = Failure
+5 ;
+6 ;Check input
+7 SET DFN=+$GET(DFN)
+8 if ('$DATA(^DPT(DFN,0)))
QUIT "-1^Did not pass valid DFN"
+9 ;Declare variables
+10 NEW DPTZERO,CREATED,USER,INFOARR,MSG2MPI,MSG2DHCP,TMP,ICN
+11 SET MSG2MPI="^TMP(""MPIFRTC"","_$JOB_",""MSG2MPI"")"
+12 SET MSG2DHCP="^TMP(""MPIFRTC"","_$JOB_",""MSG2DHCP"")"
+13 SET INFOARR="^TMP(""MPIFRTC"","_$JOB_",""INFOARR"")"
+14 KILL @MSG2MPI,@MSG2DHCP,@INFOARR
+15 ;Determine user that created patient and date/time patient was created
+16 SET DPTZERO=$GET(^DPT(DFN,0))
+17 SET USER=+$PIECE(DPTZERO,"^",15)
+18 if ('USER)
SET USER=+$GET(DUZ)
+19 SET CREATED=+$PIECE(DPTZERO,"^",16)
+20 if ('CREATED)
SET CREATED=$$NOW^XLFDT()
+21 ;Set up extra info array for message builder
+22 ; - Event reason code (EVN segment, seq #4)
+23 SET @INFOARR@("REASON",1)=94
+24 ; - Operator (EVN segment, seq #5)
+25 SET @INFOARR@("USER")=$PIECE($GET(^VA(200,USER,0)),"^",1)
+26 ;Build MSH segment for ADT-A28 HL7 message
+27 DO BLDMSH("A28","MPI","200M",MSG2MPI,1)
+28 ;Build rest of ADT-A28 HL7 message
+29 SET TMP=$$BLDMSG^VAFCMSG1(DFN,"A28",CREATED,INFOARR,MSG2MPI,2)
+30 ;need to remove local ICN from PID segment
+31 SET $PIECE(@MSG2MPI@(3),"^",3)=""
SET $PIECE(@MSG2MPI@(3),"^",4)=""
+32 ;Send ADT-A28 HL7 message to MPI using real time connection
+33 SET TMP=$$EN^HLCSAC("MPIVA DIR",MSG2MPI,MSG2DHCP)
+34 if (TMP<0)
QUIT TMP
+35 ;Process ADT-A31 HL7 message returned by MPI (contains ICN assignment)
+36 SET ICN=$$PROCESS^MPIFA31I(MSG2DHCP)
+37 ;Done - Clean up and return ICN
EX KILL @MSG2MPI,@MSG2DHCP,@INFOARR
+1 QUIT ICN
+2 ;
BLDMSH(EVNTHL7,RCVAPP,RCVFAC,ARRAY,LINE) ;Build MSH segment for ADT
+1 ; HL7 message
+2 ;
+3 ;Input : EVNTHL7 - HL7 ADT event to build MSH segment for A28
+4 ; (Defaults to A28)
+5 ; RCVAPP - Text to use as RECEIVING APPLICATION (seq #5)
+6 ; RCVFAC - Text to use as RECEIVING FACILITY (seq #6)
+7 ; ARRAY - Array to store MSH segment in (full global reference)
+8 ; (Defaults to ^TMP("MPIFRTC",$J,"MSH"))
+9 ; LINE - Line number in ARRAY to store MSH segment in
+10 ; Can not be zero or negative number (defaults to 1)
+11 ;Output : None
+12 ; ARRAY() will be in the following format
+13 ; ARRAY(LINE) = MSH segment
+14 ; ARRAY(LINE,1) = First continuation node
+15 ; ARRAY(LINE,n) = Nth continuation node
+16 ;Notes : ARRAY(LINE) will be initialized (KILLed) on input
+17 ; : ARRAY(LINE) will not be defined on bad input
+18 ; : SENDING APPLICATION (seq #3) and SENDING FACILITY (seq #4)
+19 ; are based on the application attached to the PIMS ADT-xxx
+20 ; HL7 Server Protocol
+21 ;
+22 ;Check input
+23 SET EVNTHL7=$GET(EVNTHL7)
+24 if (EVNTHL7="")
SET EVNTHL7="A28"
+25 SET RCVAPP=$GET(RCVAPP)
+26 SET RCVFAC=$GET(RCVFAC)
+27 SET ARRAY=$GET(ARRAY)
+28 if (ARRAY="")
SET ARRAY="^TMP(""MPIFRTC"","_$JOB_",""MSH"")"
+29 SET LINE=+$GET(LINE)
+30 if (LINE<1)
SET LINE=1
+31 ;Declare variables
+32 NEW HLEID,HL,TMPMSHAR
+33 ;Inintialize output array
+34 KILL @ARRAY@(LINE)
+35 ;Get pointer to ADT-xxx HL7 Server Protocol
+36 SET HLEID=$$GETSRVR^VAFCMSG5(EVNTHL7)
+37 ;Initialize HL7 variables
+38 DO INIT^HLFNC2(HLEID,.HL)
+39 ;Build MSH segment for ADT-xxx HL7 message
+40 DO MSH^HLFNC2(.HL,"",.TMPMSHAR)
+41 ;Manually set RECEIVING APPLICATION (seq #5)
+42 SET $PIECE(TMPMSHAR,HL("FS"),5)=RCVAPP
+43 ;Manually set RECEIVING FACILITY (seq #6)
+44 SET $PIECE(TMPMSHAR,HL("FS"),6)=RCVFAC
+45 ;Move MSH segment into output array
+46 SET @ARRAY@(LINE)=TMPMSHAR
+47 SET HL=0
+48 FOR
SET HL=+$ORDER(MSH(HL))
if ('HL)
QUIT
SET @ARRAY@(LINE,HL)=TMPMSHAR(HL)
+49 ;Done
+50 QUIT
