- 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 Mar 13, 2025@21:16:06 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
