- 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 Feb 18, 2025@23:37:53 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