MPIFRPC3 ;DRI/BHM - MPIF RPC API'S ;11/2/05 16:42
;;1.0; MASTER PATIENT INDEX VISTA ;**42**;30 Apr 99
;
;Integration Agreements Utilized:
; ^DPT( - #2070
; ^A7RCP( - #4830
;
PRIMARY(RETURN,SITE,DFN) ; rpc to return primary patient record ;**42
; site - station number or legacy station number
; dfn - patient dfn or dfn in legacy site
; return = primary dfn^icn icn (if available) can be local or national
; if a problem
; return = -1^error type^error text
;
N ICN,NDFN,PDFN,SITEIEN K RETURN
;
I $G(SITE)="" S RETURN="-1^NULL STATION NUMBER^Null station number passed." Q
I $G(DFN)="" S RETURN="-1^NULL PATIENT NUMBER^Null patient DFN passed." Q
;
S PDFN=DFN ;assume primary dfn passed in
;
I +$$SITE^VASITE()'=SITE D ;use ndbi data
. S SITEIEN=$O(^A7RCP("B",SITE,0)) ;check ndbi x-ref for site ien
. I SITEIEN="",$D(^A7RCP(SITE)) S SITEIEN=SITE ;some sites have site number as ien
. I SITEIEN="" S RETURN="-1^NO LEGACY DATA FOR SITE^Legacy site '"_SITE_"' data does not exist." Q
. S PDFN=$P($G(^A7RCP(SITEIEN,1,2,1,DFN,1)),"^",1) ;find primary dfn for patient file (#2) data
. I 'PDFN,$D(^A7RCP(SITEIEN,1,2,1,DFN,2)) S RETURN="-1^DUP MERGE AT LEGACY^"_$P($G(^(2)),"^",4)_"." Q
. I 'PDFN S RETURN="-1^NO LEGACY DATA FOR DFN^DFN '"_DFN_"' does not exist in legacy data" Q
I $G(RETURN) Q ;invalid ndbi data
;
I $D(^DPT(PDFN,-9)) D ;check merge records
. S NDFN=PDFN ;next dfn
. F S NDFN=$P($G(^DPT(NDFN,-9)),"^") I $S('NDFN:1,'$D(^DPT(NDFN,-9)):1,1:0) Q ;could be multiple merges
. S PDFN=NDFN ;last dfn is new primary dfn
. I 'PDFN S RETURN="-1^NO MERGE DATA FOR DFN^No DFN for merged DFN '"_DFN_"'." Q
. I '$D(^DPT(PDFN)) S RETURN="-1^DFN NOT IN DATABASE FOR MERGED DFN^DFN '"_PDFN_"' does not exist for merged DFN '"_DFN_"'." Q
I $G(RETURN) Q ;invalid merge data
;
I '$D(^DPT(PDFN)) S RETURN="-1^PATIENT NOT IN DATABASE^DFN '"_PDFN_"' does not exist in database." Q
;
S ICN=$$GETICN^MPIF001(PDFN) ;get icn
I ICN<0 S RETURN=PDFN_"^"_$P(ICN,"^",2) Q ;return primary dfn and icn error message
S RETURN=PDFN_"^"_ICN ; return primary dfn and icn
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFRPC3 2150 printed Nov 22, 2024@17:21:42 Page 2
MPIFRPC3 ;DRI/BHM - MPIF RPC API'S ;11/2/05 16:42
+1 ;;1.0; MASTER PATIENT INDEX VISTA ;**42**;30 Apr 99
+2 ;
+3 ;Integration Agreements Utilized:
+4 ; ^DPT( - #2070
+5 ; ^A7RCP( - #4830
+6 ;
PRIMARY(RETURN,SITE,DFN) ; rpc to return primary patient record ;**42
+1 ; site - station number or legacy station number
+2 ; dfn - patient dfn or dfn in legacy site
+3 ; return = primary dfn^icn icn (if available) can be local or national
+4 ; if a problem
+5 ; return = -1^error type^error text
+6 ;
+7 NEW ICN,NDFN,PDFN,SITEIEN
KILL RETURN
+8 ;
+9 IF $GET(SITE)=""
SET RETURN="-1^NULL STATION NUMBER^Null station number passed."
QUIT
+10 IF $GET(DFN)=""
SET RETURN="-1^NULL PATIENT NUMBER^Null patient DFN passed."
QUIT
+11 ;
+12 ;assume primary dfn passed in
SET PDFN=DFN
+13 ;
+14 ;use ndbi data
IF +$$SITE^VASITE()'=SITE
Begin DoDot:1
+15 ;check ndbi x-ref for site ien
SET SITEIEN=$ORDER(^A7RCP("B",SITE,0))
+16 ;some sites have site number as ien
IF SITEIEN=""
IF $DATA(^A7RCP(SITE))
SET SITEIEN=SITE
+17 IF SITEIEN=""
SET RETURN="-1^NO LEGACY DATA FOR SITE^Legacy site '"_SITE_"' data does not exist."
QUIT
+18 ;find primary dfn for patient file (#2) data
SET PDFN=$PIECE($GET(^A7RCP(SITEIEN,1,2,1,DFN,1)),"^",1)
+19 IF 'PDFN
IF $DATA(^A7RCP(SITEIEN,1,2,1,DFN,2))
SET RETURN="-1^DUP MERGE AT LEGACY^"_$PIECE($GET(^(2)),"^",4)_"."
QUIT
+20 IF 'PDFN
SET RETURN="-1^NO LEGACY DATA FOR DFN^DFN '"_DFN_"' does not exist in legacy data"
QUIT
End DoDot:1
+21 ;invalid ndbi data
IF $GET(RETURN)
QUIT
+22 ;
+23 ;check merge records
IF $DATA(^DPT(PDFN,-9))
Begin DoDot:1
+24 ;next dfn
SET NDFN=PDFN
+25 ;could be multiple merges
FOR
SET NDFN=$PIECE($GET(^DPT(NDFN,-9)),"^")
IF $SELECT('NDFN:1,'$DATA(^DPT(NDFN,-9)):1,1:0)
QUIT
+26 ;last dfn is new primary dfn
SET PDFN=NDFN
+27 IF 'PDFN
SET RETURN="-1^NO MERGE DATA FOR DFN^No DFN for merged DFN '"_DFN_"'."
QUIT
+28 IF '$DATA(^DPT(PDFN))
SET RETURN="-1^DFN NOT IN DATABASE FOR MERGED DFN^DFN '"_PDFN_"' does not exist for merged DFN '"_DFN_"'."
QUIT
End DoDot:1
+29 ;invalid merge data
IF $GET(RETURN)
QUIT
+30 ;
+31 IF '$DATA(^DPT(PDFN))
SET RETURN="-1^PATIENT NOT IN DATABASE^DFN '"_PDFN_"' does not exist in database."
QUIT
+32 ;
+33 ;get icn
SET ICN=$$GETICN^MPIF001(PDFN)
+34 ;return primary dfn and icn error message
IF ICN<0
SET RETURN=PDFN_"^"_$PIECE(ICN,"^",2)
QUIT
+35 ; return primary dfn and icn
SET RETURN=PDFN_"^"_ICN
+36 QUIT
+37 ;
