Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MPIFDNL

MPIFDNL.m

Go to the documentation of this file. 
  1. MPIFDNL ;OAK/TKW-CALL RPC TO ADD TO MPI DO NOT LINK FILE #985.28 ;9 Apr 2013  2:18 PM
  1.  ;;1.0;MASTER PATIENT INDEX AUSTIN;**52,55,57**;30 Apr 99;Build 2
  1.  ;
  1.  ;Reference to ^XWB2HL7 supported by IA #3144
  1.  ;Reference to ^XWBDRPC supported by IA #3149
  1.  ;
  1. CALLRPC(MPIFDUZ,MPIFSITE,MPIFFR,MPIFTO,MPIFINAC) ; Activate (add if necessary) or
  1.  ; inactivate entry on MPI DO NOT LINK file (#985.28)
  1.  ;
  1.  ; Called from option XDR VERIFY ALL when patient pair status set to VERIFIED, NOT A DUPLICATE
  1.  ; Called from option XDR EDIT DUP RECORD STATUS when status set to POTENTIAL DUPLICATE, UNVERIFIED
  1.  ;  MPIFDUZ = DUZ of current user (REQUIRED)
  1.  ;  MPIFSITE = IEN from file 4 for current users institution (from DUZ(2)) (REQUIRED)
  1.  ;  MPIFFR = First Patient IEN (DFN) from File 2 at the VistA site (REQUIRED)
  1.  ;  MPIFTO = Second Patient IEN (DFN) from file 2 at the VistA site (REQUIRED)
  1.  ;  MPIFINAC = If set to 1, entry will be inactivated (OPTIONAL)
  1.  ;
  1.  ; Call KERNEL routine to call remote RPC
  1.  ; 1) Return array
  1.  ; 2) Station number where RPC is to be executed (MPI="200M")
  1.  ; 3) Name of RPC at VistA site
  1.  ; 4) Version number
  1.  ; 5) SOURCEID = TO_DFN~STATION~Assigning_Authority~Source_Type (Ex. 12345~500~USVHA~PI)
  1.  ; 6) DNLSOURCEID = FROM_DFN~STATION~Assigning_Authority~Source_Type
  1.  ; 7) DNLIDENTIFIEDBY = Name of person whose DUZ represents current user
  1.  ; 8) DNLEVENT = "P" (KERNEL Duplicate Merge potential match resolution)
  1.  ; 9) DNLIDENTIFYINGLOCATION = VistA station number
  1.  ; 10) INACTIVATE_FLAG = (optional) set to "Y" if entry is to be inactivated.
  1.  ;
  1.  N MPIFRTN,MPIFNAME,MPIFSTA,MPISTA,MPIFFRP,MPIFTOP,MPIFHNDL,MPIFUERR,X
  1.  ; Set MPI station number
  1.  S MPISTA="200M"
  1.  ; Get current users name and current station number
  1.  S MPIFDUZ=+$G(MPIFDUZ),MPIFSITE=+$G(MPIFSITE)
  1.  S (MPIFNAME,MPIFSTA)=""
  1.  I MPIFSITE,$D(^DIC(4,MPIFSITE,0)) S MPIFSTA=$$GET1^DIQ(4,+MPIFSITE_",",99)
  1.  I MPIFSTA="" D  Q
  1.  . D ERRMSG(MPIFNAME,MPIFSITE,MPIFFR,MPIFTO,"missing or invalid value in user's station DUZ(2) parameter")
  1.  . Q
  1.  I $D(^VA(200,MPIFDUZ,0)) S MPIFNAME=$$GET1^DIQ(200,MPIFDUZ_",",.01)
  1.  I ('MPIFDUZ)!(MPIFNAME'?1U.E1","1U.E) D  Q
  1.  . D ERRMSG(MPIFDUZ,MPIFSTA,MPIFFR,MPIFTO,"missing or invalid value in users DUZ variable")
  1.  . Q
  1.  S MPIFUERR=0
  1.  S X=$$GET1^DIQ(200,MPIFDUZ_",",9)
  1.  ; If station is not MANILA-RO, user must have an SSN.
  1.  I MPIFSTA'=358,X'?9N D  Q
  1.  . D ERRMSG(MPIFDUZ,MPIFSTA,MPIFFR,MPIFTO,"Current user has missing or invalid SSN")
  1.  . Q
  1.  S MPIFFR=+$G(MPIFFR),MPIFTO=+$G(MPIFTO)
  1.  I ('$D(^DPT(MPIFFR,0)))!('$D(^DPT(MPIFTO,0))) D  Q
  1.  . D ERRMSG(MPIFNAME,MPIFSTA,MPIFFR,MPIFTO,"invalid FROM or TO patient input variable")
  1.  . Q
  1.  S MPIFSTA=$P($$SITE^VASITE,U,3) ;**55,MPIC 2161: Reset site, don't use DUZ(2)
  1.  ; Build FROM patient parameter
  1.  S MPIFFRP=MPIFFR_"~"_MPIFSTA_"~USVHA~PI"
  1.  ; Build TO patient parameter
  1.  S MPIFTOP=MPIFTO_"~"_MPIFSTA_"~USVHA~PI"
  1.  ; Call RPC to Activate or Inactivate the entry in the MPI DO NOT LINK file.
  1.  I $G(MPIFINAC) D EN1^XWB2HL7(.MPIFRTN,MPISTA,"MPIF DNL ADD UPD",1,MPIFTOP,MPIFFRP,"P",MPIFSTA,MPIFNAME,"Y")
  1.  I '$G(MPIFINAC) D EN1^XWB2HL7(.MPIFRTN,MPISTA,"MPIF DNL ADD UPD",1,MPIFTOP,MPIFFRP,"P",MPIFSTA,MPIFNAME)
  1.  ; If RPC was not scheduled, return error.
  1.  I $G(MPIFRTN(0))=""!($P($G(MPIFRTN(0)),U)=0)!(+$G(MPIFRTN(0))=-1) D  Q
  1.  . S X=$P($G(MPIFRTN(0)),U,2)
  1.  . S:X="" X=$P($G(MPIFRTN(1)),U,2)
  1.  . D ERRMSG(MPIFNAME,MPIFSTA,MPIFFR,MPIFTO,X)
  1.  . Q
  1.  ; Schedule a taskman job to process results of RPC
  1.  S MPIFHNDL=MPIFRTN(0)
  1.  N ZTIO,ZTSK,ZTRTN,ZTDESC,ZTSAVE,ZTDTH,Y
  1.  S ZTIO="",ZTRTN="CHKRSLT^MPIFDNL",ZTDTH=$H
  1.  S ZTSAVE("MPIFHNDL")=MPIFHNDL,ZTSAVE("MPIFNAME")=MPIFNAME,ZTSAVE("MPIFSTA")=MPIFSTA
  1.  S ZTSAVE("MPIFFR")=MPIFFR,ZTSAVE("MPIFTO")=MPIFTO
  1.  S ZTDESC="Check Results from call to RPC MPIF DNL ADD UPD"
  1.  D ^%ZTLOAD
  1.  I '$G(ZTSK) D  Q
  1.  . S MPIFMSG="Results not returned from RPC to log an MPI DO NOT LINK entry for User "_MPIFNAME_" at station "_MPIFSTA_", for "_MPIFFR_" and "_MPIFTO_"."
  1.  . D EXC^RGHLLOG(208,MPIFMSG,MPIFTO)
  1.  . D STOP^RGHLLOG(0)
  1.  . Q
  1.  Q
  1.  ;
  1. CHKRSLT ; Check results from calling RPC (QUEUED job)
  1.  ;**57,MVI_1414 (mko): Call RPCCHK^XWB2HL7 instead of RTNDATA^XWBDRPC to check for results
  1.  N MPIFCNT,MPIFRTN,X
  1.  F MPIFCNT=1:1:20 K MPIFRTN D RPCCHK^XWB2HL7(.MPIFRTN,MPIFHNDL) Q:+MPIFRTN(0)=1  Q:+MPIFRTN(0)=-1  H 5
  1.  I +MPIFRTN(0)=-1 S X=$P($G(MPIFRTN(0)),U,2) D ERRMSG(MPIFNAME,MPIFSTA,MPIFFR,MPIFTO,X) Q
  1.  I +MPIFRTN(0)'=1 D ERRMSG(MPIFNAME,MPIFSTA,MPIFFR,MPIFTO,"Timeout") Q
  1.  ; Get results
  1.  K MPIFRTN D RTNDATA^XWBDRPC(.MPIFRTN,MPIFHNDL)
  1.  I $P(MPIFRTN(0),U)=-1 S X=$P($G(MPIFRTN(0)),U,2) D ERRMSG(MPIFNAME,MPIFSTA,MPIFFR,MPIFTO,X)
  1.  Q
  1.  ;S MPIFDONE=0
  1.  ;F MPIFCNT=1:1:20 D  Q:MPIFDONE
  1.  ;. H 5
  1.  ;. D RTNDATA^XWBDRPC(.MPIFRTN,MPIFHNDL)
  1.  ;. Q:$P(MPIFRTN(0),U)=0  ; Not done
  1.  ;. I $P(MPIFRTN(0),U)=-1 D  Q
  1.  ;. . I MPIFRTN(0)["Not DONE" Q
  1.  ;. . S X=$P($G(MPIFRTN(0)),U,2)
  1.  ;. . S:X="" X=$P($G(MPIFRTN(1)),U,2)
  1.  ;. . D ERRMSG(MPIFNAME,MPIFSTA,MPIFFR,MPIFTO,X)
  1.  ;. . S MPIFDONE=1
  1.  ;. . Q
  1.  ;. ; Success.
  1.  ;. S MPIFDONE=1 Q
  1.  ;Q
  1.  ;
  1. ERRMSG(MPIFNAME,MPIFSTA,MPIFFR,MPIFTO,MPIFMSG) ; Send error to CIRN HL7 EXCEPTION LOG (991.1)
  1.  S MPIFMSG="User "_MPIFNAME_" at station "_MPIFSTA_" failed to log a DO NOT LINK event for "_MPIFFR_" and "_MPIFTO_" due to "_MPIFMSG
  1.  ; If MPIFTO is invalid, set it to null so it won't cause a problem logging the error
  1.  I '$D(^DPT(+MPIFTO,0)) S MPIFTO=""
  1.  D EXC^RGHLLOG(208,MPIFMSG,MPIFTO)
  1.  D STOP^RGHLLOG(0)
  1.  Q
  1.  ;
  1. DNLCHK(MPIFREC1,MPIFREC2) ; Checks whether records with DFNs MPIFREC1 and
  1.  ; MPIFREC2 are verified as not duplicates in the MPI DO NOT LINK file.
  1.  ; (New entry point created in MPIF*1.0*55, MPIC_1834)
  1.  ; Input:
  1.  ;   MPIFREC1          - DFN for record 1 in the Patient file
  1.  ;   MPIFREC2          - DFN for record 2 in the Patient file
  1.  ; Returns:
  1.  ;   0                 - if the are no problems and the records can be
  1.  ;                       added to the Duplicate Record file
  1.  ;   -1^error message  - if the there was a problem calling the MPI RPC
  1.  ;                       or if the record pair is in the MPI DO NOT LINK
  1.  ;                       file.
  1.  ;
  1.  N MPIFERR,MPIFSITE,MPIFID,MPIFI,MPIFREC,MPIICN1,MPIICN2
  1.  S MPIFERR=0
  1.  ;
  1.  ; Find records that should not be merged with MPIFREC1
  1.  ; Use the ICN if available,
  1.  S MPIFSITE=$P($$SITE^VASITE,U,3)
  1.  S MPIFICN1=$$GETICN^MPIF001(MPIFREC1)
  1.  S MPIFICN2=$$GETICN^MPIF001(MPIFREC2)
  1.  I MPIFICN1>0 D
  1.  . S MPIFID=MPIFICN1_"|200M|USVHA|NI"
  1.  E  D
  1.  . S MPIFID=MPIFREC1_"|"_MPIFSITE_"|USVHA|PI"
  1.  D CALLRPCD(.MPIFRES,MPIFID)
  1.  ;
  1.  ; Check for errors invoking RPC
  1.  I $P($G(MPIFRES(0)),U)=-1!(+$G(MPIFRES)=-1) D  Q MPIFERR
  1.  . S MPIFERR="-1^Remote procedure call to MPI to return DO NOT LINK records failed. "_$P($G(MPIFRES(0)),U,2)
  1.  ;
  1.  ; Loop through the records returned by the MPI EVENT LIST call and see
  1.  ; if any of the returned records match MPIFREC2 or MPIFICN2
  1.  S MPIFI="" F  S MPIFI=$O(MPIFRES(MPIFI)) Q:MPIFI=""  D  Q:MPIFERR
  1.  . Q:MPIFRES(MPIFI)'["^DO NOT LINK^"
  1.  . S MPIFID2=$P(MPIFRES(MPIFI),"^DO NOT LINK^",2,999)
  1.  . I $P(MPIFID2,U,1,4)=(MPIFREC2_U_MPIFSITE_"^USVHA^PI")!($P(MPIFID2,U,1,4)=(MPIFICN2_"^200M^USVHA^NI")) D
  1.  .. S MPIFERR="-1^The records with DFN #"_MPIFREC1_" and "_MPIFREC2_" have already been identified as not duplicates in the MPI NOT LINK file, and therefore cannot be added as a duplicate pair."
  1.  ;
  1.  Q MPIFERR
  1.  ;
  1. CALLRPCD(MPIFRES,MPIFID) ; Uses the DIRECT^XWB2HL7 API to call the
  1.  ; "MPI EVENT LIST" Remote Procedure on the MPI directly. This RPC
  1.  ; returns the list of records that have been marked as DO NOT LINK
  1.  ; with the record identified by the Source ID input parameter.
  1.  ; (Entry point created in MPIF*1.0*55, MPIC_1834)
  1.  ;
  1.  ; Input:
  1.  ;  MPIFID = The source ID in the format:
  1.  ;              DFN/ICN|SourceSytemID|SourceAssigningAuthority|IDType
  1.  ;           Example:
  1.  ;              100001440|500|USVHA|PI
  1.  ; Output:
  1.  ;  .MPIFRES = Array of records that should not be linked with the
  1.  ;             source ID passed in
  1.  ; Example output:
  1.  ;   RESULT(0)="100001440|500|USVHA|PI^DO NOT LINK^100001439^500^USVHA^PI"
  1.  ;   RESULT(1)="100001440|500|USVHA|PI^DO NOT LINK^100002113^500^USVHA^PI"
  1.  ;
  1.  N MPIFRPC,MPIFSTA
  1.  ;
  1.  ; Setup input parameters and call the DIRECT^XWB2HL7 entry point to
  1.  ; invoke the "MPI EVENT LIST" Remote Procedure on the MPI.
  1.  S MPIFRPC="MPI EVENT LIST"
  1.  S MPIFSTA="200M"
  1.  D DIRECT^XWB2HL7(.MPIFRES,MPIFSTA,MPIFRPC,1,MPIFID)
  1.  Q
  1.  ;