MPIFSEED ;BP/CMC-SEEDING OF A31s TO MPI AND SUB CLEANUP ;FEB 5, 2002
;;1.0; MASTER PATIENT INDEX VISTA ;**22,24,27**;30 Apr 99
;
;CHANGING SEEDING TO SEND X NUMBER OF MESSAGES EACH TIME BACK GROUND
; JOB XXX RUNS UNTIL ALL ARE SENT. KEEPING TRACK OF WHERE WE ARE AT
; FOR THE NEXT JOB TO START AT
; SEND E-MAIL WHEN FINISH EACH GROUP AND A SITE COMPLETES SEEDING
; ALL PATIENTS.
;
; Intregration Agreement Utilized:
;
; ^DPT("AICNL", ^DPT("AICN", ^DPT("AMPIMIS", ^DPT("ASCN2" - #2070
; ^DPT( - #2070
;
; $O through Patient file (#2) Sending A31 message for any patients
; with an active National ICN.
;
EN ;
I $D(^XTMP("MPIF_SEEDING"))&('$D(^XTMP("MPIF_SEEDING","STOPPED"))) Q
; ^ Seeding job is already running
D START
Q
QUEUE ;
I $D(^XTMP("MPIF_SEEDING"))&('$D(^XTMP("MPIF_SEEDING","STOPPED"))) Q
; ^ Seeding job is already running
S ZTRTN="START^MPIFSEED",ZTDESC="A31 SEEDING FOR SITE"
D NOW^%DTC
S ZTIO="",ZTDTH=%
I $D(DUZ) S ZTSAVE("DUZ")=DUZ
D ^%ZTLOAD
D HOME^%ZIS K IO("Q")
K ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,%
Q
;
START N ICN,DFN,SSN,CNT,XICN,SITE,ARRAY,ARR,SUB,A31,A31E,NODE,IEN,STOP,MANY
N OICN,OA31E,OCNT,NODE,STICN
I $D(ZTQUEUED) S ZTREQ="@"
I $D(^XTMP("MPIF_SEEDING"))&('$D(^XTMP("MPIF_SEEDING","STOPPED"))) Q
S (DFN,CNT,XICN,A31E)=0,ARR="ARRAY"
D NOW^%DTC
S ^XTMP("MPIF_SEEDING",0)=%+10_"^"_%_"^Seeding MPI w/A31s"
S ^XTMP("MPIF_SEEDING","STARTED")=%
I '$D(^DPT("AICN")) S ^XTMP("MPIF_SEEDING","STOPPED")=% Q
; ^ No ICNs
;GET LAST ICN COMPLETED
S IEN=$O(^MPIF(984.8,"B","ONE","")),NODE=$G(^MPIF(984.8,IEN,0))
I $P(NODE,"^",5)'="" S ^XTMP("MPIF_SEEDING","STOPPED")=% Q
; ^ SEEDING FINISHED
S OICN=+$P(NODE,"^",8),OA31E=+$P(NODE,"^",7),OCNT=+$P(NODE,"^",6)
S ICN=$P(NODE,"^",11),SITE=$P($$SITE^VASITE(),"^",3),STOP=0
S STICN=+$P(NODE,"^",4) I STICN=0 S STICN=$O(^DPT("AICN","A"),-1)
S MANY=$P(NODE,"^",9)
I +MANY<1 S ^XTMP("MPIF_SEEDING","STOPPED")=% Q
F S ICN=$O(^DPT("AICN",ICN)) Q:ICN=""!(STOP) D
.I ICN=STICN!(ICN>STICN) S STOP=1
.Q:$E(ICN,1,3)=SITE
.; ^LOCAL ICN
.S CNT=CNT+1
.I '(CNT#10000) W:$E(IOST)="C" !,ICN S ^XTMP("MPIF_SEEDING","LAST")="CNT="_CNT_"^ICN="_ICN_"^SENT="_XICN
.S DFN=$O(^DPT("AICN",ICN,""))
.Q:+DFN<1
.Q:'$D(^DPT(DFN,"MPI"))
.I $P($G(^DPT(DFN,"MPI")),"^")=ICN S A31=$$A31^MPIFA31B(DFN) S:A31>0 XICN=XICN+1 S:+A31<1 ^XTMP("MPIF_SEEDING","A31 ERR",DFN)=A31,A31E=A31E+1
.; ^ generate A31 message to MPI
.I XICN=MANY S STOP=1,$P(NODE,"^",11)=ICN
DONE S ^XTMP("MPIF_SEEDING","TOTAL","PROCESSED")=CNT,$P(NODE,"^",6)=CNT+OCNT
S ^XTMP("MPIF_SEEDING","TOTAL","A31 SENT")=XICN,$P(NODE,"^",8)=XICN+OICN
S ^XTMP("MPIF_SEEDING","TOTAL","A31 ERR")=A31E,$P(NODE,"^",7)=A31E+OA31E
D NOW^%DTC
S ^XTMP("MPIF_SEEDING","STOPPED")=%
K %
I ICN=""!(ICN=STICN)!(ICN>STICN) S $P(NODE,"^",5)="SEEDING COMPLETED" D MAIL("D")
S ^MPIF(984.8,IEN,0)=NODE
I $P(NODE,"^",5)="" D MAIL("C")
Q
;
MAIL(STAT) ;
;send bulletin that seeding round is complete or seeding has
;been completely finished
; STAT=
;"D" - completely finished
;"C" - round finished
;
N MPIF,NODE,IEN,XMDUZ,XMSUB,XMY,XMTEXT,MSG
S IEN=$O(^MPIF(984.8,"B","ONE",""))
S NODE=$G(^MPIF(984.8,IEN,0))
I STAT="D" S MSG="Seeding has been completed at site "_$P($$SITE^VASITE(),"^",2)_" (_"_$P($$SITE^VASITE(),"^",3)_")"
I STAT="C" S MSG="Round of seeding has been completed at site "_$P($$SITE^VASITE(),"^",2)_" (_"_$P($$SITE^VASITE(),"^",3)_")"
S MPIF(1,1)=MSG
S MPIF(1,2)=""
S MPIF(1,3)="Site stats for seeding (total to date): "
S MPIF(1,4)=" AICN x-refs Processed: "_$P(NODE,"^",6)
S MPIF(1,5)=" A31s Sent: "_$P(NODE,"^",8)
S MPIF(1,6)=" A31 Errors: "_$P(NODE,"^",7)
S XMDUZ="MPIF VISTA PACKAGE"
S XMSUB="Seeding msg "_$P($$SITE^VASITE(),"^",2)_" ("_$P($$SITE^VASITE(),"^",3)_")"
S XMY("G.CIRN DEV@DOMAIN.EXT")="",XMTEXT="MPIF(1,"
D ^XMD
Q
;
SET(RETURN,NUMBER) ;
;
N IEN,DIE,DA,DR
S IEN=$O(^MPIF(984.8,"B","ONE","")),RETURN=0
Q:IEN<1
S DIE="^MPIF(984.8,",DA=IEN,DR="8////^S X=NUMBER"
D ^DIE
S NODE=$G(^MPIF(984.8,IEN,0))
I $P(NODE,"^",9)=NUMBER S RETURN=1
Q
;
STATS(RETURN) ;
;
N IEN,CNT,TICN,LAST,LONE,SITE
S SITE=$P($$SITE^VASITE(),"^",3),CNT=0
S IEN=$O(^MPIF(984.8,"B","ONE","")),RETURN=0
Q:IEN<1
S NODE=$G(^MPIF(984.8,IEN,0)),RETURN=1
I $P(NODE,"^",5)'="" S RETURN(1)=NODE Q
;^ QUIT IF COMPLETED SEEDING ALREADY
S LAST=$P(NODE,"^",11) ;LAST ICN PROCESSED
I +LAST<1 S LAST=0
S LONE=$P(NODE,"^",4) ;LAST ICN TO BE PROCESSED
F S LAST=$O(^DPT("AICN",LAST)) Q:LAST>LONE S CNT=CNT+1
K DIC
N X,Y,BK,SCH
S DIC="^DIC(19,",X="MPIF SEEDING TASK" D ^DIC K DIC S BK=+Y
I BK<0 S RETURN(2)="MPIF SEEDING TASK doesn't exist in OPTION file"
I BK>0 S DIC="^DIC(19.2,",X="MPIF SEEDING TASK" D ^DIC K DIC S SCH=+Y
I SCH<0 S RETURN(2)="MPIF SEEDING TASK isn't scheduled to run"
I SCH>0 S SCH=$$GET1^DIQ(19.2,SCH_",",2),RETURN(2)="MPIF SEEDING TASK is scheduled to run at "_$$FMTE^XLFDT(SCH)
S RETURN(1)=NODE,RETURN(3)=CNT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFSEED 5074 printed Sep 23, 2025@19:47:45 Page 2
MPIFSEED ;BP/CMC-SEEDING OF A31s TO MPI AND SUB CLEANUP ;FEB 5, 2002
+1 ;;1.0; MASTER PATIENT INDEX VISTA ;**22,24,27**;30 Apr 99
+2 ;
+3 ;CHANGING SEEDING TO SEND X NUMBER OF MESSAGES EACH TIME BACK GROUND
+4 ; JOB XXX RUNS UNTIL ALL ARE SENT. KEEPING TRACK OF WHERE WE ARE AT
+5 ; FOR THE NEXT JOB TO START AT
+6 ; SEND E-MAIL WHEN FINISH EACH GROUP AND A SITE COMPLETES SEEDING
+7 ; ALL PATIENTS.
+8 ;
+9 ; Intregration Agreement Utilized:
+10 ;
+11 ; ^DPT("AICNL", ^DPT("AICN", ^DPT("AMPIMIS", ^DPT("ASCN2" - #2070
+12 ; ^DPT( - #2070
+13 ;
+14 ; $O through Patient file (#2) Sending A31 message for any patients
+15 ; with an active National ICN.
+16 ;
EN ;
+1 IF $DATA(^XTMP("MPIF_SEEDING"))&('$DATA(^XTMP("MPIF_SEEDING","STOPPED")))
QUIT
+2 ; ^ Seeding job is already running
+3 DO START
+4 QUIT
QUEUE ;
+1 IF $DATA(^XTMP("MPIF_SEEDING"))&('$DATA(^XTMP("MPIF_SEEDING","STOPPED")))
QUIT
+2 ; ^ Seeding job is already running
+3 SET ZTRTN="START^MPIFSEED"
SET ZTDESC="A31 SEEDING FOR SITE"
+4 DO NOW^%DTC
+5 SET ZTIO=""
SET ZTDTH=%
+6 IF $DATA(DUZ)
SET ZTSAVE("DUZ")=DUZ
+7 DO ^%ZTLOAD
+8 DO HOME^%ZIS
KILL IO("Q")
+9 KILL ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,%
+10 QUIT
+11 ;
START NEW ICN,DFN,SSN,CNT,XICN,SITE,ARRAY,ARR,SUB,A31,A31E,NODE,IEN,STOP,MANY
+1 NEW OICN,OA31E,OCNT,NODE,STICN
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 IF $DATA(^XTMP("MPIF_SEEDING"))&('$DATA(^XTMP("MPIF_SEEDING","STOPPED")))
QUIT
+4 SET (DFN,CNT,XICN,A31E)=0
SET ARR="ARRAY"
+5 DO NOW^%DTC
+6 SET ^XTMP("MPIF_SEEDING",0)=%+10_"^"_%_"^Seeding MPI w/A31s"
+7 SET ^XTMP("MPIF_SEEDING","STARTED")=%
+8 IF '$DATA(^DPT("AICN"))
SET ^XTMP("MPIF_SEEDING","STOPPED")=%
QUIT
+9 ; ^ No ICNs
+10 ;GET LAST ICN COMPLETED
+11 SET IEN=$ORDER(^MPIF(984.8,"B","ONE",""))
SET NODE=$GET(^MPIF(984.8,IEN,0))
+12 IF $PIECE(NODE,"^",5)'=""
SET ^XTMP("MPIF_SEEDING","STOPPED")=%
QUIT
+13 ; ^ SEEDING FINISHED
+14 SET OICN=+$PIECE(NODE,"^",8)
SET OA31E=+$PIECE(NODE,"^",7)
SET OCNT=+$PIECE(NODE,"^",6)
+15 SET ICN=$PIECE(NODE,"^",11)
SET SITE=$PIECE($$SITE^VASITE(),"^",3)
SET STOP=0
+16 SET STICN=+$PIECE(NODE,"^",4)
IF STICN=0
SET STICN=$ORDER(^DPT("AICN","A"),-1)
+17 SET MANY=$PIECE(NODE,"^",9)
+18 IF +MANY<1
SET ^XTMP("MPIF_SEEDING","STOPPED")=%
QUIT
+19 FOR
SET ICN=$ORDER(^DPT("AICN",ICN))
if ICN=""!(STOP)
QUIT
Begin DoDot:1
+20 IF ICN=STICN!(ICN>STICN)
SET STOP=1
+21 if $EXTRACT(ICN,1,3)=SITE
QUIT
+22 ; ^LOCAL ICN
+23 SET CNT=CNT+1
+24 IF '(CNT#10000)
if $EXTRACT(IOST)="C"
WRITE !,ICN
SET ^XTMP("MPIF_SEEDING","LAST")="CNT="_CNT_"^ICN="_ICN_"^SENT="_XICN
+25 SET DFN=$ORDER(^DPT("AICN",ICN,""))
+26 if +DFN<1
QUIT
+27 if '$DATA(^DPT(DFN,"MPI"))
QUIT
+28 IF $PIECE($GET(^DPT(DFN,"MPI")),"^")=ICN
SET A31=$$A31^MPIFA31B(DFN)
if A31>0
SET XICN=XICN+1
if +A31<1
SET ^XTMP("MPIF_SEEDING","A31 ERR",DFN)=A31
SET A31E=A31E+1
+29 ; ^ generate A31 message to MPI
+30 IF XICN=MANY
SET STOP=1
SET $PIECE(NODE,"^",11)=ICN
End DoDot:1
DONE SET ^XTMP("MPIF_SEEDING","TOTAL","PROCESSED")=CNT
SET $PIECE(NODE,"^",6)=CNT+OCNT
+1 SET ^XTMP("MPIF_SEEDING","TOTAL","A31 SENT")=XICN
SET $PIECE(NODE,"^",8)=XICN+OICN
+2 SET ^XTMP("MPIF_SEEDING","TOTAL","A31 ERR")=A31E
SET $PIECE(NODE,"^",7)=A31E+OA31E
+3 DO NOW^%DTC
+4 SET ^XTMP("MPIF_SEEDING","STOPPED")=%
+5 KILL %
+6 IF ICN=""!(ICN=STICN)!(ICN>STICN)
SET $PIECE(NODE,"^",5)="SEEDING COMPLETED"
DO MAIL("D")
+7 SET ^MPIF(984.8,IEN,0)=NODE
+8 IF $PIECE(NODE,"^",5)=""
DO MAIL("C")
+9 QUIT
+10 ;
MAIL(STAT) ;
+1 ;send bulletin that seeding round is complete or seeding has
+2 ;been completely finished
+3 ; STAT=
+4 ;"D" - completely finished
+5 ;"C" - round finished
+6 ;
+7 NEW MPIF,NODE,IEN,XMDUZ,XMSUB,XMY,XMTEXT,MSG
+8 SET IEN=$ORDER(^MPIF(984.8,"B","ONE",""))
+9 SET NODE=$GET(^MPIF(984.8,IEN,0))
+10 IF STAT="D"
SET MSG="Seeding has been completed at site "_$PIECE($$SITE^VASITE(),"^",2)_" (_"_$PIECE($$SITE^VASITE(),"^",3)_")"
+11 IF STAT="C"
SET MSG="Round of seeding has been completed at site "_$PIECE($$SITE^VASITE(),"^",2)_" (_"_$PIECE($$SITE^VASITE(),"^",3)_")"
+12 SET MPIF(1,1)=MSG
+13 SET MPIF(1,2)=""
+14 SET MPIF(1,3)="Site stats for seeding (total to date): "
+15 SET MPIF(1,4)=" AICN x-refs Processed: "_$PIECE(NODE,"^",6)
+16 SET MPIF(1,5)=" A31s Sent: "_$PIECE(NODE,"^",8)
+17 SET MPIF(1,6)=" A31 Errors: "_$PIECE(NODE,"^",7)
+18 SET XMDUZ="MPIF VISTA PACKAGE"
+19 SET XMSUB="Seeding msg "_$PIECE($$SITE^VASITE(),"^",2)_" ("_$PIECE($$SITE^VASITE(),"^",3)_")"
+20 SET XMY("G.CIRN DEV@DOMAIN.EXT")=""
SET XMTEXT="MPIF(1,"
+21 DO ^XMD
+22 QUIT
+23 ;
SET(RETURN,NUMBER) ;
+1 ;
+2 NEW IEN,DIE,DA,DR
+3 SET IEN=$ORDER(^MPIF(984.8,"B","ONE",""))
SET RETURN=0
+4 if IEN<1
QUIT
+5 SET DIE="^MPIF(984.8,"
SET DA=IEN
SET DR="8////^S X=NUMBER"
+6 DO ^DIE
+7 SET NODE=$GET(^MPIF(984.8,IEN,0))
+8 IF $PIECE(NODE,"^",9)=NUMBER
SET RETURN=1
+9 QUIT
+10 ;
STATS(RETURN) ;
+1 ;
+2 NEW IEN,CNT,TICN,LAST,LONE,SITE
+3 SET SITE=$PIECE($$SITE^VASITE(),"^",3)
SET CNT=0
+4 SET IEN=$ORDER(^MPIF(984.8,"B","ONE",""))
SET RETURN=0
+5 if IEN<1
QUIT
+6 SET NODE=$GET(^MPIF(984.8,IEN,0))
SET RETURN=1
+7 IF $PIECE(NODE,"^",5)'=""
SET RETURN(1)=NODE
QUIT
+8 ;^ QUIT IF COMPLETED SEEDING ALREADY
+9 ;LAST ICN PROCESSED
SET LAST=$PIECE(NODE,"^",11)
+10 IF +LAST<1
SET LAST=0
+11 ;LAST ICN TO BE PROCESSED
SET LONE=$PIECE(NODE,"^",4)
+12 FOR
SET LAST=$ORDER(^DPT("AICN",LAST))
if LAST>LONE
QUIT
SET CNT=CNT+1
+13 KILL DIC
+14 NEW X,Y,BK,SCH
+15 SET DIC="^DIC(19,"
SET X="MPIF SEEDING TASK"
DO ^DIC
KILL DIC
SET BK=+Y
+16 IF BK<0
SET RETURN(2)="MPIF SEEDING TASK doesn't exist in OPTION file"
+17 IF BK>0
SET DIC="^DIC(19.2,"
SET X="MPIF SEEDING TASK"
DO ^DIC
KILL DIC
SET SCH=+Y
+18 IF SCH<0
SET RETURN(2)="MPIF SEEDING TASK isn't scheduled to run"
+19 IF SCH>0
SET SCH=$$GET1^DIQ(19.2,SCH_",",2)
SET RETURN(2)="MPIF SEEDING TASK is scheduled to run at "_$$FMTE^XLFDT(SCH)
+20 SET RETURN(1)=NODE
SET RETURN(3)=CNT
+21 QUIT
