1 | MPIFDEL ;SF/MJM,CMC-DELETE PATIENT FROM MPI ;JUL 14, 1998
|
---|
2 | ;;1.0; MASTER PATIENT INDEX VISTA ;**1,3,9,19,17,21,27,28,25**;30 Apr 99
|
---|
3 | ;
|
---|
4 | ;Integration Agreements Utilized:
|
---|
5 | ; ^DPT( - IA #2070
|
---|
6 | ; $$EN^VAFCPID - IA #3015
|
---|
7 | ; START^RGHLLOG - IA #2796
|
---|
8 | ; EXC^RGHLLOG - IA #2796
|
---|
9 | ; STOP^RGHLLOG - IA #2796
|
---|
10 | ; $$DELALLTF^VAFCTFU - IA #2988
|
---|
11 | ; $$EN^VAFCPID - IA #3015
|
---|
12 | ;
|
---|
13 | INTER ;
|
---|
14 | ;Entry point for Inactivate Patient from MPI option [MPIF PAT INACT]
|
---|
15 | ;No input or output variables ^DPT
|
---|
16 | N DIC,DA,DFN,HL,ERROR,CNT,HLRST,ICN,DATE,MPIFCMOR,DTOUT,DUTOUT
|
---|
17 | S ERROR=""
|
---|
18 | S DIC=2,DIC(0)="QEAM" D ^DIC Q:+Y<0 S DFN=+Y
|
---|
19 | S ICN=$P($$MPINODE^MPIFAPI(DFN),"^")
|
---|
20 | I ICN=""!(ICN=-1) W !,"** Patient Does NOT have an ICN **" Q
|
---|
21 | S MPIFCMOR=+$$LKUP^XUAF4(+$$GETVCCI^MPIF001(DFN))
|
---|
22 | I MPIFCMOR=0 W !,"*** Could NOT Inactivate Patient from MPI: Coordinating Master of Record is Not Defined ***" Q
|
---|
23 | 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
|
---|
24 | S ICN=$$GETICN^MPIF001(DFN)
|
---|
25 | ;ask user if they are sure
|
---|
26 | N DIR,Y S DIR(0)="Y",DIR("B")="No"
|
---|
27 | S DIR("A")="Are you sure you want to Inactivate this Patient?"
|
---|
28 | D ^DIR
|
---|
29 | K DIR
|
---|
30 | Q:$D(DTOUT)!($D(DUTOUT))!('Y)
|
---|
31 | D HL7(DFN,.ERROR)
|
---|
32 | I ERROR="" D DELETE(DFN) S ERROR=$$DELALLTF^VAFCTFU(+ICN),ERROR=""
|
---|
33 | I ERROR=""!(ERROR=0) W !,"*** Inactivated on YOUR system, message sent to MPI to Inactivate ***"
|
---|
34 | I ERROR'="" W !,"Error Occurred - "_ERROR
|
---|
35 | Q
|
---|
36 | ;
|
---|
37 | HL7(DFN,ERROR) ; create HL7 message
|
---|
38 | ; check if no subscribers
|
---|
39 | N SUB,HL,CNT,ICN,%,HLDATE,TFC,IEN
|
---|
40 | K HLL,MPIFDEL
|
---|
41 | S ICN=$$GETICN^MPIF001(DFN),ERROR=""
|
---|
42 | Q:$E(ICN,1,3)=$P($$SITE^VASITE(),"^",3)
|
---|
43 | ; ^ don't generate HL7 message if local ICN
|
---|
44 | S SUB=$$QUERYTF^VAFCTFU1(+ICN,"MPIFDEL"),TFC=0
|
---|
45 | I $D(MPIFDEL) D
|
---|
46 | .S IEN="" F S IEN=$O(MPIFDEL(IEN)) Q:IEN="" I +$G(MPIFDEL(IEN))'=$P($$SITE^VASITE,"^") S TFC=TFC+1
|
---|
47 | .I TFC'=0 S ERROR="Attempted to Inactivate an ICN and Patient is Shared. Can't Inactivate patient DFN= "_DFN Q
|
---|
48 | Q:ERROR'=""
|
---|
49 | D NOW^%DTC S HLDATE=$$HLDATE^HLFNC(%,"DT")
|
---|
50 | S HL=0,CNT=0
|
---|
51 | D INIT^HLFNC2("MPIF A29 SERVER",.HL)
|
---|
52 | I HL S ERROR="ERROR = "_HL_" During INIT^HLFNC2 for MPIF A29 Server for Patient DFN= "_DFN D EXC(DFN,ERROR,220)
|
---|
53 | S CNT=CNT+1,HLA("HLS",CNT)="EVN"_HL("FS")_"A29"_HL("FS")_HLDATE_HL("FS")_HL("FS")_""_HL("FS")
|
---|
54 | S CNT=CNT+1,HLA("HLS",CNT)=$$EN^VAFCPID(DFN,"2,3,5")
|
---|
55 | ; message only goes to MPI Link
|
---|
56 | D GENERATE^HLMA("MPIF A29 SERVER","LM",1,.HLRST,"",.HL)
|
---|
57 | I 'HLRST S ERROR="Error During Generate for MPIF A29 Server Error= "_HLRST_" for DFN "_DFN D EXC(DFN,ERROR,220)
|
---|
58 | K MPIFDEL
|
---|
59 | Q
|
---|
60 | ;
|
---|
61 | PAT1 ;entry point for tasked job from .01 in Patient file for ZZ patients
|
---|
62 | N ERR,TDA
|
---|
63 | S ERR=""
|
---|
64 | S TDA=DA
|
---|
65 | L +^DPT("INAC",DA):2
|
---|
66 | Q:'$T
|
---|
67 | D PAT(DA,.ERR)
|
---|
68 | S ZTREQ="@"
|
---|
69 | L -^DPT("INAC",TDA)
|
---|
70 | Q
|
---|
71 | ;
|
---|
72 | PAT(DFN,ERROR) ;Programmer API to Delete MPI entry and remove ICN data from DPT
|
---|
73 | ; if CMOR not defined but is a local CMOR, inactivate and don't log exception
|
---|
74 | S ERROR=""
|
---|
75 | I $G(DFN)="" S ERROR="DFN not defined" Q
|
---|
76 | Q:+$$GETICN^MPIF001(DFN)<0 ; incase has been inactivated already
|
---|
77 | 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
|
---|
78 | D HL7(DFN,.ERROR)
|
---|
79 | I ERROR="" S ERROR=$$DELALLTF^VAFCTFU(+$$GETICN^MPIF001(DFN)),ERROR="" D DELETE(DFN)
|
---|
80 | Q
|
---|
81 | DELETE(DFN) ;
|
---|
82 | N ARRAY,TMP
|
---|
83 | S ARRAY(991.01)="@",ARRAY(991.02)="@",ARRAY(991.03)="@",ARRAY(991.04)="@",ARRAY(991.05)="@"
|
---|
84 | S ARR="ARRAY"
|
---|
85 | S TMP=$$UPDATE^MPIFAPI(DFN,ARR)
|
---|
86 | K ARR
|
---|
87 | Q
|
---|
88 | ;
|
---|
89 | EXC(DFN,ERROR,TYPE) ; subscribers, log exception
|
---|
90 | D START^RGHLLOG(0)
|
---|
91 | D EXC^RGHLLOG(TYPE,ERROR,$G(DFN))
|
---|
92 | D STOP^RGHLLOG(0)
|
---|
93 | Q
|
---|
94 | ;
|
---|
95 | ZZSET(DA,NAME) ;this entry point checks to see if .01 of Patient file entry
|
---|
96 | ;starts with at least two Zs
|
---|
97 | ;if it does and an ICN is present, it will be inactivated
|
---|
98 | ;
|
---|
99 | Q
|
---|
100 | Q:$E(NAME,1,2)'="ZZ"
|
---|
101 | ;task inactivation off
|
---|
102 | I +$$GETICN^MPIF001(DA)>0 D
|
---|
103 | .S ZTRTN="PAT1^MPIFDEL",ZTDESC="Inactivate ICN for 'ZZ'd patient"
|
---|
104 | .S ZTIO="",ZTSAVE("DA")=DA,ZTSAVE("NAME")=NAME
|
---|
105 | .S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,1,0)
|
---|
106 | .D ^%ZTLOAD
|
---|
107 | .K ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTREQ
|
---|
108 | Q
|
---|
109 | ZZKILL(DA,NAME) ;This entry point checks if there is an ICN present, if so
|
---|
110 | ;if will be inactivated, following the inactivate rules
|
---|
111 | Q
|
---|
112 | N ERR S ERR=""
|
---|
113 | I +$$GETICN^MPIF001(DA)>0 D PAT(DA,.ERR)
|
---|
114 | Q
|
---|
115 | SSET(DA,SSN) ; this entry point checks to see if the SSN has been changed
|
---|
116 | ; to 5 leading zeros and if the ICN is present, if so, it will be
|
---|
117 | ; inactivated.
|
---|
118 | Q:$E(SSN,1,5)'="00000"
|
---|
119 | I +$$GETICN^MPIF001(DA)>0 D
|
---|
120 | .S ZTRTN="PAT1^MPIFDEL",ZTDESC="Inactivate ICN for 'ZZ'd patient"
|
---|
121 | .S ZTIO="",ZTSAVE("DA")=DA,ZTSAVE("SSN")="SSN"
|
---|
122 | .S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,1,0)
|
---|
123 | .D ^%ZTLOAD
|
---|
124 | .K ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTREQ
|
---|
125 | Q
|
---|