MPIFRPC ;SFCIO/CMC-MPIF RPC APIS ;26 JUN 01
;;1.0;MASTER PATIENT INDEX VISTA;**20,62**;30 Apr 99;Build 3
;
;Integration Agreements Utilized:
; ^DPT( - #2070
; AVAFC^VAFCDD01 - #3493
; GETEX^RGEX03 - #3554
; NOTICE^DGSEC4 - #3027
; PTSEC^DGSEC4 - #3027
;
ICNSTAT(RETURN,ICN,SSN,RPC) ;
;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
; RETURN - array to return ICN data
; ICN - ICN for the patient in the Patient (#2) file data is to be returned on
; SSN - social security number for the patient in the Patient (#2) file data is to be returned on
; 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
;
N PICN,CNTD,DFN,TICN,LOCAL,XX,RETS,TEXT,CMOR,ICNH,CMORH
I $G(RPC)="" S RPC=1
I $G(ICN)=""&($G(SSN)="") S RETURN="-1^NO ICN OR SSN PASSED" Q
I $G(SSN)'="" S ICN=$$GETICNS^MPIF002(SSN),RETURN(1,"SSN USED")="MPI(""SSN USED"")="_""""_SSN_"""" ; possible to have multiple entries with same SSN
S PICN=ICN,CNTD=0,TEXT=""
F XX=1:1 S ICN=$P(PICN,"^",XX) Q:ICN="" D
.S DFN=$$GETDFN^MPIF001(+ICN),CNTD=CNTD+1
.I +DFN=-1 S RETURN(XX)="-1^NO SUCH ICN "_ICN Q
.I '$D(^DPT(DFN)) S RETURN(DFN)="-1^BAD AICN X-REF, PT FILE ENTRY DOESN'T EXIST DFN= "_DFN_" ICN= "_ICN Q
.; check if this data can be returned and if sensative pt bulletin needed
.N SENS D PTSEC^DGSEC4(.SENS,DFN,1,"Remote Procedure from MPI^RPC from MPI for ICN Information")
.N NOT D NOTICE^DGSEC4(.NOT,DFN,"Remote Procedure from MPI^RPC from MPI for ICN Information")
.I SENS(1)=3!(SENS(1)=4)!(SENS(1)=-1) S RETURN(XX)="-1^SENSATIVE PT ISSUE "_SENS(2)_" DFN= "_DFN_" ICN= "_ICN Q
.I RPC=1 S TEXT="MPI("_DFN_",""DFN"")="
.S RETURN(DFN,"DFN")=TEXT_""""_DFN_""""
.S TICN=$$GETICN^MPIF001(DFN)
.I +TICN<0 D
..I RPC=1 S RETURN(DFN,1)="MPI("_DFN_",1)="_""""_"No current ICN"
..I RPC=0 S RETURN(DFN,1)="""No Current ICN"
.I +TICN>0 D
..I RPC=1 S RETURN(DFN,"ICN")="MPI("_DFN_",""ICN"")="_""""_TICN_""""
..I RPC=0 S RETURN(DFN,"ICN")=""""_TICN_""""
.S LOCAL=""
.I $E($G(RETURN(DFN,"ICN")),1,3)=$P($$SITE^VASITE(),"^",3) S LOCAL="Y"
.I LOCAL=""&(+TICN>0) D
..I RPC=1 S RETURN(DFN,1)="MPI("_DFN_",1)="_""""_"NATIONAL ICN"
..I RPC=0 S RETURN(DFN,1)=""""_"NATIONAL ICN"
.I LOCAL="Y"&(+TICN>0) D
..I RPC=1 S RETURN(DFN,1)="MPI("_DFN_",1)="_""""_"LOCAL ICN"
..I RPC=0 S RETURN(DFN,1)=""""_"LOCAL ICN"_""""
.S CMOR=$$GETVCCI^MPIF001(DFN)
.I +CMOR=-1 S CMOR=$P(CMOR,"^",2)
.I RPC=1 S RETURN(DFN,"CMOR")="MPI("_DFN_",""CMOR"")="""_CMOR_""""
.I RPC=0 S RETURN(DFN,"CMOR")=""""_CMOR_""""
.D GETICNH^MPIF002(DFN,.ICNH)
.I +ICNH=-1 D
..I RPC=1 S RETURN(DFN,"ICN HISTORY")="MPI("_DFN_",""ICN HISTORY"")="""_$P(ICNH,"^",2)_""""
..I RPC=0 S RETURN(DFN,"ICN HISTORY")=""""_$P(ICNH,"^",2)_""""
.I +ICNH'=-1 D
..M RETURN(DFN,"ICN HISTORY")=ICNH
..I RPC=1 D
...N IEN
...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))
...S RETURN(DFN,"ICN HISTORY")="MPI("_DFN_",""ICN HISTORY"")="_$G(RETURN(DFN,"ICN HISTORY"))
.;
.D GETCMORH^MPIF002(DFN,.CMORH)
.I +CMORH=-1 D
..I RPC=1 S RETURN(DFN,"CMOR HISTORY")="MPI("_DFN_",""CMOR HISTORY"")="""_$P(CMORH,"^",2)_""""
..I RPC=0 S RETURN(DFN,"CMOR HISTORY")=""""_$P(CMORH,"^",2)_""""
.I +CMORH'=-1 D
..M RETURN(DFN,"CMOR HISTORY")=CMORH
..I RPC=1 D
...N IEN
...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))
...S RETURN(DFN,"CMOR HISTORY")="MPI("_DFN_",""CMOR HISTORY"")="_$G(RETURN(DFN,"CMOR HISTORY"))
.;
.D EXC(DFN,.RETS,XX)
.I RETS(XX,"EXCEPTIONS")="No Exceptions" D
..I RPC=1 S RETURN(DFN,"EXCEPTIONS")="MPI("_DFN_",""EXCEPTIONS"")=""NO EXCEPTIONS""",RETURN(DFN,1)=$G(RETURN(DFN,1))_" with No Exceptions"_""""
..I RPC=0 S RETURN(DFN,"EXCEPTIONS")="""NO EXCEPTIONS""",RETURN(DFN,1)=$G(RETURN(DFN,1))_" with No Exceptions"_""""
.I RETS(XX,"EXCEPTIONS")'="No Exceptions" D
..I RPC=1 S RETURN(DFN,1)=$G(RETURN(DFN,1))_" with Exceptions"_"""",RETURN(DFN,"EXCEPTIONS")="MPI("_DFN_",""EXCEPTIONS"")="_""""_$G(RETS(XX,"EXCEPTIONS"))_""""
..I RPC=0 S RETURN(DFN,1)=$G(RETURN(DFN,1))_" with Exceptions"_"""",RETURN(DFN,"EXCEPTIONS")=$G(RETS(XX,"EXCEPTIONS"))
I CNTD>1 D
.I RPC=1 S RETURN(1,"ICNS PROCESSED")="MPI(""ICNS PROCESSED"")="_""""_CNTD_""""
.I RPC=0 S RETURN(1,"ICNS PROCESSED")="MPI(""ICNS PROCESSED"")="_CNTD
Q
EXC(DFN,RET,YY) ;
; process exceptions into single value
N TVAL,IEN
D GETEX^RGEX03(.VAL,DFN)
I +VAL(0)=0 S RET(YY,"EXCEPTIONS")="No Exceptions"
I +VAL(0)'=0 D
.S IEN=0,TVAL=""
.F IEN=$O(VAL(IEN)) Q:IEN="" S TVAL=TVAL_$P($G(VAL(IEN)),"^")_"^"
.S RET(YY,"EXCEPTIONS")=""""_TVAL_""""
K VAL
Q
;
INACT(RETURN,ICN) ;
;RPC to inactivate the ICN passed.
; RETURN - 1 for successful inactivation or -1^error msg
; ICN = is the ICN for the patient that is to be inactivated
;
I $G(ICN)="" S RETURN="-1^No ICN Passed" Q
I +ICN<1 S RETURN="-1^Invalid ICN" Q
N DFN,TICN,ER
S DFN=$$GETDFN^MPIF001(ICN)
I +DFN<0 S RETURN="-1^No such ICN" Q
S TICN=$$GETICN^MPIF001(DFN)
I +TICN'=+ICN S RETURN="-1^ICN is not active" Q
D PAT^MPIFDEL(DFN,.ER)
I ER'="" S RETURN="-1^"_ER Q
S RETURN=1
Q
;
RCCMOR(RETURN,ICN,CMOR,SSN,A08) ;
;RPC to change the CMOR value to CMOR for patient with ICN value ICN
; RETURN - array to return 1 for successful update or -1^ERROR MSG
; ICN = ICN for the patient that the CMOR is to be changed for
; CMOR = Station Number of the site that should become the CMOR
; SSN = Social Security Number of the patient involved, to be used if
; ICN is not found due to bad AICN x-ref
; A08 = 1 means trigger A08 message, 0 means don't send A08 msg
;
I $G(ICN)=""!($G(CMOR)="") S RETURN="-1^Missing Required fields" Q
N DFN,CIEN,DFNS
S DFN=$$GETDFN^MPIF001(ICN)
I DFN'>0&($G(SSN)="") S RETURN(1)="-1^Unknown ICN" Q
I DFN'>0 D
.Q:'$D(^DPT("SSN",SSN))
.S DFNS=$$GETDFNS^MPIF002(SSN)
.S DFN=$$CHK(DFNS,ICN)
I DFN'>0!(+ICN=-1) S RETURN(1)="-1^Unknown ICN" Q
S CIEN=$$IEN^XUAF4(CMOR)
I CIEN'>0 S RETURN(1)="-1^Unknown Institution" Q
S RETURN(1)=$$CHANGE^MPIF001(DFN,CIEN)
I A08=1 D AVAFC^VAFCDD01(DFN) ; trigger A08 msg
I A08=1 S RETURN(1)=RETURN(1)_"^and A08 triggered"
;trigger a08
Q
;
CHK(DFNS,ICN) ; see if had broken AICN x-ref, if so, fix it and return
; correct DFN for patient that's CMOR is to be changed.
;
N IEN,NODE,NXT,FOUND,DFN
S FOUND=0
F NXT=1:1 S IEN=$P(DFNS,"^",NXT) Q:IEN=""!(FOUND=1) D
.S NODE=$$MPINODE^MPIFAPI(NXT)
.I $P(NODE,"^")=ICN S FOUND=1,^DPT("AICN",ICN,IEN)="",DFN=IEN
I FOUND=0 Q "-1^No such ICN"
Q DFN
;
GETCARD(RETURN) ; - RPC to get VHIC/CAC card log data
N MPIFDT,MPIFLINE,MPIFCT
K ^TMP("MPIFCARD",$J)
S MPIFCT=0
S RETURN=$NA(^TMP("MPIFCARD",$J))
S MPIFDT=0 F S MPIFDT=$O(^XTMP("MPIFCARD",MPIFDT)) Q:'MPIFDT!(MPIFDT'<DT) D
. S MPIFLINE=0 F S MPIFLINE=$O(^XTMP("MPIFCARD",MPIFDT,MPIFLINE)) Q:'MPIFLINE D
.. S MPIFCT=MPIFCT+1
.. S ^TMP("MPIFCARD",$J,MPIFCT)=^XTMP("MPIFCARD",MPIFDT,MPIFLINE)
Q
;
PURGCARD(RETURN) ; - RPC called to purge card data for dates specified
N MPIFDT
S MPIFDT=0 F S MPIFDT=$O(^XTMP("MPIFCARD",MPIFDT)) Q:'MPIFDT!(MPIFDT'<DT) K ^XTMP("MPIFCARD",MPIFDT)
S RETURN="1^PURGE SUCCESSFUL"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFRPC 7569 printed Apr 09, 2024@21:13:09 Page 2
MPIFRPC ;SFCIO/CMC-MPIF RPC APIS ;26 JUN 01
+1 ;;1.0;MASTER PATIENT INDEX VISTA;**20,62**;30 Apr 99;Build 3
+2 ;
+3 ;Integration Agreements Utilized:
+4 ; ^DPT( - #2070
+5 ; AVAFC^VAFCDD01 - #3493
+6 ; GETEX^RGEX03 - #3554
+7 ; NOTICE^DGSEC4 - #3027
+8 ; PTSEC^DGSEC4 - #3027
+9 ;
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
+2 ; RETURN - array to return ICN data
+3 ; ICN - ICN for the patient in the Patient (#2) file data is to be returned on
+4 ; SSN - social security number for the patient in the Patient (#2) file data is to be returned on
+5 ; 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
+6 ;
+7 NEW PICN,CNTD,DFN,TICN,LOCAL,XX,RETS,TEXT,CMOR,ICNH,CMORH
+8 IF $GET(RPC)=""
SET RPC=1
+9 IF $GET(ICN)=""&($GET(SSN)="")
SET RETURN="-1^NO ICN OR SSN PASSED"
QUIT
+10 ; possible to have multiple entries with same SSN
IF $GET(SSN)'=""
SET ICN=$$GETICNS^MPIF002(SSN)
SET RETURN(1,"SSN USED")="MPI(""SSN USED"")="_""""_SSN_""""
+11 SET PICN=ICN
SET CNTD=0
SET TEXT=""
+12 FOR XX=1:1
SET ICN=$PIECE(PICN,"^",XX)
if ICN=""
QUIT
Begin DoDot:1
+13 SET DFN=$$GETDFN^MPIF001(+ICN)
SET CNTD=CNTD+1
+14 IF +DFN=-1
SET RETURN(XX)="-1^NO SUCH ICN "_ICN
QUIT
+15 IF '$DATA(^DPT(DFN))
SET RETURN(DFN)="-1^BAD AICN X-REF, PT FILE ENTRY DOESN'T EXIST DFN= "_DFN_" ICN= "_ICN
QUIT
+16 ; check if this data can be returned and if sensative pt bulletin needed
+17 NEW SENS
DO PTSEC^DGSEC4(.SENS,DFN,1,"Remote Procedure from MPI^RPC from MPI for ICN Information")
+18 NEW NOT
DO NOTICE^DGSEC4(.NOT,DFN,"Remote Procedure from MPI^RPC from MPI for ICN Information")
+19 IF SENS(1)=3!(SENS(1)=4)!(SENS(1)=-1)
SET RETURN(XX)="-1^SENSATIVE PT ISSUE "_SENS(2)_" DFN= "_DFN_" ICN= "_ICN
QUIT
+20 IF RPC=1
SET TEXT="MPI("_DFN_",""DFN"")="
+21 SET RETURN(DFN,"DFN")=TEXT_""""_DFN_""""
+22 SET TICN=$$GETICN^MPIF001(DFN)
+23 IF +TICN<0
Begin DoDot:2
+24 IF RPC=1
SET RETURN(DFN,1)="MPI("_DFN_",1)="_""""_"No current ICN"
+25 IF RPC=0
SET RETURN(DFN,1)="""No Current ICN"
End DoDot:2
+26 IF +TICN>0
Begin DoDot:2
+27 IF RPC=1
SET RETURN(DFN,"ICN")="MPI("_DFN_",""ICN"")="_""""_TICN_""""
+28 IF RPC=0
SET RETURN(DFN,"ICN")=""""_TICN_""""
End DoDot:2
+29 SET LOCAL=""
+30 IF $EXTRACT($GET(RETURN(DFN,"ICN")),1,3)=$PIECE($$SITE^VASITE(),"^",3)
SET LOCAL="Y"
+31 IF LOCAL=""&(+TICN>0)
Begin DoDot:2
+32 IF RPC=1
SET RETURN(DFN,1)="MPI("_DFN_",1)="_""""_"NATIONAL ICN"
+33 IF RPC=0
SET RETURN(DFN,1)=""""_"NATIONAL ICN"
End DoDot:2
+34 IF LOCAL="Y"&(+TICN>0)
Begin DoDot:2
+35 IF RPC=1
SET RETURN(DFN,1)="MPI("_DFN_",1)="_""""_"LOCAL ICN"
+36 IF RPC=0
SET RETURN(DFN,1)=""""_"LOCAL ICN"_""""
End DoDot:2
+37 SET CMOR=$$GETVCCI^MPIF001(DFN)
+38 IF +CMOR=-1
SET CMOR=$PIECE(CMOR,"^",2)
+39 IF RPC=1
SET RETURN(DFN,"CMOR")="MPI("_DFN_",""CMOR"")="""_CMOR_""""
+40 IF RPC=0
SET RETURN(DFN,"CMOR")=""""_CMOR_""""
+41 DO GETICNH^MPIF002(DFN,.ICNH)
+42 IF +ICNH=-1
Begin DoDot:2
+43 IF RPC=1
SET RETURN(DFN,"ICN HISTORY")="MPI("_DFN_",""ICN HISTORY"")="""_$PIECE(ICNH,"^",2)_""""
+44 IF RPC=0
SET RETURN(DFN,"ICN HISTORY")=""""_$PIECE(ICNH,"^",2)_""""
End DoDot:2
+45 IF +ICNH'=-1
Begin DoDot:2
+46 MERGE RETURN(DFN,"ICN HISTORY")=ICNH
+47 IF RPC=1
Begin DoDot:3
+48 NEW IEN
+49 SET IEN=""
FOR
SET IEN=$ORDER(RETURN(DFN,"ICN HISTORY",IEN))
if IEN=""
QUIT
SET RETURN(DFN,"ICN HISTORY",IEN)="MPI("_DFN_",""ICN HISTORY"","_IEN_")="_$GET(RETURN(DFN,"ICN HISTORY",IEN))
+50 SET RETURN(DFN,"ICN HISTORY")="MPI("_DFN_",""ICN HISTORY"")="_$GET(RETURN(DFN,"ICN HISTORY"))
End DoDot:3
End DoDot:2
+51 ;
+52 DO GETCMORH^MPIF002(DFN,.CMORH)
+53 IF +CMORH=-1
Begin DoDot:2
+54 IF RPC=1
SET RETURN(DFN,"CMOR HISTORY")="MPI("_DFN_",""CMOR HISTORY"")="""_$PIECE(CMORH,"^",2)_""""
+55 IF RPC=0
SET RETURN(DFN,"CMOR HISTORY")=""""_$PIECE(CMORH,"^",2)_""""
End DoDot:2
+56 IF +CMORH'=-1
Begin DoDot:2
+57 MERGE RETURN(DFN,"CMOR HISTORY")=CMORH
+58 IF RPC=1
Begin DoDot:3
+59 NEW IEN
+60 SET IEN=""
FOR
SET IEN=$ORDER(RETURN(DFN,"CMOR HISTORY",IEN))
if IEN=""
QUIT
SET RETURN(DFN,"CMOR HISTORY",IEN)="MPI("_DFN_",""CMOR HISTORY"","_IEN_")="_$GET(RETURN(DFN,"CMOR HISTORY",IEN))
+61 SET RETURN(DFN,"CMOR HISTORY")="MPI("_DFN_",""CMOR HISTORY"")="_$GET(RETURN(DFN,"CMOR HISTORY"))
End DoDot:3
End DoDot:2
+62 ;
+63 DO EXC(DFN,.RETS,XX)
+64 IF RETS(XX,"EXCEPTIONS")="No Exceptions"
Begin DoDot:2
+65 IF RPC=1
SET RETURN(DFN,"EXCEPTIONS")="MPI("_DFN_",""EXCEPTIONS"")=""NO EXCEPTIONS"""
SET RETURN(DFN,1)=$GET(RETURN(DFN,1))_" with No Exceptions"_""""
+66 IF RPC=0
SET RETURN(DFN,"EXCEPTIONS")="""NO EXCEPTIONS"""
SET RETURN(DFN,1)=$GET(RETURN(DFN,1))_" with No Exceptions"_""""
End DoDot:2
+67 IF RETS(XX,"EXCEPTIONS")'="No Exceptions"
Begin DoDot:2
+68 IF RPC=1
SET RETURN(DFN,1)=$GET(RETURN(DFN,1))_" with Exceptions"_""""
SET RETURN(DFN,"EXCEPTIONS")="MPI("_DFN_",""EXCEPTIONS"")="_""""_$GET(RETS(XX,"EXCEPTIONS"))_""""
+69 IF RPC=0
SET RETURN(DFN,1)=$GET(RETURN(DFN,1))_" with Exceptions"_""""
SET RETURN(DFN,"EXCEPTIONS")=$GET(RETS(XX,"EXCEPTIONS"))
End DoDot:2
End DoDot:1
+70 IF CNTD>1
Begin DoDot:1
+71 IF RPC=1
SET RETURN(1,"ICNS PROCESSED")="MPI(""ICNS PROCESSED"")="_""""_CNTD_""""
+72 IF RPC=0
SET RETURN(1,"ICNS PROCESSED")="MPI(""ICNS PROCESSED"")="_CNTD
End DoDot:1
+73 QUIT
EXC(DFN,RET,YY) ;
+1 ; process exceptions into single value
+2 NEW TVAL,IEN
+3 DO GETEX^RGEX03(.VAL,DFN)
+4 IF +VAL(0)=0
SET RET(YY,"EXCEPTIONS")="No Exceptions"
+5 IF +VAL(0)'=0
Begin DoDot:1
+6 SET IEN=0
SET TVAL=""
+7 FOR IEN=$ORDER(VAL(IEN))
if IEN=""
QUIT
SET TVAL=TVAL_$PIECE($GET(VAL(IEN)),"^")_"^"
+8 SET RET(YY,"EXCEPTIONS")=""""_TVAL_""""
End DoDot:1
+9 KILL VAL
+10 QUIT
+11 ;
INACT(RETURN,ICN) ;
+1 ;RPC to inactivate the ICN passed.
+2 ; RETURN - 1 for successful inactivation or -1^error msg
+3 ; ICN = is the ICN for the patient that is to be inactivated
+4 ;
+5 IF $GET(ICN)=""
SET RETURN="-1^No ICN Passed"
QUIT
+6 IF +ICN<1
SET RETURN="-1^Invalid ICN"
QUIT
+7 NEW DFN,TICN,ER
+8 SET DFN=$$GETDFN^MPIF001(ICN)
+9 IF +DFN<0
SET RETURN="-1^No such ICN"
QUIT
+10 SET TICN=$$GETICN^MPIF001(DFN)
+11 IF +TICN'=+ICN
SET RETURN="-1^ICN is not active"
QUIT
+12 DO PAT^MPIFDEL(DFN,.ER)
+13 IF ER'=""
SET RETURN="-1^"_ER
QUIT
+14 SET RETURN=1
+15 QUIT
+16 ;
RCCMOR(RETURN,ICN,CMOR,SSN,A08) ;
+1 ;RPC to change the CMOR value to CMOR for patient with ICN value ICN
+2 ; RETURN - array to return 1 for successful update or -1^ERROR MSG
+3 ; ICN = ICN for the patient that the CMOR is to be changed for
+4 ; CMOR = Station Number of the site that should become the CMOR
+5 ; SSN = Social Security Number of the patient involved, to be used if
+6 ; ICN is not found due to bad AICN x-ref
+7 ; A08 = 1 means trigger A08 message, 0 means don't send A08 msg
+8 ;
+9 IF $GET(ICN)=""!($GET(CMOR)="")
SET RETURN="-1^Missing Required fields"
QUIT
+10 NEW DFN,CIEN,DFNS
+11 SET DFN=$$GETDFN^MPIF001(ICN)
+12 IF DFN'>0&($GET(SSN)="")
SET RETURN(1)="-1^Unknown ICN"
QUIT
+13 IF DFN'>0
Begin DoDot:1
+14 if '$DATA(^DPT("SSN",SSN))
QUIT
+15 SET DFNS=$$GETDFNS^MPIF002(SSN)
+16 SET DFN=$$CHK(DFNS,ICN)
End DoDot:1
+17 IF DFN'>0!(+ICN=-1)
SET RETURN(1)="-1^Unknown ICN"
QUIT
+18 SET CIEN=$$IEN^XUAF4(CMOR)
+19 IF CIEN'>0
SET RETURN(1)="-1^Unknown Institution"
QUIT
+20 SET RETURN(1)=$$CHANGE^MPIF001(DFN,CIEN)
+21 ; trigger A08 msg
IF A08=1
DO AVAFC^VAFCDD01(DFN)
+22 IF A08=1
SET RETURN(1)=RETURN(1)_"^and A08 triggered"
+23 ;trigger a08
+24 QUIT
+25 ;
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.
+2 ;
+3 NEW IEN,NODE,NXT,FOUND,DFN
+4 SET FOUND=0
+5 FOR NXT=1:1
SET IEN=$PIECE(DFNS,"^",NXT)
if IEN=""!(FOUND=1)
QUIT
Begin DoDot:1
+6 SET NODE=$$MPINODE^MPIFAPI(NXT)
+7 IF $PIECE(NODE,"^")=ICN
SET FOUND=1
SET ^DPT("AICN",ICN,IEN)=""
SET DFN=IEN
End DoDot:1
+8 IF FOUND=0
QUIT "-1^No such ICN"
+9 QUIT DFN
+10 ;
GETCARD(RETURN) ; - RPC to get VHIC/CAC card log data
+1 NEW MPIFDT,MPIFLINE,MPIFCT
+2 KILL ^TMP("MPIFCARD",$JOB)
+3 SET MPIFCT=0
+4 SET RETURN=$NAME(^TMP("MPIFCARD",$JOB))
+5 SET MPIFDT=0
FOR
SET MPIFDT=$ORDER(^XTMP("MPIFCARD",MPIFDT))
if 'MPIFDT!(MPIFDT'<DT)
QUIT
Begin DoDot:1
+6 SET MPIFLINE=0
FOR
SET MPIFLINE=$ORDER(^XTMP("MPIFCARD",MPIFDT,MPIFLINE))
if 'MPIFLINE
QUIT
Begin DoDot:2
+7 SET MPIFCT=MPIFCT+1
+8 SET ^TMP("MPIFCARD",$JOB,MPIFCT)=^XTMP("MPIFCARD",MPIFDT,MPIFLINE)
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
PURGCARD(RETURN) ; - RPC called to purge card data for dates specified
+1 NEW MPIFDT
+2 SET MPIFDT=0
FOR
SET MPIFDT=$ORDER(^XTMP("MPIFCARD",MPIFDT))
if 'MPIFDT!(MPIFDT'<DT)
QUIT
KILL ^XTMP("MPIFCARD",MPIFDT)
+3 SET RETURN="1^PURGE SUCCESSFUL"
+4 QUIT
