MPIFDEL ;SF/MJM,CMC-DELETE PATIENT FROM MPI ;JUL 14, 1998
;;1.0; MASTER PATIENT INDEX VISTA ;**1,3,9,19,17,21,27,28,25**;30 Apr 99
;
;Integration Agreements Utilized:
; ^DPT( - IA #2070
; $$EN^VAFCPID - IA #3015
; START^RGHLLOG - IA #2796
; EXC^RGHLLOG - IA #2796
; STOP^RGHLLOG - IA #2796
; $$DELALLTF^VAFCTFU - IA #2988
; $$EN^VAFCPID - IA #3015
;
INTER ;
;Entry point for Inactivate Patient from MPI option [MPIF PAT INACT]
;No input or output variables ^DPT
N DIC,DA,DFN,HL,ERROR,CNT,HLRST,ICN,DATE,MPIFCMOR,DTOUT,DUTOUT
S ERROR=""
S DIC=2,DIC(0)="QEAM" D ^DIC Q:+Y<0 S DFN=+Y
S ICN=$P($$MPINODE^MPIFAPI(DFN),"^")
I ICN=""!(ICN=-1) W !,"** Patient Does NOT have an ICN **" Q
S MPIFCMOR=+$$LKUP^XUAF4(+$$GETVCCI^MPIF001(DFN))
I MPIFCMOR=0 W !,"*** Could NOT Inactivate Patient from MPI: Coordinating Master of Record is Not Defined ***" Q
I $$PAT^MPIFNQ(DFN)'=+$P($$SITE^VASITE,"^",3) W !,"*** Could NOT Inactivate Patient from MPI: Coordinating Master of record site is '"_$$CMOR2^MPIF001(DFN)_"'. You MUST be the CMOR ***" Q
S ICN=$$GETICN^MPIF001(DFN)
;ask user if they are sure
N DIR,Y S DIR(0)="Y",DIR("B")="No"
S DIR("A")="Are you sure you want to Inactivate this Patient?"
D ^DIR
K DIR
Q:$D(DTOUT)!($D(DUTOUT))!('Y)
D HL7(DFN,.ERROR)
I ERROR="" D DELETE(DFN) S ERROR=$$DELALLTF^VAFCTFU(+ICN),ERROR=""
I ERROR=""!(ERROR=0) W !,"*** Inactivated on YOUR system, message sent to MPI to Inactivate ***"
I ERROR'="" W !,"Error Occurred - "_ERROR
Q
;
HL7(DFN,ERROR) ; create HL7 message
; check if no subscribers
N SUB,HL,CNT,ICN,%,HLDATE,TFC,IEN
K HLL,MPIFDEL
S ICN=$$GETICN^MPIF001(DFN),ERROR=""
Q:$E(ICN,1,3)=$P($$SITE^VASITE(),"^",3)
; ^ don't generate HL7 message if local ICN
S SUB=$$QUERYTF^VAFCTFU1(+ICN,"MPIFDEL"),TFC=0
I $D(MPIFDEL) D
.S IEN="" F S IEN=$O(MPIFDEL(IEN)) Q:IEN="" I +$G(MPIFDEL(IEN))'=$P($$SITE^VASITE,"^") S TFC=TFC+1
.I TFC'=0 S ERROR="Attempted to Inactivate an ICN and Patient is Shared. Can't Inactivate patient DFN= "_DFN Q
Q:ERROR'=""
D NOW^%DTC S HLDATE=$$HLDATE^HLFNC(%,"DT")
S HL=0,CNT=0
D INIT^HLFNC2("MPIF A29 SERVER",.HL)
I HL S ERROR="ERROR = "_HL_" During INIT^HLFNC2 for MPIF A29 Server for Patient DFN= "_DFN D EXC(DFN,ERROR,220)
S CNT=CNT+1,HLA("HLS",CNT)="EVN"_HL("FS")_"A29"_HL("FS")_HLDATE_HL("FS")_HL("FS")_""_HL("FS")
S CNT=CNT+1,HLA("HLS",CNT)=$$EN^VAFCPID(DFN,"2,3,5")
; message only goes to MPI Link
D GENERATE^HLMA("MPIF A29 SERVER","LM",1,.HLRST,"",.HL)
I 'HLRST S ERROR="Error During Generate for MPIF A29 Server Error= "_HLRST_" for DFN "_DFN D EXC(DFN,ERROR,220)
K MPIFDEL
Q
;
PAT1 ;entry point for tasked job from .01 in Patient file for ZZ patients
N ERR,TDA
S ERR=""
S TDA=DA
L +^DPT("INAC",DA):2
Q:'$T
D PAT(DA,.ERR)
S ZTREQ="@"
L -^DPT("INAC",TDA)
Q
;
PAT(DFN,ERROR) ;Programmer API to Delete MPI entry and remove ICN data from DPT
; if CMOR not defined but is a local CMOR, inactivate and don't log exception
S ERROR=""
I $G(DFN)="" S ERROR="DFN not defined" Q
Q:+$$GETICN^MPIF001(DFN)<0 ; incase has been inactivated already
I $E($P($$GETICN^MPIF001(DFN),"^"),1,3)'=+$P($$SITE^VASITE,"^",3),+$$PAT^MPIFNQ(DFN)'=+$P($$SITE^VASITE,"^",3) S ERROR="Attempt to Inactivate Patient, DFN= "_DFN_" this site is not the CMOR for this patient" D EXC(DFN,ERROR,226) Q
D HL7(DFN,.ERROR)
I ERROR="" S ERROR=$$DELALLTF^VAFCTFU(+$$GETICN^MPIF001(DFN)),ERROR="" D DELETE(DFN)
Q
DELETE(DFN) ;
N ARRAY,TMP
S ARRAY(991.01)="@",ARRAY(991.02)="@",ARRAY(991.03)="@",ARRAY(991.04)="@",ARRAY(991.05)="@"
S ARR="ARRAY"
S TMP=$$UPDATE^MPIFAPI(DFN,ARR)
K ARR
Q
;
EXC(DFN,ERROR,TYPE) ; subscribers, log exception
D START^RGHLLOG(0)
D EXC^RGHLLOG(TYPE,ERROR,$G(DFN))
D STOP^RGHLLOG(0)
Q
;
ZZSET(DA,NAME) ;this entry point checks to see if .01 of Patient file entry
;starts with at least two Zs
;if it does and an ICN is present, it will be inactivated
;
Q
Q:$E(NAME,1,2)'="ZZ"
;task inactivation off
I +$$GETICN^MPIF001(DA)>0 D
.S ZTRTN="PAT1^MPIFDEL",ZTDESC="Inactivate ICN for 'ZZ'd patient"
.S ZTIO="",ZTSAVE("DA")=DA,ZTSAVE("NAME")=NAME
.S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,1,0)
.D ^%ZTLOAD
.K ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTREQ
Q
ZZKILL(DA,NAME) ;This entry point checks if there is an ICN present, if so
;if will be inactivated, following the inactivate rules
Q
N ERR S ERR=""
I +$$GETICN^MPIF001(DA)>0 D PAT(DA,.ERR)
Q
SSET(DA,SSN) ; this entry point checks to see if the SSN has been changed
; to 5 leading zeros and if the ICN is present, if so, it will be
; inactivated.
Q:$E(SSN,1,5)'="00000"
I +$$GETICN^MPIF001(DA)>0 D
.S ZTRTN="PAT1^MPIFDEL",ZTDESC="Inactivate ICN for 'ZZ'd patient"
.S ZTIO="",ZTSAVE("DA")=DA,ZTSAVE("SSN")="SSN"
.S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,1,0)
.D ^%ZTLOAD
.K ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTREQ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFDEL 4942 printed Dec 13, 2024@02:11:03 Page 2
MPIFDEL ;SF/MJM,CMC-DELETE PATIENT FROM MPI ;JUL 14, 1998
+1 ;;1.0; MASTER PATIENT INDEX VISTA ;**1,3,9,19,17,21,27,28,25**;30 Apr 99
+2 ;
+3 ;Integration Agreements Utilized:
+4 ; ^DPT( - IA #2070
+5 ; $$EN^VAFCPID - IA #3015
+6 ; START^RGHLLOG - IA #2796
+7 ; EXC^RGHLLOG - IA #2796
+8 ; STOP^RGHLLOG - IA #2796
+9 ; $$DELALLTF^VAFCTFU - IA #2988
+10 ; $$EN^VAFCPID - IA #3015
+11 ;
INTER ;
+1 ;Entry point for Inactivate Patient from MPI option [MPIF PAT INACT]
+2 ;No input or output variables ^DPT
+3 NEW DIC,DA,DFN,HL,ERROR,CNT,HLRST,ICN,DATE,MPIFCMOR,DTOUT,DUTOUT
+4 SET ERROR=""
+5 SET DIC=2
SET DIC(0)="QEAM"
DO ^DIC
if +Y<0
QUIT
SET DFN=+Y
+6 SET ICN=$PIECE($$MPINODE^MPIFAPI(DFN),"^")
+7 IF ICN=""!(ICN=-1)
WRITE !,"** Patient Does NOT have an ICN **"
QUIT
+8 SET MPIFCMOR=+$$LKUP^XUAF4(+$$GETVCCI^MPIF001(DFN))
+9 IF MPIFCMOR=0
WRITE !,"*** Could NOT Inactivate Patient from MPI: Coordinating Master of Record is Not Defined ***"
QUIT
+10 IF $$PAT^MPIFNQ(DFN)'=+$PIECE($$SITE^VASITE,"^",3)
WRITE !,"*** Could NOT Inactivate Patient from MPI: Coordinating Master of record site is '"_$$CMOR2^MPIF001(DFN)_"'. You MUST be the CMOR ***"
QUIT
+11 SET ICN=$$GETICN^MPIF001(DFN)
+12 ;ask user if they are sure
+13 NEW DIR,Y
SET DIR(0)="Y"
SET DIR("B")="No"
+14 SET DIR("A")="Are you sure you want to Inactivate this Patient?"
+15 DO ^DIR
+16 KILL DIR
+17 if $DATA(DTOUT)!($DATA(DUTOUT))!('Y)
QUIT
+18 DO HL7(DFN,.ERROR)
+19 IF ERROR=""
DO DELETE(DFN)
SET ERROR=$$DELALLTF^VAFCTFU(+ICN)
SET ERROR=""
+20 IF ERROR=""!(ERROR=0)
WRITE !,"*** Inactivated on YOUR system, message sent to MPI to Inactivate ***"
+21 IF ERROR'=""
WRITE !,"Error Occurred - "_ERROR
+22 QUIT
+23 ;
HL7(DFN,ERROR) ; create HL7 message
+1 ; check if no subscribers
+2 NEW SUB,HL,CNT,ICN,%,HLDATE,TFC,IEN
+3 KILL HLL,MPIFDEL
+4 SET ICN=$$GETICN^MPIF001(DFN)
SET ERROR=""
+5 if $EXTRACT(ICN,1,3)=$PIECE($$SITE^VASITE(),"^",3)
QUIT
+6 ; ^ don't generate HL7 message if local ICN
+7 SET SUB=$$QUERYTF^VAFCTFU1(+ICN,"MPIFDEL")
SET TFC=0
+8 IF $DATA(MPIFDEL)
Begin DoDot:1
+9 SET IEN=""
FOR
SET IEN=$ORDER(MPIFDEL(IEN))
if IEN=""
QUIT
IF +$GET(MPIFDEL(IEN))'=$PIECE($$SITE^VASITE,"^")
SET TFC=TFC+1
+10 IF TFC'=0
SET ERROR="Attempted to Inactivate an ICN and Patient is Shared. Can't Inactivate patient DFN= "_DFN
QUIT
End DoDot:1
+11 if ERROR'=""
QUIT
+12 DO NOW^%DTC
SET HLDATE=$$HLDATE^HLFNC(%,"DT")
+13 SET HL=0
SET CNT=0
+14 DO INIT^HLFNC2("MPIF A29 SERVER",.HL)
+15 IF HL
SET ERROR="ERROR = "_HL_" During INIT^HLFNC2 for MPIF A29 Server for Patient DFN= "_DFN
DO EXC(DFN,ERROR,220)
+16 SET CNT=CNT+1
SET HLA("HLS",CNT)="EVN"_HL("FS")_"A29"_HL("FS")_HLDATE_HL("FS")_HL("FS")_""_HL("FS")
+17 SET CNT=CNT+1
SET HLA("HLS",CNT)=$$EN^VAFCPID(DFN,"2,3,5")
+18 ; message only goes to MPI Link
+19 DO GENERATE^HLMA("MPIF A29 SERVER","LM",1,.HLRST,"",.HL)
+20 IF 'HLRST
SET ERROR="Error During Generate for MPIF A29 Server Error= "_HLRST_" for DFN "_DFN
DO EXC(DFN,ERROR,220)
+21 KILL MPIFDEL
+22 QUIT
+23 ;
PAT1 ;entry point for tasked job from .01 in Patient file for ZZ patients
+1 NEW ERR,TDA
+2 SET ERR=""
+3 SET TDA=DA
+4 LOCK +^DPT("INAC",DA):2
+5 if '$TEST
QUIT
+6 DO PAT(DA,.ERR)
+7 SET ZTREQ="@"
+8 LOCK -^DPT("INAC",TDA)
+9 QUIT
+10 ;
PAT(DFN,ERROR) ;Programmer API to Delete MPI entry and remove ICN data from DPT
+1 ; if CMOR not defined but is a local CMOR, inactivate and don't log exception
+2 SET ERROR=""
+3 IF $GET(DFN)=""
SET ERROR="DFN not defined"
QUIT
+4 ; incase has been inactivated already
if +$$GETICN^MPIF001(DFN)<0
QUIT
+5 IF $EXTRACT($PIECE($$GETICN^MPIF001(DFN),"^"),1,3)'=+$PIECE($$SITE^VASITE,"^",3)
IF +$$PAT^MPIFNQ(DFN)'=+$PIECE($$SITE^VASITE,"^",3)
SET ERROR="Attempt to Inactivate Patient, DFN= "_DFN_" this site is not the CMOR for this patient"
DO EXC(DFN,ERROR,226)
QUIT
+6 DO HL7(DFN,.ERROR)
+7 IF ERROR=""
SET ERROR=$$DELALLTF^VAFCTFU(+$$GETICN^MPIF001(DFN))
SET ERROR=""
DO DELETE(DFN)
+8 QUIT
DELETE(DFN) ;
+1 NEW ARRAY,TMP
+2 SET ARRAY(991.01)="@"
SET ARRAY(991.02)="@"
SET ARRAY(991.03)="@"
SET ARRAY(991.04)="@"
SET ARRAY(991.05)="@"
+3 SET ARR="ARRAY"
+4 SET TMP=$$UPDATE^MPIFAPI(DFN,ARR)
+5 KILL ARR
+6 QUIT
+7 ;
EXC(DFN,ERROR,TYPE) ; subscribers, log exception
+1 DO START^RGHLLOG(0)
+2 DO EXC^RGHLLOG(TYPE,ERROR,$GET(DFN))
+3 DO STOP^RGHLLOG(0)
+4 QUIT
+5 ;
ZZSET(DA,NAME) ;this entry point checks to see if .01 of Patient file entry
+1 ;starts with at least two Zs
+2 ;if it does and an ICN is present, it will be inactivated
+3 ;
+4 QUIT
+5 if $EXTRACT(NAME,1,2)'="ZZ"
QUIT
+6 ;task inactivation off
+7 IF +$$GETICN^MPIF001(DA)>0
Begin DoDot:1
+8 SET ZTRTN="PAT1^MPIFDEL"
SET ZTDESC="Inactivate ICN for 'ZZ'd patient"
+9 SET ZTIO=""
SET ZTSAVE("DA")=DA
SET ZTSAVE("NAME")=NAME
+10 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,1,0)
+11 DO ^%ZTLOAD
+12 KILL ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTREQ
End DoDot:1
+13 QUIT
ZZKILL(DA,NAME) ;This entry point checks if there is an ICN present, if so
+1 ;if will be inactivated, following the inactivate rules
+2 QUIT
+3 NEW ERR
SET ERR=""
+4 IF +$$GETICN^MPIF001(DA)>0
DO PAT(DA,.ERR)
+5 QUIT
SSET(DA,SSN) ; this entry point checks to see if the SSN has been changed
+1 ; to 5 leading zeros and if the ICN is present, if so, it will be
+2 ; inactivated.
+3 if $EXTRACT(SSN,1,5)'="00000"
QUIT
+4 IF +$$GETICN^MPIF001(DA)>0
Begin DoDot:1
+5 SET ZTRTN="PAT1^MPIFDEL"
SET ZTDESC="Inactivate ICN for 'ZZ'd patient"
+6 SET ZTIO=""
SET ZTSAVE("DA")=DA
SET ZTSAVE("SSN")="SSN"
+7 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,1,0)
+8 DO ^%ZTLOAD
+9 KILL ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTREQ
End DoDot:1
+10 QUIT
