| 1 | MPIFSEED ;BP/CMC-SEEDING OF A31s TO MPI AND SUB CLEANUP ;FEB 5, 2002 | 
|---|
| 2 | ;;1.0; MASTER PATIENT INDEX VISTA ;**22,24,27**;30 Apr 99 | 
|---|
| 3 | ; | 
|---|
| 4 | ;CHANGING SEEDING TO SEND X NUMBER OF MESSAGES EACH TIME BACK GROUND | 
|---|
| 5 | ; JOB XXX RUNS UNTIL ALL ARE SENT.  KEEPING TRACK OF WHERE WE ARE AT | 
|---|
| 6 | ; FOR THE NEXT JOB TO START AT | 
|---|
| 7 | ; SEND E-MAIL WHEN FINISH EACH GROUP AND A SITE COMPLETES SEEDING | 
|---|
| 8 | ; ALL PATIENTS. | 
|---|
| 9 | ; | 
|---|
| 10 | ; Intregration Agreement Utilized: | 
|---|
| 11 | ; | 
|---|
| 12 | ;   ^DPT("AICNL", ^DPT("AICN", ^DPT("AMPIMIS", ^DPT("ASCN2" - #2070 | 
|---|
| 13 | ;   ^DPT( - #2070 | 
|---|
| 14 | ; | 
|---|
| 15 | ; $O through Patient file (#2) Sending A31 message for any patients | 
|---|
| 16 | ; with an active National ICN. | 
|---|
| 17 | ; | 
|---|
| 18 | EN ; | 
|---|
| 19 | I $D(^XTMP("MPIF_SEEDING"))&('$D(^XTMP("MPIF_SEEDING","STOPPED"))) Q | 
|---|
| 20 | ; ^ Seeding job is already running | 
|---|
| 21 | D START | 
|---|
| 22 | Q | 
|---|
| 23 | QUEUE ; | 
|---|
| 24 | I $D(^XTMP("MPIF_SEEDING"))&('$D(^XTMP("MPIF_SEEDING","STOPPED"))) Q | 
|---|
| 25 | ; ^ Seeding job is already running | 
|---|
| 26 | S ZTRTN="START^MPIFSEED",ZTDESC="A31 SEEDING FOR SITE" | 
|---|
| 27 | D NOW^%DTC | 
|---|
| 28 | S ZTIO="",ZTDTH=% | 
|---|
| 29 | I $D(DUZ) S ZTSAVE("DUZ")=DUZ | 
|---|
| 30 | D ^%ZTLOAD | 
|---|
| 31 | D HOME^%ZIS K IO("Q") | 
|---|
| 32 | K ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,% | 
|---|
| 33 | Q | 
|---|
| 34 | ; | 
|---|
| 35 | START N ICN,DFN,SSN,CNT,XICN,SITE,ARRAY,ARR,SUB,A31,A31E,NODE,IEN,STOP,MANY | 
|---|
| 36 | N OICN,OA31E,OCNT,NODE,STICN | 
|---|
| 37 | I $D(ZTQUEUED) S ZTREQ="@" | 
|---|
| 38 | I $D(^XTMP("MPIF_SEEDING"))&('$D(^XTMP("MPIF_SEEDING","STOPPED"))) Q | 
|---|
| 39 | S (DFN,CNT,XICN,A31E)=0,ARR="ARRAY" | 
|---|
| 40 | D NOW^%DTC | 
|---|
| 41 | S ^XTMP("MPIF_SEEDING",0)=%+10_"^"_%_"^Seeding MPI w/A31s" | 
|---|
| 42 | S ^XTMP("MPIF_SEEDING","STARTED")=% | 
|---|
| 43 | I '$D(^DPT("AICN")) S ^XTMP("MPIF_SEEDING","STOPPED")=% Q | 
|---|
| 44 | ; ^ No ICNs | 
|---|
| 45 | ;GET LAST ICN COMPLETED | 
|---|
| 46 | S IEN=$O(^MPIF(984.8,"B","ONE","")),NODE=$G(^MPIF(984.8,IEN,0)) | 
|---|
| 47 | I $P(NODE,"^",5)'="" S ^XTMP("MPIF_SEEDING","STOPPED")=% Q | 
|---|
| 48 | ; ^ SEEDING FINISHED | 
|---|
| 49 | S OICN=+$P(NODE,"^",8),OA31E=+$P(NODE,"^",7),OCNT=+$P(NODE,"^",6) | 
|---|
| 50 | S ICN=$P(NODE,"^",11),SITE=$P($$SITE^VASITE(),"^",3),STOP=0 | 
|---|
| 51 | S STICN=+$P(NODE,"^",4) I STICN=0 S STICN=$O(^DPT("AICN","A"),-1) | 
|---|
| 52 | S MANY=$P(NODE,"^",9) | 
|---|
| 53 | I +MANY<1 S ^XTMP("MPIF_SEEDING","STOPPED")=% Q | 
|---|
| 54 | F  S ICN=$O(^DPT("AICN",ICN)) Q:ICN=""!(STOP)  D | 
|---|
| 55 | .I ICN=STICN!(ICN>STICN) S STOP=1 | 
|---|
| 56 | .Q:$E(ICN,1,3)=SITE | 
|---|
| 57 | .; ^LOCAL ICN | 
|---|
| 58 | .S CNT=CNT+1 | 
|---|
| 59 | .I '(CNT#10000) W:$E(IOST)="C" !,ICN S ^XTMP("MPIF_SEEDING","LAST")="CNT="_CNT_"^ICN="_ICN_"^SENT="_XICN | 
|---|
| 60 | .S DFN=$O(^DPT("AICN",ICN,"")) | 
|---|
| 61 | .Q:+DFN<1 | 
|---|
| 62 | .Q:'$D(^DPT(DFN,"MPI")) | 
|---|
| 63 | .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 | 
|---|
| 64 | .; ^ generate A31 message to MPI | 
|---|
| 65 | .I XICN=MANY S STOP=1,$P(NODE,"^",11)=ICN | 
|---|
| 66 | DONE S ^XTMP("MPIF_SEEDING","TOTAL","PROCESSED")=CNT,$P(NODE,"^",6)=CNT+OCNT | 
|---|
| 67 | S ^XTMP("MPIF_SEEDING","TOTAL","A31 SENT")=XICN,$P(NODE,"^",8)=XICN+OICN | 
|---|
| 68 | S ^XTMP("MPIF_SEEDING","TOTAL","A31 ERR")=A31E,$P(NODE,"^",7)=A31E+OA31E | 
|---|
| 69 | D NOW^%DTC | 
|---|
| 70 | S ^XTMP("MPIF_SEEDING","STOPPED")=% | 
|---|
| 71 | K % | 
|---|
| 72 | I ICN=""!(ICN=STICN)!(ICN>STICN) S $P(NODE,"^",5)="SEEDING COMPLETED" D MAIL("D") | 
|---|
| 73 | S ^MPIF(984.8,IEN,0)=NODE | 
|---|
| 74 | I $P(NODE,"^",5)="" D MAIL("C") | 
|---|
| 75 | Q | 
|---|
| 76 | ; | 
|---|
| 77 | MAIL(STAT) ; | 
|---|
| 78 | ;send bulletin that seeding round is complete or seeding has | 
|---|
| 79 | ;been completely finished | 
|---|
| 80 | ; STAT= | 
|---|
| 81 | ;"D" - completely finished | 
|---|
| 82 | ;"C" - round finished | 
|---|
| 83 | ; | 
|---|
| 84 | N MPIF,NODE,IEN,XMDUZ,XMSUB,XMY,XMTEXT,MSG | 
|---|
| 85 | S IEN=$O(^MPIF(984.8,"B","ONE","")) | 
|---|
| 86 | S NODE=$G(^MPIF(984.8,IEN,0)) | 
|---|
| 87 | I STAT="D" S MSG="Seeding has been completed at site "_$P($$SITE^VASITE(),"^",2)_" (_"_$P($$SITE^VASITE(),"^",3)_")" | 
|---|
| 88 | I STAT="C" S MSG="Round of seeding has been completed at site "_$P($$SITE^VASITE(),"^",2)_" (_"_$P($$SITE^VASITE(),"^",3)_")" | 
|---|
| 89 | S MPIF(1,1)=MSG | 
|---|
| 90 | S MPIF(1,2)="" | 
|---|
| 91 | S MPIF(1,3)="Site stats for seeding (total to date): " | 
|---|
| 92 | S MPIF(1,4)="     AICN x-refs Processed:  "_$P(NODE,"^",6) | 
|---|
| 93 | S MPIF(1,5)="     A31s Sent:  "_$P(NODE,"^",8) | 
|---|
| 94 | S MPIF(1,6)="     A31 Errors: "_$P(NODE,"^",7) | 
|---|
| 95 | S XMDUZ="MPIF VISTA PACKAGE" | 
|---|
| 96 | S XMSUB="Seeding msg "_$P($$SITE^VASITE(),"^",2)_" ("_$P($$SITE^VASITE(),"^",3)_")" | 
|---|
| 97 | S XMY("G.CIRN DEV@FORUM.VA.GOV")="",XMTEXT="MPIF(1," | 
|---|
| 98 | D ^XMD | 
|---|
| 99 | Q | 
|---|
| 100 | ; | 
|---|
| 101 | SET(RETURN,NUMBER) ; | 
|---|
| 102 | ; | 
|---|
| 103 | N IEN,DIE,DA,DR | 
|---|
| 104 | S IEN=$O(^MPIF(984.8,"B","ONE","")),RETURN=0 | 
|---|
| 105 | Q:IEN<1 | 
|---|
| 106 | S DIE="^MPIF(984.8,",DA=IEN,DR="8////^S X=NUMBER" | 
|---|
| 107 | D ^DIE | 
|---|
| 108 | S NODE=$G(^MPIF(984.8,IEN,0)) | 
|---|
| 109 | I $P(NODE,"^",9)=NUMBER S RETURN=1 | 
|---|
| 110 | Q | 
|---|
| 111 | ; | 
|---|
| 112 | STATS(RETURN) ; | 
|---|
| 113 | ; | 
|---|
| 114 | N IEN,CNT,TICN,LAST,LONE,SITE | 
|---|
| 115 | S SITE=$P($$SITE^VASITE(),"^",3),CNT=0 | 
|---|
| 116 | S IEN=$O(^MPIF(984.8,"B","ONE","")),RETURN=0 | 
|---|
| 117 | Q:IEN<1 | 
|---|
| 118 | S NODE=$G(^MPIF(984.8,IEN,0)),RETURN=1 | 
|---|
| 119 | I $P(NODE,"^",5)'="" S RETURN(1)=NODE Q | 
|---|
| 120 | ;^ QUIT IF COMPLETED SEEDING ALREADY | 
|---|
| 121 | S LAST=$P(NODE,"^",11) ;LAST ICN PROCESSED | 
|---|
| 122 | I +LAST<1 S LAST=0 | 
|---|
| 123 | S LONE=$P(NODE,"^",4) ;LAST ICN TO BE PROCESSED | 
|---|
| 124 | F  S LAST=$O(^DPT("AICN",LAST)) Q:LAST>LONE  S CNT=CNT+1 | 
|---|
| 125 | K DIC | 
|---|
| 126 | N X,Y,BK,SCH | 
|---|
| 127 | S DIC="^DIC(19,",X="MPIF SEEDING TASK" D ^DIC K DIC S BK=+Y | 
|---|
| 128 | I BK<0 S RETURN(2)="MPIF SEEDING TASK doesn't exist in OPTION file" | 
|---|
| 129 | I BK>0 S DIC="^DIC(19.2,",X="MPIF SEEDING TASK" D ^DIC K DIC S SCH=+Y | 
|---|
| 130 | I SCH<0 S RETURN(2)="MPIF SEEDING TASK isn't scheduled to run" | 
|---|
| 131 | I SCH>0 S SCH=$$GET1^DIQ(19.2,SCH_",",2),RETURN(2)="MPIF SEEDING TASK is scheduled to run at "_$$FMTE^XLFDT(SCH) | 
|---|
| 132 | S RETURN(1)=NODE,RETURN(3)=CNT | 
|---|
| 133 | Q | 
|---|