source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDRPA06.m@ 650

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

initial load of FOIAVistA 6/30/08 version
File size: 9.3 KB
Line 
1SDRPA06 ;bp-oifo/swo pait hl7 ack handling ; 10/31/04 3:53pm
2 ;;5.3;Scheduling;**290,333,349,376**;AUG 13, 1993
3 ;routine called from Vista HL7 when ack messages are received in response
4 ;to an out going HL7 message generated by protocol SC-PAIT-EVENT
5ACK ;entry point from Vista HL7
6 ;ACKDATE : date/time ack received
7 ;FLDSEP : field separator
8 ;CMPNTSEP : component separator
9 ;REPTNSEP : repetition separator
10 ;ACKCODE : acknowledgement code
11 ;ERROR : reject reason
12 ;BATCHID : batch control ID
13 ;BATCHIDO : original batch control ID
14 N ACKCODE,ACKDATE,BATCHID,BATCHIDO,CMPNTSEP,ERROR,FLDSEP,REPTNSEP,RUNIEN,SDZAP,V1
15 ;disable automatic repair of the last run, not needed to process acks
16 ;NHD will be notified when the completion message does not come out
17 ;D RSTAT^SDRPA02 ;check the status of the last run
18 K ^TMP("SDRPA06",$J)
19 S SDZAP=0
20 S ACKDATE=$$NOW^XLFDT()
21 S FLDSEP=HL("FS")
22 S CMPNTSEP=$E(HL("ECH"),1)
23 S REPTNSEP=$E(HL("ECH"),2)
24 S ACKCODE=$P(HLMSA,FLDSEP)
25 S ERROR=$P(HLMSA,FLDSEP,4)
26 S (BATCHID,BATCHIDO)=$P(HLMSA,FLDSEP,2)
27 S RUNIEN=$$RUNIEN(BATCHIDO) Q:'RUNIEN
28 S BATCHID=$$OURB(RUNIEN,BATCHIDO) ;convert to our batch id
29 Q:'BATCHID ;error needs to be handled
30 ;S V1=$O(^SDWL(409.6,"AMSG",BATCHID,"")),RUNIEN=$O(^SDWL(409.6,"AMSG",BATCHID,V1,""))
31 S V1=$O(^SDWL(409.6,"AMSG",BATCHID,"")) Q:V1=""
32 Q:'$$DUP^SDRPA02(RUNIEN,BATCHIDO) ;check for duplicate
33 S ^XTMP("SDRPA-"_BATCHID,0)=$$FMADD^XLFDT($$DT^XLFDT(),3)_"^"_$$DT^XLFDT() ;set xtmp global for diagnostics
34 I $E(ACKCODE,1,2)="AR" D AR(BATCHID,BATCHIDO),MSG(BATCHIDO,3,RUNIEN,BATCHID) Q ;whole batch rejection
35 ;Q:($E(ACKCODE,1,2)'="AA") ;quit if not a application ack
36 ;will only be 2 ACKCODEs AA and AE so don't have to screen anymore
37 F X HLNEXT Q:(HLQUIT'>0) D ;start looping the msg text
38 . Q:($E(HLNODE,1,3)'="MSA") ;skip if not a MSA segment
39 . I $P(HLNODE,FLDSEP,2)="AE" D ;it's an error
40 .. Q:($P($P(HLNODE,FLDSEP,3),"-",2))="" ;no message number
41 .. S ^TMP("SDRPA06",$J,+$P($P(HLNODE,FLDSEP,3),"-",2))=+$P(HLNODE,"^",4) ;set xref with message #
42 I '$D(^TMP("SDRPA06",$J)) D AA(BATCHID,BATCHIDO),MSG(BATCHIDO,2,RUNIEN,BATCHID) Q ;whole batch accept
43 D AAAR(BATCHID,BATCHIDO),MSG(BATCHIDO,1,RUNIEN,BATCHID) ;batch accept with errors
44 Q
45AR(BATCH,BATCHIDO) ;whole batch rejection
46 ;BATCH : originating batch number
47 ;BATCHIDO : original batch number from HL7 ACK
48 ;V1 : sequence # (individual message number in batch)
49 ;V2 : run # (ien of multiple entry)
50 ;V3 : ien (ien in patient multiple)
51 ;V4 : ien (ien batch tracking multiple)
52 Q:($G(BATCH)="")
53 N DA,DIE,DR,V1,V2,V3,V4,ZNODE
54 S V1=0
55 F S V1=$O(^SDWL(409.6,"AMSG",BATCH,V1)) Q:'V1 D
56 . S V2=$O(^SDWL(409.6,"AMSG",BATCH,V1,"")) Q:'V2
57 . ;batch tracking enhancement
58 . S V4=$O(^SDWL(409.6,V2,2,"B",BATCHIDO,"")) Q:'V4 D
59 .. S DA=V4,DA(1)=V2,DIE="^SDWL(409.6,"_V2_",2,",DR=".04///"_$$NOW^XLFDT_";.05///"_ACKCODE
60 .. D ^DIE K DIE
61 . S V3=0 F S V3=$O(^SDWL(409.6,"AMSG",BATCH,V1,V2,V3)) Q:'V3 D
62 .. S ZNODE=$G(^SDWL(409.6,V2,1,V3,0)) Q:ZNODE=""
63 .. ;4TH PIECE IS MESSAGE NUMBER
64 .. S DA=V3,DA(1)=V2,DIE="^SDWL(409.6,"_V2_",1,"
65 .. S DR="7////"_$O(^SCPT(404.472,"B","R","")) D ^DIE
66 .. I $D(^SDWL(409.6,"AE","Y",V2,V3)) Q
67 .. I $D(^SDWL(409.6,"AE","N",V2,V3)) D
68 ... S DR="4///Y" D ^DIE
69 Q
70AA(BATCH,BATCHIDO) ;whole batch accept
71 ;if the batch is accepted and no rejections then get the run # sequence #
72 ;from AMSG xref. If no "AE","Y" xref then call DIK to delete the entry
73 ;BATCH : originating batch number
74 ;BATCHIDO : original batch number from HL7 ACK
75 ;V1 : sequence # (individual message number in batch)
76 ;V2 : run # (ien of multiple entry)
77 ;V3 : ien (ien in patient multiple)
78 ;V4 : ien (ien batch tracking multiple)
79 Q:($G(BATCH)="")
80 N DA,DIK,DR,V1,V2,V3,V4,ZNODE
81 S V1=0
82 F S V1=$O(^SDWL(409.6,"AMSG",BATCH,V1)) Q:'V1 D
83 . S V2=$O(^SDWL(409.6,"AMSG",BATCH,V1,"")) Q:'V2
84 . ;batch tracking enhancement
85 . S V4=$O(^SDWL(409.6,V2,2,"B",BATCHIDO,"")) Q:'V4 D
86 .. S DA=V4,DA(1)=V2,DIE="^SDWL(409.6,"_V2_",2,",DR=".04///"_$$NOW^XLFDT_";.05///"_ACKCODE
87 .. D ^DIE K DIE
88 . S V3=0 F S V3=$O(^SDWL(409.6,"AMSG",BATCH,V1,V2,V3)) Q:'V3 D
89 .. S ZNODE=$G(^SDWL(409.6,V2,1,V3,0)) Q:ZNODE=""
90 .. ;4th piece is the message #
91 .. I '$D(^SDWL(409.6,"AE","Y",V2,V3)) D
92 ... S DIK="^SDWL(409.6,"_V2_",1,"
93 ... S DA(1)=V2,DA=V3 D ^DIK
94 ... S ^XTMP("SDRPA-"_BATCH,+$P(ZNODE,"^",4),0)=ZNODE ;diagnostics
95 Q
96AAAR(BATCH,BATCHIDO) ;batch accept with errors
97 ;BATCH : originating batch number
98 ;BATCHIDO : original batch number from HL7 ACK
99 ;V1 : sequence # (individual message number in batch)
100 ;V2 : run # (ien of multiple entry)
101 ;V3 : ien (ien in patient multiple)
102 ;V4 : ien (ien batch tracking multiple))
103 Q:($G(BATCH)="")
104 N DA,DIK,DR,V1,V2,V3,V4,ZNODE
105 S V1=0
106 F S V1=$O(^SDWL(409.6,"AMSG",BATCH,V1)) Q:'V1 D
107 . S V2=$O(^SDWL(409.6,"AMSG",BATCH,V1,"")) Q:'V2
108 . ;batch tracking enhancement
109 . S V4=$O(^SDWL(409.6,V2,2,"B",BATCHIDO,"")) Q:'V4 D
110 .. S DA=V4,DA(1)=V2,DIE="^SDWL(409.6,"_V2_",2,",DR=".04///"_$$NOW^XLFDT_";.05///"_ACKCODE
111 .. D ^DIE K DIE
112 . S V3=0 F S V3=$O(^SDWL(409.6,"AMSG",BATCH,V1,V2,V3)) Q:'V3 D
113 .. S ZNODE=$G(^SDWL(409.6,V2,1,V3,0)) Q:ZNODE=""
114 .. ;4th piece is the message #
115 .. ;next line screens for accepted batch + accepted message + status final and can be deleted
116 .. I '$D(^SDWL(409.6,"AE","Y",V2,V3))&('$D(^TMP("SDRPA06",$J,$P(ZNODE,"^",4)))) D
117 ... S DIK="^SDWL(409.6,"_V2_",1,"
118 ... S DA(1)=V2,DA=V3 D ^DIK
119 ... S ^XTMP("SDRPA-"_BATCH,+$P(ZNODE,"^",4),0)=ZNODE ;diagnostics
120 .. ;next line screens for accepted batch + error message
121 .. I $D(^TMP("SDRPA06",$J,$P(ZNODE,"^",4))) D
122 ... S DA=V3,DA(1)=V2,DIE="^SDWL(409.6,"_V2_",1,"
123 ... S DR="7////"_$O(^SCPT(404.472,"B",$G(^TMP("SDRPA06",$J,$P(ZNODE,"^",4))),"")) D ^DIE
124 ... I $D(^SDWL(409.6,"AE","Y",V2,V3)) Q
125 ... I $D(^SDWL(409.6,"AE","N",V2,V3)) D
126 .... S DR="4///Y" D ^DIE
127 Q
128CLEAN(RUN) ;housekeeping
129 ;clean up batch previous to current one by checking for "AE",("S" or "R") xref and
130 ;deleting if entry in xref exists
131 ;RUN : run # (ien of multiple entry)
132 ;V1 : previous run # (ien of multiple entry)
133 ;V2 : ien (ien in multiple)
134 Q:($G(RUN)="")
135 N V1,V2,V3
136 S V1=$O(^SDWL(409.6,RUN),-1) Q:'V1
137 F V3="R","S" S V2=0 F S V2=$O(^SDWL(409.6,"AE",V3,V1,V2)) Q:'V2 D
138 . S ZNODE=$G(^SDWL(409.6,V1,1,V2,0))
139 . S DIK="^SDWL(409.6,"_V1_",1,"
140 . S DA(1)=V1,DA=V2 D ^DIK
141 . S ^XTMP("SDRPA-"_$P(ZNODE,"^",3),"CLEAN",+$P(ZNODE,"^",4),0)=ZNODE ;diagnostics
142 Q
143MSG(BATCHIDO,TYPE,RUNIEN,BATCHID) ;acknowledgement notification to mail group
144 ;BATCHID : Our Message ID
145 ;BATCHIDO: Batch Control ID
146 ;TYPE : type of message (accept with rejects - 1, whole accept 2, whole reject -3)
147 ;RUNIEN : run ien associated with this batch
148 ;SDAMX : message text array
149 ;XMSUB : subject
150 ;XMY : addressee
151 ;XMTEXT : location of text array
152 ;XMDUZ : sender of the message
153 ;RUNZ : zero node of run associated with this batch
154 N RUNZ,SDAMX,V0,V1,V2,V3,XMSUB,XMY,XMTEXT,XMDUZ
155 Q:BATCHID=""
156 S V0=$P($G(^SDWL(409.6,RUNIEN,2,0)),"^",4)
157 S (V1,V3)=0 F S V1=$O(^SDWL(409.6,RUNIEN,2,V1)) Q:'V1 D
158 . S V2=$P($G(^SDWL(409.6,RUNIEN,2,V1,0)),"^",4)
159 . S:V2'="" V3=V3+1
160 . ;S V3=V3+1
161 S RUNZ=$G(^SDWL(409.6,RUNIEN,0))
162 S XMSUB="PAIT BATCH ACKNOWLEGEMENT "_BATCHIDO
163 S XMY("G.SD-PAIT")=""
164 S XMY("S.SD-PAIT-SERVER@FORUM.VA.GOV")=""
165 S XMTEXT="SDAMX("
166 S XMDUZ="POSTMASTER"
167 I TYPE=1 D
168 . S SDAMX(1)=" Station Number: "_$P($$SITE^VASITE(),"^",3)
169 . S SDAMX(2)="Batch Control ID: "_BATCHIDO
170 . S SDAMX(3)=" Message ID: "_BATCHID
171 . S SDAMX(4)=" Log Entry: "_RUNIEN
172 . S SDAMX(5)=" Run Date: "_$$FMTE^XLFDT($P(RUNZ,"^",7))
173 . S SDAMX(6)=" Status: Acknowledged - with rejections "
174 . S SDAMX(7)=" "_V3_" of "_V0_" ACKs received for this run date"
175 . S SDAMX(8)=""
176 . S SDAMX(9)="Use option SD-PAIT REJECTED Rejected Transmissions to view the rejections."
177 I TYPE=2 D
178 . S SDAMX(1)=" Station Number: "_$P($$SITE^VASITE(),"^",3)
179 . S SDAMX(2)="Batch Control ID: "_BATCHIDO
180 . S SDAMX(3)=" Message ID: "_BATCHID
181 . S SDAMX(4)=" Log Entry: "_RUNIEN
182 . S SDAMX(5)=" Run Date: "_$$FMTE^XLFDT($P(RUNZ,"^",7))
183 . S SDAMX(6)=" Status: Acknowledged - No Rejections"
184 . S SDAMX(7)=" "_V3_" of "_V0_" ACKs received for this run date"
185 I TYPE=3 D
186 . S SDAMX(1)=" Station Number: "_$P($$SITE^VASITE(),"^",3)
187 . S SDAMX(2)="Batch Control ID: "_BATCHIDO
188 . S SDAMX(3)=" Message ID: "_BATCHID
189 . S SDAMX(4)=" Log Entry: "_RUNIEN
190 . S SDAMX(5)=" Run Date: "_$$FMTE^XLFDT($P(RUNZ,"^",7))
191 . S SDAMX(6)=" Status: Acknowledged - Entire Batch Rejected"
192 . S SDAMX(7)=" "_V3_" of "_V0_" ACKs received for this run date"
193 D ^XMD
194 Q
195OURB(RUNIEN,BATCHIDO) ;match batch id to msg control id ("AMSG" xref)
196 ;RUNIEN : the ien in file 409.6 of the run
197 ;BATCHIDO : batchid pulled from the ACK message
198 ;V2 : returns 0 if none, or msg control id
199 N V1,V2,VNODE
200 S V2=0
201 I '$G(RUNIEN) Q V2
202 I '$G(BATCHIDO) Q V2
203 I $G(^SDWL(409.6,RUNIEN,2,0))="" Q V2
204 S V1=0 F S V1=$O(^SDWL(409.6,RUNIEN,2,"B",BATCHIDO,V1)) Q:'V1 D
205 . S VNODE=$G(^SDWL(409.6,RUNIEN,2,V1,0)) Q:VNODE=""
206 . I $P(VNODE,"^",3)="" Q
207 . S V2=$P(VNODE,"^",3) Q
208 Q V2
209RUNIEN(BATCHID) ;get runien
210 N V1,V2
211 S V2=0
212 S V1=999999999 F S V1=$O(^SDWL(409.6,V1),-1) Q:'V1!(V2) D
213 . I $O(^SDWL(409.6,V1,2,"B",BATCHID,"")) S V2=V1 Q
214 Q V2
Note: See TracBrowser for help on using the repository browser.