Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MPIFSEED

MPIFSEED.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;CHANGING SEEDING TO SEND X NUMBER OF MESSAGES EACH TIME BACK GROUND
  1. ; JOB XXX RUNS UNTIL ALL ARE SENT. KEEPING TRACK OF WHERE WE ARE AT
  1. ; FOR THE NEXT JOB TO START AT
  1. ; SEND E-MAIL WHEN FINISH EACH GROUP AND A SITE COMPLETES SEEDING
  1. ; ALL PATIENTS.
  1. ;
  1. ; Intregration Agreement Utilized:
  1. ;
  1. ; ^DPT("AICNL", ^DPT("AICN", ^DPT("AMPIMIS", ^DPT("ASCN2" - #2070
  1. ; ^DPT( - #2070
  1. ;
  1. ; $O through Patient file (#2) Sending A31 message for any patients
  1. ; with an active National ICN.
  1. ;
  1. EN ;
  1. I $D(^XTMP("MPIF_SEEDING"))&('$D(^XTMP("MPIF_SEEDING","STOPPED"))) Q
  1. ; ^ Seeding job is already running
  1. D START
  1. Q
  1. QUEUE ;
  1. I $D(^XTMP("MPIF_SEEDING"))&('$D(^XTMP("MPIF_SEEDING","STOPPED"))) Q
  1. ; ^ Seeding job is already running
  1. S ZTRTN="START^MPIFSEED",ZTDESC="A31 SEEDING FOR SITE"
  1. D NOW^%DTC
  1. S ZTIO="",ZTDTH=%
  1. I $D(DUZ) S ZTSAVE("DUZ")=DUZ
  1. D ^%ZTLOAD
  1. D HOME^%ZIS K IO("Q")
  1. K ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,%
  1. Q
  1. ;
  1. START N ICN,DFN,SSN,CNT,XICN,SITE,ARRAY,ARR,SUB,A31,A31E,NODE,IEN,STOP,MANY
  1. N OICN,OA31E,OCNT,NODE,STICN
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. I $D(^XTMP("MPIF_SEEDING"))&('$D(^XTMP("MPIF_SEEDING","STOPPED"))) Q
  1. S (DFN,CNT,XICN,A31E)=0,ARR="ARRAY"
  1. D NOW^%DTC
  1. S ^XTMP("MPIF_SEEDING",0)=%+10_"^"_%_"^Seeding MPI w/A31s"
  1. S ^XTMP("MPIF_SEEDING","STARTED")=%
  1. I '$D(^DPT("AICN")) S ^XTMP("MPIF_SEEDING","STOPPED")=% Q
  1. ; ^ No ICNs
  1. ;GET LAST ICN COMPLETED
  1. S IEN=$O(^MPIF(984.8,"B","ONE","")),NODE=$G(^MPIF(984.8,IEN,0))
  1. I $P(NODE,"^",5)'="" S ^XTMP("MPIF_SEEDING","STOPPED")=% Q
  1. ; ^ SEEDING FINISHED
  1. S OICN=+$P(NODE,"^",8),OA31E=+$P(NODE,"^",7),OCNT=+$P(NODE,"^",6)
  1. S ICN=$P(NODE,"^",11),SITE=$P($$SITE^VASITE(),"^",3),STOP=0
  1. S STICN=+$P(NODE,"^",4) I STICN=0 S STICN=$O(^DPT("AICN","A"),-1)
  1. S MANY=$P(NODE,"^",9)
  1. I +MANY<1 S ^XTMP("MPIF_SEEDING","STOPPED")=% Q
  1. F S ICN=$O(^DPT("AICN",ICN)) Q:ICN=""!(STOP) D
  1. .I ICN=STICN!(ICN>STICN) S STOP=1
  1. .Q:$E(ICN,1,3)=SITE
  1. .; ^LOCAL ICN
  1. .S CNT=CNT+1
  1. .I '(CNT#10000) W:$E(IOST)="C" !,ICN S ^XTMP("MPIF_SEEDING","LAST")="CNT="_CNT_"^ICN="_ICN_"^SENT="_XICN
  1. .S DFN=$O(^DPT("AICN",ICN,""))
  1. .Q:+DFN<1
  1. .Q:'$D(^DPT(DFN,"MPI"))
  1. .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
  1. .; ^ generate A31 message to MPI
  1. .I XICN=MANY S STOP=1,$P(NODE,"^",11)=ICN
  1. DONE S ^XTMP("MPIF_SEEDING","TOTAL","PROCESSED")=CNT,$P(NODE,"^",6)=CNT+OCNT
  1. S ^XTMP("MPIF_SEEDING","TOTAL","A31 SENT")=XICN,$P(NODE,"^",8)=XICN+OICN
  1. S ^XTMP("MPIF_SEEDING","TOTAL","A31 ERR")=A31E,$P(NODE,"^",7)=A31E+OA31E
  1. D NOW^%DTC
  1. S ^XTMP("MPIF_SEEDING","STOPPED")=%
  1. K %
  1. I ICN=""!(ICN=STICN)!(ICN>STICN) S $P(NODE,"^",5)="SEEDING COMPLETED" D MAIL("D")
  1. S ^MPIF(984.8,IEN,0)=NODE
  1. I $P(NODE,"^",5)="" D MAIL("C")
  1. Q
  1. ;
  1. MAIL(STAT) ;
  1. ;send bulletin that seeding round is complete or seeding has
  1. ;been completely finished
  1. ; STAT=
  1. ;"D" - completely finished
  1. ;"C" - round finished
  1. ;
  1. N MPIF,NODE,IEN,XMDUZ,XMSUB,XMY,XMTEXT,MSG
  1. S IEN=$O(^MPIF(984.8,"B","ONE",""))
  1. S NODE=$G(^MPIF(984.8,IEN,0))
  1. I STAT="D" S MSG="Seeding has been completed at site "_$P($$SITE^VASITE(),"^",2)_" (_"_$P($$SITE^VASITE(),"^",3)_")"
  1. I STAT="C" S MSG="Round of seeding has been completed at site "_$P($$SITE^VASITE(),"^",2)_" (_"_$P($$SITE^VASITE(),"^",3)_")"
  1. S MPIF(1,1)=MSG
  1. S MPIF(1,2)=""
  1. S MPIF(1,3)="Site stats for seeding (total to date): "
  1. S MPIF(1,4)=" AICN x-refs Processed: "_$P(NODE,"^",6)
  1. S MPIF(1,5)=" A31s Sent: "_$P(NODE,"^",8)
  1. S MPIF(1,6)=" A31 Errors: "_$P(NODE,"^",7)
  1. S XMDUZ="MPIF VISTA PACKAGE"
  1. S XMSUB="Seeding msg "_$P($$SITE^VASITE(),"^",2)_" ("_$P($$SITE^VASITE(),"^",3)_")"
  1. S XMY("G.CIRN DEV@DOMAIN.EXT")="",XMTEXT="MPIF(1,"
  1. D ^XMD
  1. Q
  1. ;
  1. SET(RETURN,NUMBER) ;
  1. ;
  1. N IEN,DIE,DA,DR
  1. S IEN=$O(^MPIF(984.8,"B","ONE","")),RETURN=0
  1. Q:IEN<1
  1. S DIE="^MPIF(984.8,",DA=IEN,DR="8////^S X=NUMBER"
  1. D ^DIE
  1. S NODE=$G(^MPIF(984.8,IEN,0))
  1. I $P(NODE,"^",9)=NUMBER S RETURN=1
  1. Q
  1. ;
  1. STATS(RETURN) ;
  1. ;
  1. N IEN,CNT,TICN,LAST,LONE,SITE
  1. S SITE=$P($$SITE^VASITE(),"^",3),CNT=0
  1. S IEN=$O(^MPIF(984.8,"B","ONE","")),RETURN=0
  1. Q:IEN<1
  1. S NODE=$G(^MPIF(984.8,IEN,0)),RETURN=1
  1. I $P(NODE,"^",5)'="" S RETURN(1)=NODE Q
  1. ;^ QUIT IF COMPLETED SEEDING ALREADY
  1. S LAST=$P(NODE,"^",11) ;LAST ICN PROCESSED
  1. I +LAST<1 S LAST=0
  1. S LONE=$P(NODE,"^",4) ;LAST ICN TO BE PROCESSED
  1. F S LAST=$O(^DPT("AICN",LAST)) Q:LAST>LONE S CNT=CNT+1
  1. K DIC
  1. N X,Y,BK,SCH
  1. S DIC="^DIC(19,",X="MPIF SEEDING TASK" D ^DIC K DIC S BK=+Y
  1. I BK<0 S RETURN(2)="MPIF SEEDING TASK doesn't exist in OPTION file"
  1. I BK>0 S DIC="^DIC(19.2,",X="MPIF SEEDING TASK" D ^DIC K DIC S SCH=+Y
  1. I SCH<0 S RETURN(2)="MPIF SEEDING TASK isn't scheduled to run"
  1. I SCH>0 S SCH=$$GET1^DIQ(19.2,SCH_",",2),RETURN(2)="MPIF SEEDING TASK is scheduled to run at "_$$FMTE^XLFDT(SCH)
  1. S RETURN(1)=NODE,RETURN(3)=CNT
  1. Q