MPIFP60 ;;OAK/ELZ-MPI VISTA POST-INIT MPIF*1*60 ;OCT 8, 2014
;;1.0;MASTER PATIENT INDEX VISTA;**60**;30 Apr 99;Build 2
;
POST ;
D BMES^XPDUTL("Post-init will populate the new Full ICN fields.")
;
N QUEDUZ,ZTDESC,ZTIO,ZTREQ,ZTRTN,ZTSAVE,ZTDTH
;
I $G(^XTMP("MPIFP60","CURRENT STATUS"))["FINISHED" D BMES^XPDUTL("Post-init already run... Done") Q
;
S QUEDUZ=$S($G(DUZ)="":.5,1:DUZ)
S ZTSAVE("QUEDUZ")="",ZTRTN="DQ^MPIFP60",ZTDESC="MPI/PD - Populate new Full ICN fields",ZTIO="",ZTDTH=$$NOW^XLFDT D ^%ZTLOAD
I $D(ZTSK) D BMES^XPDUTL("Job was queued as Task #"_ZTSK_".")
S ^XTMP("MPIFP60",0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^MPIF*1*60 POST-INIT"
S ^XTMP("MPIFP60","CURRENT STATUS")="QUEUED TASK #"_ZTSK
;
K ZTSK S:$D(ZTQUEUED) ZTREQ="@"
;
Q
;
DQ ;entry point for background job
;
N DFN,MPINODE,ICN,CKSUM,FULLICN,DIE,DA,DR,HISX,HISZ,QUIT,X,Y
;
S ^XTMP("MPIFP60","CURRENT STATUS")="RUNNING AT "_$$NOW^XLFDT
S DFN=+$G(^XTMP("MPIFP60","LAST DFN"))
;
F S DFN=$O(^DPT(DFN)) Q:'DFN D
. ;
. ;Q:DFN>5
. ;
. ; populate FULL ICN field
. S MPINODE=$G(^DPT(DFN,"MPI"))
. S ICN=$P(MPINODE,"^"),CKSUM=$P(MPINODE,"^",2)
. I ICN,CKSUM D
.. S FULLICN=ICN_"V"_CKSUM
.. S DIE="^DPT(",DA=DFN,DR="991.1///^S X=FULLICN" D ^DIE
. ;
. ; populate the FULL ICN HISTORY multiple
. S HISX=0 F S HISX=$O(^DPT(DFN,"MPIFHIS",HISX)) Q:'HISX D
.. S HISZ=$G(^DPT(DFN,"MPIFHIS",HISX,0))
.. S ICN=$P(HISZ,"^"),CKSUM=$P(HISZ,"^",2)
.. I ICN,CKSUM D
... S FULLICN=ICN_"V"_CKSUM
... ;
... ; lets double check it isn't here already
... S (X,QUIT)=0 F S X=$O(^DPT(DFN,"MPIFICNHIS",X)) Q:'X!(QUIT) I ^DPT(DFN,"MPIFICNHIS",X,0)=FULLICN S QUIT=1
... Q:QUIT
... ;
... ; file it
... S X=FULLICN
... S DIC="^DPT("_DFN_",""MPIFICNHIS"",",DIC(0)="L"
... S DA(1)=DFN
... D ^DIC
. ;
. ; ok all done with this patient
. S ^XTMP("MPIFP60","LAST DFN")=DFN
;
; send e-mail to user who queued job
N XMDUZ,XMSUB,MPI,XMY,XMTEXT
S XMDUZ="MPI PACKAGE"
S XMSUB="MPIF*1.0*60 Post Init Complete."
S XMY(QUEDUZ)="",XMTEXT="MPI(1,"
S MPI(1,1)="Post Init for patch MPIF*1.0*60 has run to completion."
S MPI(1,2)="You may now delete routine ^MPIFP60."
D ^XMD
;
S ^XTMP("MPIFP60","CURRENT STATUS")="FINISHED AT "_$$NOW^XLFDT
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFP60 2296 printed Sep 23, 2025@19:47:22 Page 2
MPIFP60 ;;OAK/ELZ-MPI VISTA POST-INIT MPIF*1*60 ;OCT 8, 2014
+1 ;;1.0;MASTER PATIENT INDEX VISTA;**60**;30 Apr 99;Build 2
+2 ;
POST ;
+1 DO BMES^XPDUTL("Post-init will populate the new Full ICN fields.")
+2 ;
+3 NEW QUEDUZ,ZTDESC,ZTIO,ZTREQ,ZTRTN,ZTSAVE,ZTDTH
+4 ;
+5 IF $GET(^XTMP("MPIFP60","CURRENT STATUS"))["FINISHED"
DO BMES^XPDUTL("Post-init already run... Done")
QUIT
+6 ;
+7 SET QUEDUZ=$SELECT($GET(DUZ)="":.5,1:DUZ)
+8 SET ZTSAVE("QUEDUZ")=""
SET ZTRTN="DQ^MPIFP60"
SET ZTDESC="MPI/PD - Populate new Full ICN fields"
SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT
DO ^%ZTLOAD
+9 IF $DATA(ZTSK)
DO BMES^XPDUTL("Job was queued as Task #"_ZTSK_".")
+10 SET ^XTMP("MPIFP60",0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^MPIF*1*60 POST-INIT"
+11 SET ^XTMP("MPIFP60","CURRENT STATUS")="QUEUED TASK #"_ZTSK
+12 ;
+13 KILL ZTSK
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+14 ;
+15 QUIT
+16 ;
DQ ;entry point for background job
+1 ;
+2 NEW DFN,MPINODE,ICN,CKSUM,FULLICN,DIE,DA,DR,HISX,HISZ,QUIT,X,Y
+3 ;
+4 SET ^XTMP("MPIFP60","CURRENT STATUS")="RUNNING AT "_$$NOW^XLFDT
+5 SET DFN=+$GET(^XTMP("MPIFP60","LAST DFN"))
+6 ;
+7 FOR
SET DFN=$ORDER(^DPT(DFN))
if 'DFN
QUIT
Begin DoDot:1
+8 ;
+9 ;Q:DFN>5
+10 ;
+11 ; populate FULL ICN field
+12 SET MPINODE=$GET(^DPT(DFN,"MPI"))
+13 SET ICN=$PIECE(MPINODE,"^")
SET CKSUM=$PIECE(MPINODE,"^",2)
+14 IF ICN
IF CKSUM
Begin DoDot:2
+15 SET FULLICN=ICN_"V"_CKSUM
+16 SET DIE="^DPT("
SET DA=DFN
SET DR="991.1///^S X=FULLICN"
DO ^DIE
End DoDot:2
+17 ;
+18 ; populate the FULL ICN HISTORY multiple
+19 SET HISX=0
FOR
SET HISX=$ORDER(^DPT(DFN,"MPIFHIS",HISX))
if 'HISX
QUIT
Begin DoDot:2
+20 SET HISZ=$GET(^DPT(DFN,"MPIFHIS",HISX,0))
+21 SET ICN=$PIECE(HISZ,"^")
SET CKSUM=$PIECE(HISZ,"^",2)
+22 IF ICN
IF CKSUM
Begin DoDot:3
+23 SET FULLICN=ICN_"V"_CKSUM
+24 ;
+25 ; lets double check it isn't here already
+26 SET (X,QUIT)=0
FOR
SET X=$ORDER(^DPT(DFN,"MPIFICNHIS",X))
if 'X!(QUIT)
QUIT
IF ^DPT(DFN,"MPIFICNHIS",X,0)=FULLICN
SET QUIT=1
+27 if QUIT
QUIT
+28 ;
+29 ; file it
+30 SET X=FULLICN
+31 SET DIC="^DPT("_DFN_",""MPIFICNHIS"","
SET DIC(0)="L"
+32 SET DA(1)=DFN
+33 DO ^DIC
End DoDot:3
End DoDot:2
+34 ;
+35 ; ok all done with this patient
+36 SET ^XTMP("MPIFP60","LAST DFN")=DFN
End DoDot:1
+37 ;
+38 ; send e-mail to user who queued job
+39 NEW XMDUZ,XMSUB,MPI,XMY,XMTEXT
+40 SET XMDUZ="MPI PACKAGE"
+41 SET XMSUB="MPIF*1.0*60 Post Init Complete."
+42 SET XMY(QUEDUZ)=""
SET XMTEXT="MPI(1,"
+43 SET MPI(1,1)="Post Init for patch MPIF*1.0*60 has run to completion."
+44 SET MPI(1,2)="You may now delete routine ^MPIFP60."
+45 DO ^XMD
+46 ;
+47 SET ^XTMP("MPIFP60","CURRENT STATUS")="FINISHED AT "_$$NOW^XLFDT
+48 ;
+49 QUIT
