DGPROSAD ;ALB/CKN - Patient Add support for Prosthetics/CERNER; 03/24/23 11:12pm ; 4/14/23 3:05pm
;;5.3;Registration;**1096**;Aug 13, 1993;Build 24
;This API is supported by DBIA #7421
Q
;
ADD(SRCID,SITE) ;Add patient to site mentioned
;This utility code is to support IFC to add patient into VistA for
;provided ICN OR EDIPI (one of the value must be passed in)
;Input: SRCID - Fully qualified ID (Required)
; ex: For ICN: FullICN~USVHA~NI~200M
; For EDIPI: EDIPI~USDOD~NI~200DOD
; SITE - VistA station number (default: current VistA site)
;Output: 1^ICN^STATION NUMBER^DFN value if patient record is created at Site
; Or
; -1^Error message if failed
;
N RETURN,RPC,ICN,DFN,ID,AA,IDTYP,STA,I,RET,RSLT
I $G(SRCID)="" Q "-1^ID parameter is missing"
S ID=$P(SRCID,"~"),AA=$P(SRCID,"~",2),IDTYP=$P(SRCID,"~",3),STA=$P(SRCID,"~",4)
I ID="" Q "-1^Source ID is missing in ID parameter"
I AA="" Q "-1^Assigning Authority is missing in ID parameter"
I ((AA'="USVHA")&(AA'="USDOD")) Q "-1^Invalid Assigning Authority for ICN or EDIPI"
I IDTYP="" Q "-1^ID Type is missing in ID parameter"
I IDTYP'="NI" Q "-1^Invalid ID type in ID parameter for ICN or EDIPI value"
I STA="" Q "-1^Station Number is missing in ID parameter"
I $$IEN^XUAF4($G(STA))="" Q "-1^Invalid Station number in ID parameter"
I AA="USVHA",(STA'="200M") Q "-1^Assigning Authority and Station number invalid for ICN"
I AA="USDOD",(STA'="200DOD") Q "-1^Assiging Authority and Station number invalid for EDIPI"
I $G(SITE)="" S SITE=$P($$SITE^VASITE(),"^",3) ;Default Site to add patient
I '$$IEN^XUAF4(SITE) Q "-1^Invalid VistA site"
;Call MPI RPC - MPI IFC VISTA ADD PATIENT to create patient at VistA
;If ICN is passed in, MPI will remotely create patient in VistA using PV data
;If EDIPI is passed in, MPI will find 200DOD correlation and use associated ICN
;with the correlation to create patient in VistA using its PV data
;If EDIPI not found at MPI, MPI will request DoD orchestration to PSIM and once
;200DoD correlation is created, using its ICN PV data to create patient at VistA
S RPC="MPI IFC VISTA ADD PATIENT"
N DONE,HCNT S HCNT=1
S DONE=0
TR ;
D EN1^XWB2HL7(.RET,"200M",RPC,1,$G(SRCID),$G(SITE))
I $G(RET(0))="" S HCNT=HCNT+1 H 2 I HCNT<15 G TR
I $G(RET(0))="" Q "-1^"_$G(RET(1))
I +$G(RET(0))=-1 Q $G(RET(0))
F I=1:1:25 D Q:DONE
.D RPCCHK^XWB2HL7(.RSLT,$G(RET(0)))
.I $P($G(RSLT(0)),"^")=-1 S DONE=1 Q
.I $P($G(RSLT(0)),"^")>0 S DONE=1 Q
.K RSLT
.H 5
I $P($G(RSLT(0)),"^")=-1 Q $G(RSLT(0))
I $P($G(RSLT(0)),"^")'>0 Q "-1^Sorry, it is taking too long retrieve patient information, Please try again later!"
I +$G(RSLT(0))=1 D RTNDATA^XWBDRPC(.RETURN,RET(0))
Q $G(RETURN(0))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPROSAD 2794 printed Sep 23, 2025@20:27:02 Page 2
DGPROSAD ;ALB/CKN - Patient Add support for Prosthetics/CERNER; 03/24/23 11:12pm ; 4/14/23 3:05pm
+1 ;;5.3;Registration;**1096**;Aug 13, 1993;Build 24
+2 ;This API is supported by DBIA #7421
+3 QUIT
+4 ;
ADD(SRCID,SITE) ;Add patient to site mentioned
+1 ;This utility code is to support IFC to add patient into VistA for
+2 ;provided ICN OR EDIPI (one of the value must be passed in)
+3 ;Input: SRCID - Fully qualified ID (Required)
+4 ; ex: For ICN: FullICN~USVHA~NI~200M
+5 ; For EDIPI: EDIPI~USDOD~NI~200DOD
+6 ; SITE - VistA station number (default: current VistA site)
+7 ;Output: 1^ICN^STATION NUMBER^DFN value if patient record is created at Site
+8 ; Or
+9 ; -1^Error message if failed
+10 ;
+11 NEW RETURN,RPC,ICN,DFN,ID,AA,IDTYP,STA,I,RET,RSLT
+12 IF $GET(SRCID)=""
QUIT "-1^ID parameter is missing"
+13 SET ID=$PIECE(SRCID,"~")
SET AA=$PIECE(SRCID,"~",2)
SET IDTYP=$PIECE(SRCID,"~",3)
SET STA=$PIECE(SRCID,"~",4)
+14 IF ID=""
QUIT "-1^Source ID is missing in ID parameter"
+15 IF AA=""
QUIT "-1^Assigning Authority is missing in ID parameter"
+16 IF ((AA'="USVHA")&(AA'="USDOD"))
QUIT "-1^Invalid Assigning Authority for ICN or EDIPI"
+17 IF IDTYP=""
QUIT "-1^ID Type is missing in ID parameter"
+18 IF IDTYP'="NI"
QUIT "-1^Invalid ID type in ID parameter for ICN or EDIPI value"
+19 IF STA=""
QUIT "-1^Station Number is missing in ID parameter"
+20 IF $$IEN^XUAF4($GET(STA))=""
QUIT "-1^Invalid Station number in ID parameter"
+21 IF AA="USVHA"
IF (STA'="200M")
QUIT "-1^Assigning Authority and Station number invalid for ICN"
+22 IF AA="USDOD"
IF (STA'="200DOD")
QUIT "-1^Assiging Authority and Station number invalid for EDIPI"
+23 ;Default Site to add patient
IF $GET(SITE)=""
SET SITE=$PIECE($$SITE^VASITE(),"^",3)
+24 IF '$$IEN^XUAF4(SITE)
QUIT "-1^Invalid VistA site"
+25 ;Call MPI RPC - MPI IFC VISTA ADD PATIENT to create patient at VistA
+26 ;If ICN is passed in, MPI will remotely create patient in VistA using PV data
+27 ;If EDIPI is passed in, MPI will find 200DOD correlation and use associated ICN
+28 ;with the correlation to create patient in VistA using its PV data
+29 ;If EDIPI not found at MPI, MPI will request DoD orchestration to PSIM and once
+30 ;200DoD correlation is created, using its ICN PV data to create patient at VistA
+31 SET RPC="MPI IFC VISTA ADD PATIENT"
+32 NEW DONE,HCNT
SET HCNT=1
+33 SET DONE=0
TR ;
+1 DO EN1^XWB2HL7(.RET,"200M",RPC,1,$GET(SRCID),$GET(SITE))
+2 IF $GET(RET(0))=""
SET HCNT=HCNT+1
HANG 2
IF HCNT<15
GOTO TR
+3 IF $GET(RET(0))=""
QUIT "-1^"_$GET(RET(1))
+4 IF +$GET(RET(0))=-1
QUIT $GET(RET(0))
+5 FOR I=1:1:25
Begin DoDot:1
+6 DO RPCCHK^XWB2HL7(.RSLT,$GET(RET(0)))
+7 IF $PIECE($GET(RSLT(0)),"^")=-1
SET DONE=1
QUIT
+8 IF $PIECE($GET(RSLT(0)),"^")>0
SET DONE=1
QUIT
+9 KILL RSLT
+10 HANG 5
End DoDot:1
if DONE
QUIT
+11 IF $PIECE($GET(RSLT(0)),"^")=-1
QUIT $GET(RSLT(0))
+12 IF $PIECE($GET(RSLT(0)),"^")'>0
QUIT "-1^Sorry, it is taking too long retrieve patient information, Please try again later!"
+13 IF +$GET(RSLT(0))=1
DO RTNDATA^XWBDRPC(.RETURN,RET(0))
+14 QUIT $GET(RETURN(0))
