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

MPIFRPC.m

Go to the documentation of this file.
  1. MPIFRPC ;SFCIO/CMC-MPIF RPC APIS ;26 JUN 01
  1. ;;1.0;MASTER PATIENT INDEX VISTA;**20,62**;30 Apr 99;Build 3
  1. ;
  1. ;Integration Agreements Utilized:
  1. ; ^DPT( - #2070
  1. ; AVAFC^VAFCDD01 - #3493
  1. ; GETEX^RGEX03 - #3554
  1. ; NOTICE^DGSEC4 - #3027
  1. ; PTSEC^DGSEC4 - #3027
  1. ;
  1. ICNSTAT(RETURN,ICN,SSN,RPC) ;
  1. ;RPC to return status of ICN passed or if SSN is passed find ICN and return status including ICN, ICN History, CMOR History, Exceptions pending
  1. ; RETURN - array to return ICN data
  1. ; ICN - ICN for the patient in the Patient (#2) file data is to be returned on
  1. ; SSN - social security number for the patient in the Patient (#2) file data is to be returned on
  1. ; RPC - 0 or 1 to denote if the call is being made from a RPC or called locally. 1=RPC remote call 0=locally called - 1 is default
  1. ;
  1. N PICN,CNTD,DFN,TICN,LOCAL,XX,RETS,TEXT,CMOR,ICNH,CMORH
  1. I $G(RPC)="" S RPC=1
  1. I $G(ICN)=""&($G(SSN)="") S RETURN="-1^NO ICN OR SSN PASSED" Q
  1. I $G(SSN)'="" S ICN=$$GETICNS^MPIF002(SSN),RETURN(1,"SSN USED")="MPI(""SSN USED"")="_""""_SSN_"""" ; possible to have multiple entries with same SSN
  1. S PICN=ICN,CNTD=0,TEXT=""
  1. F XX=1:1 S ICN=$P(PICN,"^",XX) Q:ICN="" D
  1. .S DFN=$$GETDFN^MPIF001(+ICN),CNTD=CNTD+1
  1. .I +DFN=-1 S RETURN(XX)="-1^NO SUCH ICN "_ICN Q
  1. .I '$D(^DPT(DFN)) S RETURN(DFN)="-1^BAD AICN X-REF, PT FILE ENTRY DOESN'T EXIST DFN= "_DFN_" ICN= "_ICN Q
  1. .; check if this data can be returned and if sensative pt bulletin needed
  1. .N SENS D PTSEC^DGSEC4(.SENS,DFN,1,"Remote Procedure from MPI^RPC from MPI for ICN Information")
  1. .N NOT D NOTICE^DGSEC4(.NOT,DFN,"Remote Procedure from MPI^RPC from MPI for ICN Information")
  1. .I SENS(1)=3!(SENS(1)=4)!(SENS(1)=-1) S RETURN(XX)="-1^SENSATIVE PT ISSUE "_SENS(2)_" DFN= "_DFN_" ICN= "_ICN Q
  1. .I RPC=1 S TEXT="MPI("_DFN_",""DFN"")="
  1. .S RETURN(DFN,"DFN")=TEXT_""""_DFN_""""
  1. .S TICN=$$GETICN^MPIF001(DFN)
  1. .I +TICN<0 D
  1. ..I RPC=1 S RETURN(DFN,1)="MPI("_DFN_",1)="_""""_"No current ICN"
  1. ..I RPC=0 S RETURN(DFN,1)="""No Current ICN"
  1. .I +TICN>0 D
  1. ..I RPC=1 S RETURN(DFN,"ICN")="MPI("_DFN_",""ICN"")="_""""_TICN_""""
  1. ..I RPC=0 S RETURN(DFN,"ICN")=""""_TICN_""""
  1. .S LOCAL=""
  1. .I $E($G(RETURN(DFN,"ICN")),1,3)=$P($$SITE^VASITE(),"^",3) S LOCAL="Y"
  1. .I LOCAL=""&(+TICN>0) D
  1. ..I RPC=1 S RETURN(DFN,1)="MPI("_DFN_",1)="_""""_"NATIONAL ICN"
  1. ..I RPC=0 S RETURN(DFN,1)=""""_"NATIONAL ICN"
  1. .I LOCAL="Y"&(+TICN>0) D
  1. ..I RPC=1 S RETURN(DFN,1)="MPI("_DFN_",1)="_""""_"LOCAL ICN"
  1. ..I RPC=0 S RETURN(DFN,1)=""""_"LOCAL ICN"_""""
  1. .S CMOR=$$GETVCCI^MPIF001(DFN)
  1. .I +CMOR=-1 S CMOR=$P(CMOR,"^",2)
  1. .I RPC=1 S RETURN(DFN,"CMOR")="MPI("_DFN_",""CMOR"")="""_CMOR_""""
  1. .I RPC=0 S RETURN(DFN,"CMOR")=""""_CMOR_""""
  1. .D GETICNH^MPIF002(DFN,.ICNH)
  1. .I +ICNH=-1 D
  1. ..I RPC=1 S RETURN(DFN,"ICN HISTORY")="MPI("_DFN_",""ICN HISTORY"")="""_$P(ICNH,"^",2)_""""
  1. ..I RPC=0 S RETURN(DFN,"ICN HISTORY")=""""_$P(ICNH,"^",2)_""""
  1. .I +ICNH'=-1 D
  1. ..M RETURN(DFN,"ICN HISTORY")=ICNH
  1. ..I RPC=1 D
  1. ...N IEN
  1. ...S IEN="" F S IEN=$O(RETURN(DFN,"ICN HISTORY",IEN)) Q:IEN="" S RETURN(DFN,"ICN HISTORY",IEN)="MPI("_DFN_",""ICN HISTORY"","_IEN_")="_$G(RETURN(DFN,"ICN HISTORY",IEN))
  1. ...S RETURN(DFN,"ICN HISTORY")="MPI("_DFN_",""ICN HISTORY"")="_$G(RETURN(DFN,"ICN HISTORY"))
  1. .;
  1. .D GETCMORH^MPIF002(DFN,.CMORH)
  1. .I +CMORH=-1 D
  1. ..I RPC=1 S RETURN(DFN,"CMOR HISTORY")="MPI("_DFN_",""CMOR HISTORY"")="""_$P(CMORH,"^",2)_""""
  1. ..I RPC=0 S RETURN(DFN,"CMOR HISTORY")=""""_$P(CMORH,"^",2)_""""
  1. .I +CMORH'=-1 D
  1. ..M RETURN(DFN,"CMOR HISTORY")=CMORH
  1. ..I RPC=1 D
  1. ...N IEN
  1. ...S IEN="" F S IEN=$O(RETURN(DFN,"CMOR HISTORY",IEN)) Q:IEN="" S RETURN(DFN,"CMOR HISTORY",IEN)="MPI("_DFN_",""CMOR HISTORY"","_IEN_")="_$G(RETURN(DFN,"CMOR HISTORY",IEN))
  1. ...S RETURN(DFN,"CMOR HISTORY")="MPI("_DFN_",""CMOR HISTORY"")="_$G(RETURN(DFN,"CMOR HISTORY"))
  1. .;
  1. .D EXC(DFN,.RETS,XX)
  1. .I RETS(XX,"EXCEPTIONS")="No Exceptions" D
  1. ..I RPC=1 S RETURN(DFN,"EXCEPTIONS")="MPI("_DFN_",""EXCEPTIONS"")=""NO EXCEPTIONS""",RETURN(DFN,1)=$G(RETURN(DFN,1))_" with No Exceptions"_""""
  1. ..I RPC=0 S RETURN(DFN,"EXCEPTIONS")="""NO EXCEPTIONS""",RETURN(DFN,1)=$G(RETURN(DFN,1))_" with No Exceptions"_""""
  1. .I RETS(XX,"EXCEPTIONS")'="No Exceptions" D
  1. ..I RPC=1 S RETURN(DFN,1)=$G(RETURN(DFN,1))_" with Exceptions"_"""",RETURN(DFN,"EXCEPTIONS")="MPI("_DFN_",""EXCEPTIONS"")="_""""_$G(RETS(XX,"EXCEPTIONS"))_""""
  1. ..I RPC=0 S RETURN(DFN,1)=$G(RETURN(DFN,1))_" with Exceptions"_"""",RETURN(DFN,"EXCEPTIONS")=$G(RETS(XX,"EXCEPTIONS"))
  1. I CNTD>1 D
  1. .I RPC=1 S RETURN(1,"ICNS PROCESSED")="MPI(""ICNS PROCESSED"")="_""""_CNTD_""""
  1. .I RPC=0 S RETURN(1,"ICNS PROCESSED")="MPI(""ICNS PROCESSED"")="_CNTD
  1. Q
  1. EXC(DFN,RET,YY) ;
  1. ; process exceptions into single value
  1. N TVAL,IEN
  1. D GETEX^RGEX03(.VAL,DFN)
  1. I +VAL(0)=0 S RET(YY,"EXCEPTIONS")="No Exceptions"
  1. I +VAL(0)'=0 D
  1. .S IEN=0,TVAL=""
  1. .F IEN=$O(VAL(IEN)) Q:IEN="" S TVAL=TVAL_$P($G(VAL(IEN)),"^")_"^"
  1. .S RET(YY,"EXCEPTIONS")=""""_TVAL_""""
  1. K VAL
  1. Q
  1. ;
  1. INACT(RETURN,ICN) ;
  1. ;RPC to inactivate the ICN passed.
  1. ; RETURN - 1 for successful inactivation or -1^error msg
  1. ; ICN = is the ICN for the patient that is to be inactivated
  1. ;
  1. I $G(ICN)="" S RETURN="-1^No ICN Passed" Q
  1. I +ICN<1 S RETURN="-1^Invalid ICN" Q
  1. N DFN,TICN,ER
  1. S DFN=$$GETDFN^MPIF001(ICN)
  1. I +DFN<0 S RETURN="-1^No such ICN" Q
  1. S TICN=$$GETICN^MPIF001(DFN)
  1. I +TICN'=+ICN S RETURN="-1^ICN is not active" Q
  1. D PAT^MPIFDEL(DFN,.ER)
  1. I ER'="" S RETURN="-1^"_ER Q
  1. S RETURN=1
  1. Q
  1. ;
  1. RCCMOR(RETURN,ICN,CMOR,SSN,A08) ;
  1. ;RPC to change the CMOR value to CMOR for patient with ICN value ICN
  1. ; RETURN - array to return 1 for successful update or -1^ERROR MSG
  1. ; ICN = ICN for the patient that the CMOR is to be changed for
  1. ; CMOR = Station Number of the site that should become the CMOR
  1. ; SSN = Social Security Number of the patient involved, to be used if
  1. ; ICN is not found due to bad AICN x-ref
  1. ; A08 = 1 means trigger A08 message, 0 means don't send A08 msg
  1. ;
  1. I $G(ICN)=""!($G(CMOR)="") S RETURN="-1^Missing Required fields" Q
  1. N DFN,CIEN,DFNS
  1. S DFN=$$GETDFN^MPIF001(ICN)
  1. I DFN'>0&($G(SSN)="") S RETURN(1)="-1^Unknown ICN" Q
  1. I DFN'>0 D
  1. .Q:'$D(^DPT("SSN",SSN))
  1. .S DFNS=$$GETDFNS^MPIF002(SSN)
  1. .S DFN=$$CHK(DFNS,ICN)
  1. I DFN'>0!(+ICN=-1) S RETURN(1)="-1^Unknown ICN" Q
  1. S CIEN=$$IEN^XUAF4(CMOR)
  1. I CIEN'>0 S RETURN(1)="-1^Unknown Institution" Q
  1. S RETURN(1)=$$CHANGE^MPIF001(DFN,CIEN)
  1. I A08=1 D AVAFC^VAFCDD01(DFN) ; trigger A08 msg
  1. I A08=1 S RETURN(1)=RETURN(1)_"^and A08 triggered"
  1. ;trigger a08
  1. Q
  1. ;
  1. CHK(DFNS,ICN) ; see if had broken AICN x-ref, if so, fix it and return
  1. ; correct DFN for patient that's CMOR is to be changed.
  1. ;
  1. N IEN,NODE,NXT,FOUND,DFN
  1. S FOUND=0
  1. F NXT=1:1 S IEN=$P(DFNS,"^",NXT) Q:IEN=""!(FOUND=1) D
  1. .S NODE=$$MPINODE^MPIFAPI(NXT)
  1. .I $P(NODE,"^")=ICN S FOUND=1,^DPT("AICN",ICN,IEN)="",DFN=IEN
  1. I FOUND=0 Q "-1^No such ICN"
  1. Q DFN
  1. ;
  1. GETCARD(RETURN) ; - RPC to get VHIC/CAC card log data
  1. N MPIFDT,MPIFLINE,MPIFCT
  1. K ^TMP("MPIFCARD",$J)
  1. S MPIFCT=0
  1. S RETURN=$NA(^TMP("MPIFCARD",$J))
  1. S MPIFDT=0 F S MPIFDT=$O(^XTMP("MPIFCARD",MPIFDT)) Q:'MPIFDT!(MPIFDT'<DT) D
  1. . S MPIFLINE=0 F S MPIFLINE=$O(^XTMP("MPIFCARD",MPIFDT,MPIFLINE)) Q:'MPIFLINE D
  1. .. S MPIFCT=MPIFCT+1
  1. .. S ^TMP("MPIFCARD",$J,MPIFCT)=^XTMP("MPIFCARD",MPIFDT,MPIFLINE)
  1. Q
  1. ;
  1. PURGCARD(RETURN) ; - RPC called to purge card data for dates specified
  1. N MPIFDT
  1. S MPIFDT=0 F S MPIFDT=$O(^XTMP("MPIFCARD",MPIFDT)) Q:'MPIFDT!(MPIFDT'<DT) K ^XTMP("MPIFCARD",MPIFDT)
  1. S RETURN="1^PURGE SUCCESSFUL"
  1. Q