Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDRPA06.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDRPA06.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDRPA06.m
r613 r623 1 SDRPA06 2 ;;5.3;Scheduling;**290,333,349,376,491**;AUG 13, 1993;Build 533 4 5 ACK 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 AR(BATCH,BATCHIDO) 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 AA(BATCH,BATCHIDO) 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 AAAR(BATCH,BATCHIDO) 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 CLEAN(RUN) 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 MSG(BATCHIDO,TYPE,RUNIEN,BATCHID) 144 145 146 147 148 149 150 151 152 153 154 155 156 L +^SDWL(409.6,RUNIEN,2,0)157 S V0=$P($G(^SDWL(409.6,RUNIEN,2,0)),"^",4) 158 S (V1,V3)=0 F S V1=$O(^SDWL(409.6,RUNIEN,2,V1)) Q:'V1 D 159 . S:$P($G(^SDWL(409.6,RUNIEN,2,V1,0)),"^",4)'="" V3=V3+1160 L -^SDWL(409.6,RUNIEN,2,0) 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 OURB(RUNIEN,BATCHIDO) 196 197 198 199 200 201 202 203 204 205 206 207 208 209 RUNIEN(BATCHID) 210 211 212 213 214 1 SDRPA06 ;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 5 ACK ;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 45 AR(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 70 AA(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 96 AAAR(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 128 CLEAN(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 143 MSG(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 195 OURB(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 209 RUNIEN(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 TracChangeset
for help on using the changeset viewer.
