source: FOIAVistA/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIFBT1.m@ 1683

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

initial load of FOIAVistA 6/30/08 version

File size: 5.5 KB
Line 
1MPIFBT1 ;SLC/ARS/SFCIO/CMC-BATCH QUERY TO MPI ;FEB 4, 1997
2 ;;1.0; MASTER PATIENT INDEX VISTA ;**17,28,33**;30 Apr 99
3 ;
4 ; Integration Agreements Utilized:
5 ; EXC, START, STOP^RGHLLOG - #2796
6 ; ^DPT("ACMORS" - #2070
7 ; ^RGSITE(991.8,1,"CMOR" - #2746
8 ;
9GOBKG ;
10 K STOP
11 ;make sure only one job will run
12 L +^XTMP("MPIF BATCH LOAD"):3 E W !,"JOB ALREADY RUNNING" Q
13 ;
14 I '$D(^RGSITE(991.8,1,"CMOR")) W !,"CMOR Scores NOT Complete" G EXIT
15 I $D(^RGSITE(991.8,1,"CMOR")),$P($G(^RGSITE(991.8,1,"CMOR")),"^",7)'="SN" W !,"CMOR Scores NOT Complete" G EXIT
16 ;
17 ;Check to see if job had STOPed -start where left off, start over or quit
18 I $P($G(^MPIF(984.8,1,0)),"^",6)'="" D AGAIN
19 I $D(STOP) W !,"Job NOT Started" K STOP G EXIT
20 D BEG
21 I $D(STOP) K STOP G EXIT
22 S ZTRTN="GO^MPIFBT1",ZTDESC="USE HL7 MSGS AND MAIL TO BUILD ICN"
23 S ZTIO="",ZTDTH=START
24 I $D(DUZ) S ZTSAVE("DUZ")=DUZ
25 I $D(ORDER) S ZTSAVE("ORDER")=ORDER
26 D ^%ZTLOAD W:$D(ZTSK) !,"TASK #: ",ZTSK
27 D HOME^%ZIS K IO("Q")
28 K ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,ORDER,START,ENDT
29 Q
30EXIT ;
31 L -^XTMP("MPIF BATCH LOAD")
32 Q
33 ;
34BEG K DIR,DIE,DR,DA,X,Y
35 S DIR(0)="D^::AEFT",DIR("B")="NOW",DIR("A")="START TIME"
36 D ^DIR
37 I $D(DTOUT)!($D(DUOUT)) W !,"Job NOT Scheduled" K DTOUT,DUOUT,DIR,DA,X,Y S STOP="" Q
38 S START=Y
39 D DD^%DT
40 S ENDT=Y
41TRY K DIR,DIE,DR,DA,X,Y
42 S DIR(0)="D^::AEFT",DIR("B")=ENDT,DIR("A")="STOP TIME"
43 D ^DIR
44 I $D(DTOUT)!($D(DUOUT)) W !,"Job NOT Scheduled" K DTOUT,DUOUT,DIR,DA,X,Y S STOP="" Q
45 I Y'>START W !,"Stop Time must be greater than Start Time" G TRY
46 D DD^%DT
47 S ENDT=Y
48 K DIR,DIE,DR,DA,X,Y
49 S DIE="^MPIF(984.8,",DR="9///"_ENDT,DA=1 D ^DIE
50 K DIE,X,Y,DA,DR
51 I $D(DTOUT)!($D(DUOUT)) W !,"Job NOT Scheduled" K DTOUT,DUOUT,DIR,DA,X,Y S STOP="" Q
52 Q
53 ;
54GO ;ENTRY POINT
55 I '$D(ZTQUEUED) L +^XTMP("MPIF BATCH LOAD"):3 E W !,"JOB ALREADY RUNNING" Q
56 I '$D(ZTQUEUED),('$D(^RGSITE(991.8,1,"CMOR"))) W !,"CMOR Scores NOT Complete" G EXIT
57 I '$D(ZTQUEUED),$D(^RGSITE(991.8,1,"CMOR")),$P($G(^RGSITE(991.8,1,"CMOR")),"^",7)'="SN" W !,"CMOR Scores NOT Complete" G EXIT
58 K STOP
59 ;Check to see if job had STOPed-start where left off, start over or quit
60 I '$D(ZTQUEUED),$P($G(^MPIF(984.8,1,0)),"^",6)'="" D AGAIN
61 I $D(STOP) W !,"Job NOT Started" K STOP G EXIT
62 I '$D(ZTQUEUED) D BEG
63 I $D(STOP) K STOP G EXIT
64GO1 K ^TMP("HLS",$J)
65 N MPIMORE,MPITOT
66 I $D(ZTQUEUED) S ZTREQ="@"
67 S QUITIME=$P(^MPIF(984.8,1,0),"^",10)
68 I '$D(ORDER) S ORDER=0
69 ;
70 K ^TMP("HLS",$J)
71 S MPICNT=$S($P(^MPIF(984.8,1,0),"^",9)>1:$P(^MPIF(984.8,1,0),"^",9),1:1)
72 I +ORDER<1 S ORDER=0
73 D WORK
74 I $D(^TMP("HLS",$J)) D SEND
75 D STOP^RGHLLOG(0)
76 K MPIIT,MPITOT,HLDT,HLDT1,MPICNT,MPIDNUM,MPIEROR,MPIMIDT,MPIMSH
77 K MPIOUT,MPIQRYNM,MPISEQ,ORDER,QCNT,QUITIME,MPIMCNT,MPIMTX,ORDER,START
78 K ENDT
79 L -^XTMP("MPIF BATCH LOAD")
80 Q
81WORK ;
82 Q:$P(^MPIF(984.8,1,0),"^",6)="STOP"
83 D NOW^%DTC
84 S $P(^MPIF(984.8,1,0),"^",2)=%
85 I %>QUITIME Q
86 S MPIMCNT="",MPIMTX=""
87 D HLRDF,LOOP
88 Q
89 ;
90HLRDF ;
91 S (MPIOUT,MPIMCNT)=""
92 S HL("ECH")="^~\&"
93 S HL("FS")="|"
94 D INIT^HLFNC2("MPIF ICN-Q02 SERVER",.HL)
95 I $O(HL("")) S ^TMP($J,"MPIF","ERR")=HL
96 D CREATE^HLTF(.MPIMCNT,.MPIMTX,.HLDT,.HLDT1)
97 D START^RGHLLOG()
98 Q:$P(^MPIF(984.8,1,0),"^",6)="STOP"
99 S $P(^MPIF(984.8,1,0),"^",7)=MPIMCNT
100 S $P(^MPIF(984.8,1,0),"^",8)=MPIMTX
101 Q
102LOOP ;
103 Q:$P(^MPIF(984.8,1,0),"^",6)="STOP"
104 S MPIDNUM=1
105 D MAKE
106 Q
107SEND ;ready to send
108 S $P(^MPIF(984.8,1,0),"^",5)="GENERATE TAG"
109 D GENERATE^HLMA("MPIF ICN-Q02 SERVER","GB",1,.MPIMTX,.MPIEROR,.MPIMORE)
110 I +MPIEROR=0 S ^TMP($J,"MPIF","ERR")=MPIEROR
111 D NOW^%DTC
112 S $P(^MPIF(984.8,1,0),"^",3)=%
113 K %,MPIMTX,MPIEROR,MPIMORE
114 K ^TMP("HLS",$J)
115 Q
116MAKE ;
117 F S ORDER=$O(^DPT("ACMORS",ORDER)) Q:ORDER=""!($P(^MPIF(984.8,1,0),"^",6)="STOP") D
118 .S MPIIT=0
119 .F S MPIIT=$O(^DPT("ACMORS",ORDER,MPIIT)) Q:MPIIT=""!($P(^MPIF(984.8,1,0),"^",6)="STOP") D
120 ..D MAKE3
121 ..D NOW^%DTC
122 ..I %>QUITIME S $P(^MPIF(984.8,1,0),"^",6)="STOP"
123 Q
124MAKE3 ;
125 K MPIOUT
126 Q:$P(^MPIF(984.8,1,0),"^",6)="STOP"
127 S $P(^MPIF(984.8,1,0),"^",5)="LOOPING: "_MPIDNUM
128 S:$G(MPIQRYNM)="" MPIQRYNM="VTQ_PID_ICN_LOAD_1"
129 D VTQ1^MPIFVTQ(MPIIT,.MPIOUT,.HL,.MPIQRYNM)
130 I $P(MPIOUT(0),"^",1)<0,$P(MPIOUT(0),"^",2)="invalid DFN"!($P(MPIOUT(0),"^",2)="no encoding characters") D
131 .D EXC^RGHLLOG(206,"DFN = "_MPIIT_" Problem with building VTQ was "_$P(MPIOUT(0),"^",2),MPIIT) Q
132 ;I $P(MPIOUT(0),"^")<0,$P(MPIOUT(0),"^",2)="Missing Required Field(s)" D EXC^RGHLLOG(209,"DFN - "_MPIIT_" Missing Required Field(s)",MPIIT) Q
133 Q:$P(MPIOUT(0),"^")<0
134 ;call for HL7 header
135 S MPIMIDT=MPIMCNT_"-"_MPIDNUM
136 D MSH^HLFNC2(.HL,MPIMIDT,.MPIMSH)
137 S MPIOUT(1)=MPIMSH
138 ;MESSAGE BUILT
139 S MPISEQ=0
140 F S MPISEQ=$O(MPIOUT(MPISEQ)) Q:MPISEQ'>0 D
141 .S ^TMP("HLS",$J,MPICNT)=MPIOUT(MPISEQ)
142 .S MPICNT=MPICNT+1
143 S $P(^MPIF(984.8,1,0),"^",11)=ORDER
144 S $P(^MPIF(984.8,1,0),"^",9)=MPICNT
145 S $P(^MPIF(984.8,1,0),"^",4)=MPIIT
146 S MPIDNUM=MPIDNUM+1
147 I MPIDNUM>100 D
148 .D SEND
149 .S (MPICNT,MPIDNUM)=1
150 .D HLRDF
151 Q
152 ;
153AGAIN ;job started before
154 W !,"Job was started before and has Stopped"
155 K DIR,DR
156 S DIR(0)="Y",DIR("B")="YES",DIR("A")="Begin Where Left Off? ",DIR("?")="Y for yes to start where job left off, N for no"
157 D ^DIR
158 I Y=1 S ORDER=$P(^MPIF(984.8,1,0),"^",11),$P(^MPIF(984.8,1,0),"^",6)="" G END
159 ;job started but used doesn't want to start where job left off
160 W !,"'E' - Exit or 'O' - Start over from the Beginning"
161 K DIR,DR
162 S DIR(0)="S^E:EXIT;O:OVER",DIR("?")="E for Exit, O to Start Over from the Beginning"
163 S DIR("A")="What would you like to do?"
164 D ^DIR
165 S:Y="E" STOP=""
166 S:Y="O" ORDER=0,$P(^MPIF(984.8,1,0),"^",6)=""
167END ;
168 K DIR,Y,DR,X
169 ; wants to start over or from where job left off if '$d(stop)
170 Q
Note: See TracBrowser for help on using the repository browser.