source: FOIAVistA/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIFSEED.m@ 1504

Last change on this file since 1504 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1MPIFSEED ;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 ;
18EN ;
19 I $D(^XTMP("MPIF_SEEDING"))&('$D(^XTMP("MPIF_SEEDING","STOPPED"))) Q
20 ; ^ Seeding job is already running
21 D START
22 Q
23QUEUE ;
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 ;
35START 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
66DONE 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 ;
77MAIL(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 ;
101SET(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 ;
112STATS(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
Note: See TracBrowser for help on using the repository browser.