SDRPA06 ;bp-oifo/swo pait hl7 ack handling ; 10/31/04 3:53pm
;;5.3;Scheduling;**290,333,349,376,491,1015**;AUG 13, 1993;Build 21
;routine called from Vista HL7 when ack messages are received in response
;to an out going HL7 message generated by protocol SC-PAIT-EVENT
ACK ;entry point from Vista HL7
;ACKDATE : date/time ack received
;FLDSEP : field separator
;CMPNTSEP : component separator
;REPTNSEP : repetition separator
;ACKCODE : acknowledgement code
;ERROR : reject reason
;BATCHID : batch control ID
;BATCHIDO : original batch control ID
N ACKCODE,ACKDATE,BATCHID,BATCHIDO,CMPNTSEP,ERROR,FLDSEP,REPTNSEP,RUNIEN,SDZAP,V1
;disable automatic repair of the last run, not needed to process acks
;NHD will be notified when the completion message does not come out
;D RSTAT^SDRPA02 ;check the status of the last run
K ^TMP("SDRPA06",$J)
S SDZAP=0
S ACKDATE=$$NOW^XLFDT()
S FLDSEP=HL("FS")
S CMPNTSEP=$E(HL("ECH"),1)
S REPTNSEP=$E(HL("ECH"),2)
S ACKCODE=$P(HLMSA,FLDSEP)
S ERROR=$P(HLMSA,FLDSEP,4)
S (BATCHID,BATCHIDO)=$P(HLMSA,FLDSEP,2)
S RUNIEN=$$RUNIEN(BATCHIDO) Q:'RUNIEN
S BATCHID=$$OURB(RUNIEN,BATCHIDO) ;convert to our batch id
Q:'BATCHID ;error needs to be handled
;S V1=$O(^SDWL(409.6,"AMSG",BATCHID,"")),RUNIEN=$O(^SDWL(409.6,"AMSG",BATCHID,V1,""))
S V1=$O(^SDWL(409.6,"AMSG",BATCHID,"")) Q:V1=""
Q:'$$DUP^SDRPA02(RUNIEN,BATCHIDO) ;check for duplicate
S ^XTMP("SDRPA-"_BATCHID,0)=$$FMADD^XLFDT($$DT^XLFDT(),3)_"^"_$$DT^XLFDT() ;set xtmp global for diagnostics
I $E(ACKCODE,1,2)="AR" D AR(BATCHID,BATCHIDO),MSG(BATCHIDO,3,RUNIEN,BATCHID) Q ;whole batch rejection
;Q:($E(ACKCODE,1,2)'="AA") ;quit if not a application ack
;will only be 2 ACKCODEs AA and AE so don't have to screen anymore
F X HLNEXT Q:(HLQUIT'>0) D ;start looping the msg text
. Q:($E(HLNODE,1,3)'="MSA") ;skip if not a MSA segment
. I $P(HLNODE,FLDSEP,2)="AE" D ;it's an error
.. Q:($P($P(HLNODE,FLDSEP,3),"-",2))="" ;no message number
.. S ^TMP("SDRPA06",$J,+$P($P(HLNODE,FLDSEP,3),"-",2))=+$P(HLNODE,"^",4) ;set xref with message #
I '$D(^TMP("SDRPA06",$J)) D AA(BATCHID,BATCHIDO),MSG(BATCHIDO,2,RUNIEN,BATCHID) Q ;whole batch accept
D AAAR(BATCHID,BATCHIDO),MSG(BATCHIDO,1,RUNIEN,BATCHID) ;batch accept with errors
Q
AR(BATCH,BATCHIDO) ;whole batch rejection
;BATCH : originating batch number
;BATCHIDO : original batch number from HL7 ACK
;V1 : sequence # (individual message number in batch)
;V2 : run # (ien of multiple entry)
;V3 : ien (ien in patient multiple)
;V4 : ien (ien batch tracking multiple)
Q:($G(BATCH)="")
N DA,DIE,DR,V1,V2,V3,V4,ZNODE
S V1=0
F S V1=$O(^SDWL(409.6,"AMSG",BATCH,V1)) Q:'V1 D
. S V2=$O(^SDWL(409.6,"AMSG",BATCH,V1,"")) Q:'V2
. ;batch tracking enhancement
. S V4=$O(^SDWL(409.6,V2,2,"B",BATCHIDO,"")) Q:'V4 D
.. S DA=V4,DA(1)=V2,DIE="^SDWL(409.6,"_V2_",2,",DR=".04///"_$$NOW^XLFDT_";.05///"_ACKCODE
.. D ^DIE K DIE
. S V3=0 F S V3=$O(^SDWL(409.6,"AMSG",BATCH,V1,V2,V3)) Q:'V3 D
.. S ZNODE=$G(^SDWL(409.6,V2,1,V3,0)) Q:ZNODE=""
.. ;4TH PIECE IS MESSAGE NUMBER
.. S DA=V3,DA(1)=V2,DIE="^SDWL(409.6,"_V2_",1,"
.. S DR="7////"_$O(^SCPT(404.472,"B","R","")) D ^DIE
.. I $D(^SDWL(409.6,"AE","Y",V2,V3)) Q
.. I $D(^SDWL(409.6,"AE","N",V2,V3)) D
... S DR="4///Y" D ^DIE
Q
AA(BATCH,BATCHIDO) ;whole batch accept
;if the batch is accepted and no rejections then get the run # sequence #
;from AMSG xref. If no "AE","Y" xref then call DIK to delete the entry
;BATCH : originating batch number
;BATCHIDO : original batch number from HL7 ACK
;V1 : sequence # (individual message number in batch)
;V2 : run # (ien of multiple entry)
;V3 : ien (ien in patient multiple)
;V4 : ien (ien batch tracking multiple)
Q:($G(BATCH)="")
N DA,DIK,DR,V1,V2,V3,V4,ZNODE
S V1=0
F S V1=$O(^SDWL(409.6,"AMSG",BATCH,V1)) Q:'V1 D
. S V2=$O(^SDWL(409.6,"AMSG",BATCH,V1,"")) Q:'V2
. ;batch tracking enhancement
. S V4=$O(^SDWL(409.6,V2,2,"B",BATCHIDO,"")) Q:'V4 D
.. S DA=V4,DA(1)=V2,DIE="^SDWL(409.6,"_V2_",2,",DR=".04///"_$$NOW^XLFDT_";.05///"_ACKCODE
.. D ^DIE K DIE
. S V3=0 F S V3=$O(^SDWL(409.6,"AMSG",BATCH,V1,V2,V3)) Q:'V3 D
.. S ZNODE=$G(^SDWL(409.6,V2,1,V3,0)) Q:ZNODE=""
.. ;4th piece is the message #
.. I '$D(^SDWL(409.6,"AE","Y",V2,V3)) D
... S DIK="^SDWL(409.6,"_V2_",1,"
... S DA(1)=V2,DA=V3 D ^DIK
... S ^XTMP("SDRPA-"_BATCH,+$P(ZNODE,"^",4),0)=ZNODE ;diagnostics
Q
AAAR(BATCH,BATCHIDO) ;batch accept with errors
;BATCH : originating batch number
;BATCHIDO : original batch number from HL7 ACK
;V1 : sequence # (individual message number in batch)
;V2 : run # (ien of multiple entry)
;V3 : ien (ien in patient multiple)
;V4 : ien (ien batch tracking multiple))
Q:($G(BATCH)="")
N DA,DIK,DR,V1,V2,V3,V4,ZNODE
S V1=0
F S V1=$O(^SDWL(409.6,"AMSG",BATCH,V1)) Q:'V1 D
. S V2=$O(^SDWL(409.6,"AMSG",BATCH,V1,"")) Q:'V2
. ;batch tracking enhancement
. S V4=$O(^SDWL(409.6,V2,2,"B",BATCHIDO,"")) Q:'V4 D
.. S DA=V4,DA(1)=V2,DIE="^SDWL(409.6,"_V2_",2,",DR=".04///"_$$NOW^XLFDT_";.05///"_ACKCODE
.. D ^DIE K DIE
. S V3=0 F S V3=$O(^SDWL(409.6,"AMSG",BATCH,V1,V2,V3)) Q:'V3 D
.. S ZNODE=$G(^SDWL(409.6,V2,1,V3,0)) Q:ZNODE=""
.. ;4th piece is the message #
.. ;next line screens for accepted batch + accepted message + status final and can be deleted
.. I '$D(^SDWL(409.6,"AE","Y",V2,V3))&('$D(^TMP("SDRPA06",$J,$P(ZNODE,"^",4)))) D
... S DIK="^SDWL(409.6,"_V2_",1,"
... S DA(1)=V2,DA=V3 D ^DIK
... S ^XTMP("SDRPA-"_BATCH,+$P(ZNODE,"^",4),0)=ZNODE ;diagnostics
.. ;next line screens for accepted batch + error message
.. I $D(^TMP("SDRPA06",$J,$P(ZNODE,"^",4))) D
... S DA=V3,DA(1)=V2,DIE="^SDWL(409.6,"_V2_",1,"
... S DR="7////"_$O(^SCPT(404.472,"B",$G(^TMP("SDRPA06",$J,$P(ZNODE,"^",4))),"")) D ^DIE
... I $D(^SDWL(409.6,"AE","Y",V2,V3)) Q
... I $D(^SDWL(409.6,"AE","N",V2,V3)) D
.... S DR="4///Y" D ^DIE
Q
CLEAN(RUN) ;housekeeping
;clean up batch previous to current one by checking for "AE",("S" or "R") xref and
;deleting if entry in xref exists
;RUN : run # (ien of multiple entry)
;V1 : previous run # (ien of multiple entry)
;V2 : ien (ien in multiple)
Q:($G(RUN)="")
N V1,V2,V3
S V1=$O(^SDWL(409.6,RUN),-1) Q:'V1
F V3="R","S" S V2=0 F S V2=$O(^SDWL(409.6,"AE",V3,V1,V2)) Q:'V2 D
. S ZNODE=$G(^SDWL(409.6,V1,1,V2,0))
. S DIK="^SDWL(409.6,"_V1_",1,"
. S DA(1)=V1,DA=V2 D ^DIK
. S ^XTMP("SDRPA-"_$P(ZNODE,"^",3),"CLEAN",+$P(ZNODE,"^",4),0)=ZNODE ;diagnostics
Q
MSG(BATCHIDO,TYPE,RUNIEN,BATCHID) ;acknowledgement notification to mail group
;BATCHID : Our Message ID
;BATCHIDO: Batch Control ID
;TYPE : type of message (accept with rejects - 1, whole accept 2, whole reject -3)
;RUNIEN : run ien associated with this batch
;SDAMX : message text array
;XMSUB : subject
;XMY : addressee
;XMTEXT : location of text array
;XMDUZ : sender of the message
;RUNZ : zero node of run associated with this batch
N RUNZ,SDAMX,V0,V1,V2,V3,XMSUB,XMY,XMTEXT,XMDUZ
Q:BATCHID=""
L +^SDWL(409.6,RUNIEN,2,0)
S V0=$P($G(^SDWL(409.6,RUNIEN,2,0)),"^",4)
S (V1,V3)=0 F S V1=$O(^SDWL(409.6,RUNIEN,2,V1)) Q:'V1 D
. S:$P($G(^SDWL(409.6,RUNIEN,2,V1,0)),"^",4)'="" V3=V3+1
L -^SDWL(409.6,RUNIEN,2,0)
S RUNZ=$G(^SDWL(409.6,RUNIEN,0))
S XMSUB="PAIT BATCH ACKNOWLEGEMENT "_BATCHIDO
S XMY("G.SD-PAIT")=""
S XMY("S.SD-PAIT-SERVER@FORUM.VA.GOV")=""
S XMTEXT="SDAMX("
S XMDUZ="POSTMASTER"
I TYPE=1 D
. S SDAMX(1)=" Station Number: "_$P($$SITE^VASITE(),"^",3)
. S SDAMX(2)="Batch Control ID: "_BATCHIDO
. S SDAMX(3)=" Message ID: "_BATCHID
. S SDAMX(4)=" Log Entry: "_RUNIEN
. S SDAMX(5)=" Run Date: "_$$FMTE^XLFDT($P(RUNZ,"^",7))
. S SDAMX(6)=" Status: Acknowledged - with rejections "
. S SDAMX(7)=" "_V3_" of "_V0_" ACKs received for this run date"
. S SDAMX(8)=""
. S SDAMX(9)="Use option SD-PAIT REJECTED Rejected Transmissions to view the rejections."
I TYPE=2 D
. S SDAMX(1)=" Station Number: "_$P($$SITE^VASITE(),"^",3)
. S SDAMX(2)="Batch Control ID: "_BATCHIDO
. S SDAMX(3)=" Message ID: "_BATCHID
. S SDAMX(4)=" Log Entry: "_RUNIEN
. S SDAMX(5)=" Run Date: "_$$FMTE^XLFDT($P(RUNZ,"^",7))
. S SDAMX(6)=" Status: Acknowledged - No Rejections"
. S SDAMX(7)=" "_V3_" of "_V0_" ACKs received for this run date"
I TYPE=3 D
. S SDAMX(1)=" Station Number: "_$P($$SITE^VASITE(),"^",3)
. S SDAMX(2)="Batch Control ID: "_BATCHIDO
. S SDAMX(3)=" Message ID: "_BATCHID
. S SDAMX(4)=" Log Entry: "_RUNIEN
. S SDAMX(5)=" Run Date: "_$$FMTE^XLFDT($P(RUNZ,"^",7))
. S SDAMX(6)=" Status: Acknowledged - Entire Batch Rejected"
. S SDAMX(7)=" "_V3_" of "_V0_" ACKs received for this run date"
D ^XMD
Q
OURB(RUNIEN,BATCHIDO) ;match batch id to msg control id ("AMSG" xref)
;RUNIEN : the ien in file 409.6 of the run
;BATCHIDO : batchid pulled from the ACK message
;V2 : returns 0 if none, or msg control id
N V1,V2,VNODE
S V2=0
I '$G(RUNIEN) Q V2
I '$G(BATCHIDO) Q V2
I $G(^SDWL(409.6,RUNIEN,2,0))="" Q V2
S V1=0 F S V1=$O(^SDWL(409.6,RUNIEN,2,"B",BATCHIDO,V1)) Q:'V1 D
. S VNODE=$G(^SDWL(409.6,RUNIEN,2,V1,0)) Q:VNODE=""
. I $P(VNODE,"^",3)="" Q
. S V2=$P(VNODE,"^",3) Q
Q V2
RUNIEN(BATCHID) ;get runien
N V1,V2
S V2=0
S V1=999999999 F S V1=$O(^SDWL(409.6,V1),-1) Q:'V1!(V2) D
. I $O(^SDWL(409.6,V1,2,"B",BATCHID,"")) S V2=V1 Q
Q V2
SDRPA06 ;bp-oifo/swo pait hl7 ack handling ; 10/31/04 3:53pm
+1 ;;5.3;Scheduling;**290,333,349,376,491,1015**;AUG 13, 1993;Build 21
+2 ;routine called from Vista HL7 when ack messages are received in response
+3 ;to an out going HL7 message generated by protocol SC-PAIT-EVENT
ACK ;entry point from Vista HL7
+1 ;ACKDATE : date/time ack received
+2 ;FLDSEP : field separator
+3 ;CMPNTSEP : component separator
+4 ;REPTNSEP : repetition separator
+5 ;ACKCODE : acknowledgement code
+6 ;ERROR : reject reason
+7 ;BATCHID : batch control ID
+8 ;BATCHIDO : original batch control ID
+9 NEW ACKCODE,ACKDATE,BATCHID,BATCHIDO,CMPNTSEP,ERROR,FLDSEP,REPTNSEP,RUNIEN,SDZAP,V1
+10 ;disable automatic repair of the last run, not needed to process acks
+11 ;NHD will be notified when the completion message does not come out
+12 ;D RSTAT^SDRPA02 ;check the status of the last run
+13 KILL ^TMP("SDRPA06",$JOB)
+14 SET SDZAP=0
+15 SET ACKDATE=$$NOW^XLFDT()
+16 SET FLDSEP=HL("FS")
+17 SET CMPNTSEP=$EXTRACT(HL("ECH"),1)
+18 SET REPTNSEP=$EXTRACT(HL("ECH"),2)
+19 SET ACKCODE=$PIECE(HLMSA,FLDSEP)
+20 SET ERROR=$PIECE(HLMSA,FLDSEP,4)
+21 SET (BATCHID,BATCHIDO)=$PIECE(HLMSA,FLDSEP,2)
+22 SET RUNIEN=$$RUNIEN(BATCHIDO)
IF 'RUNIEN
QUIT
+23 ;convert to our batch id
SET BATCHID=$$OURB(RUNIEN,BATCHIDO)
+24 ;error needs to be handled
IF 'BATCHID
QUIT
+25 ;S V1=$O(^SDWL(409.6,"AMSG",BATCHID,"")),RUNIEN=$O(^SDWL(409.6,"AMSG",BATCHID,V1,""))
+26 SET V1=$ORDER(^SDWL(409.6,"AMSG",BATCHID,""))
IF V1=""
QUIT
+27 ;check for duplicate
IF '$$DUP^SDRPA02(RUNIEN,BATCHIDO)
QUIT
+28 ;set xtmp global for diagnostics
SET ^XTMP("SDRPA-"_BATCHID,0)=$$FMADD^XLFDT($$DT^XLFDT(),3)_"^"_$$DT^XLFDT()
+29 ;whole batch rejection
IF $EXTRACT(ACKCODE,1,2)="AR"
DO AR(BATCHID,BATCHIDO)
DO MSG(BATCHIDO,3,RUNIEN,BATCHID)
QUIT
+30 ;Q:($E(ACKCODE,1,2)'="AA") ;quit if not a application ack
+31 ;will only be 2 ACKCODEs AA and AE so don't have to screen anymore
+32 ;start looping the msg text
FOR
XECUTE HLNEXT
IF (HLQUIT'>0)
QUIT
Begin DoDot:1
+33 ;skip if not a MSA segment
IF ($EXTRACT(HLNODE,1,3)'="MSA")
QUIT
+34 ;it's an error
IF $PIECE(HLNODE,FLDSEP,2)="AE"
Begin DoDot:2
+35 ;no message number
IF ($PIECE($PIECE(HLNODE,FLDSEP,3),"-",2))=""
QUIT
+36 ;set xref with message #
SET ^TMP("SDRPA06",$JOB,+$PIECE($PIECE(HLNODE,FLDSEP,3),"-",2))=+$PIECE(HLNODE,"^",4)
End DoDot:2
End DoDot:1
+37 ;whole batch accept
IF '$DATA(^TMP("SDRPA06",$JOB))
DO AA(BATCHID,BATCHIDO)
DO MSG(BATCHIDO,2,RUNIEN,BATCHID)
QUIT
+38 ;batch accept with errors
DO AAAR(BATCHID,BATCHIDO)
DO MSG(BATCHIDO,1,RUNIEN,BATCHID)
+39 QUIT
AR(BATCH,BATCHIDO) ;whole batch rejection
+1 ;BATCH : originating batch number
+2 ;BATCHIDO : original batch number from HL7 ACK
+3 ;V1 : sequence # (individual message number in batch)
+4 ;V2 : run # (ien of multiple entry)
+5 ;V3 : ien (ien in patient multiple)
+6 ;V4 : ien (ien batch tracking multiple)
+7 IF ($GET(BATCH)="")
QUIT
+8 NEW DA,DIE,DR,V1,V2,V3,V4,ZNODE
+9 SET V1=0
+10 FOR
SET V1=$ORDER(^SDWL(409.6,"AMSG",BATCH,V1))
IF 'V1
QUIT
Begin DoDot:1
+11 SET V2=$ORDER(^SDWL(409.6,"AMSG",BATCH,V1,""))
IF 'V2
QUIT
+12 ;batch tracking enhancement
+13 SET V4=$ORDER(^SDWL(409.6,V2,2,"B",BATCHIDO,""))
IF 'V4
QUIT
Begin DoDot:2
+14 SET DA=V4
SET DA(1)=V2
SET DIE="^SDWL(409.6,"_V2_",2,"
SET DR=".04///"_$$NOW^XLFDT_";.05///"_ACKCODE
+15 DO ^DIE
KILL DIE
End DoDot:2
+16 SET V3=0
FOR
SET V3=$ORDER(^SDWL(409.6,"AMSG",BATCH,V1,V2,V3))
IF 'V3
QUIT
Begin DoDot:2
+17 SET ZNODE=$GET(^SDWL(409.6,V2,1,V3,0))
IF ZNODE=""
QUIT
+18 ;4TH PIECE IS MESSAGE NUMBER
+19 SET DA=V3
SET DA(1)=V2
SET DIE="^SDWL(409.6,"_V2_",1,"
+20 SET DR="7////"_$ORDER(^SCPT(404.472,"B","R",""))
DO ^DIE
+21 IF $DATA(^SDWL(409.6,"AE","Y",V2,V3))
QUIT
+22 IF $DATA(^SDWL(409.6,"AE","N",V2,V3))
Begin DoDot:3
+23 SET DR="4///Y"
DO ^DIE
End DoDot:3
End DoDot:2
End DoDot:1
+24 QUIT
AA(BATCH,BATCHIDO) ;whole batch accept
+1 ;if the batch is accepted and no rejections then get the run # sequence #
+2 ;from AMSG xref. If no "AE","Y" xref then call DIK to delete the entry
+3 ;BATCH : originating batch number
+4 ;BATCHIDO : original batch number from HL7 ACK
+5 ;V1 : sequence # (individual message number in batch)
+6 ;V2 : run # (ien of multiple entry)
+7 ;V3 : ien (ien in patient multiple)
+8 ;V4 : ien (ien batch tracking multiple)
+9 IF ($GET(BATCH)="")
QUIT
+10 NEW DA,DIK,DR,V1,V2,V3,V4,ZNODE
+11 SET V1=0
+12 FOR
SET V1=$ORDER(^SDWL(409.6,"AMSG",BATCH,V1))
IF 'V1
QUIT
Begin DoDot:1
+13 SET V2=$ORDER(^SDWL(409.6,"AMSG",BATCH,V1,""))
IF 'V2
QUIT
+14 ;batch tracking enhancement
+15 SET V4=$ORDER(^SDWL(409.6,V2,2,"B",BATCHIDO,""))
IF 'V4
QUIT
Begin DoDot:2
+16 SET DA=V4
SET DA(1)=V2
SET DIE="^SDWL(409.6,"_V2_",2,"
SET DR=".04///"_$$NOW^XLFDT_";.05///"_ACKCODE
+17 DO ^DIE
KILL DIE
End DoDot:2
+18 SET V3=0
FOR
SET V3=$ORDER(^SDWL(409.6,"AMSG",BATCH,V1,V2,V3))
IF 'V3
QUIT
Begin DoDot:2
+19 SET ZNODE=$GET(^SDWL(409.6,V2,1,V3,0))
IF ZNODE=""
QUIT
+20 ;4th piece is the message #
+21 IF '$DATA(^SDWL(409.6,"AE","Y",V2,V3))
Begin DoDot:3
+22 SET DIK="^SDWL(409.6,"_V2_",1,"
+23 SET DA(1)=V2
SET DA=V3
DO ^DIK
+24 ;diagnostics
SET ^XTMP("SDRPA-"_BATCH,+$PIECE(ZNODE,"^",4),0)=ZNODE
End DoDot:3
End DoDot:2
End DoDot:1
+25 QUIT
AAAR(BATCH,BATCHIDO) ;batch accept with errors
+1 ;BATCH : originating batch number
+2 ;BATCHIDO : original batch number from HL7 ACK
+3 ;V1 : sequence # (individual message number in batch)
+4 ;V2 : run # (ien of multiple entry)
+5 ;V3 : ien (ien in patient multiple)
+6 ;V4 : ien (ien batch tracking multiple))
+7 IF ($GET(BATCH)="")
QUIT
+8 NEW DA,DIK,DR,V1,V2,V3,V4,ZNODE
+9 SET V1=0
+10 FOR
SET V1=$ORDER(^SDWL(409.6,"AMSG",BATCH,V1))
IF 'V1
QUIT
Begin DoDot:1
+11 SET V2=$ORDER(^SDWL(409.6,"AMSG",BATCH,V1,""))
IF 'V2
QUIT
+12 ;batch tracking enhancement
+13 SET V4=$ORDER(^SDWL(409.6,V2,2,"B",BATCHIDO,""))
IF 'V4
QUIT
Begin DoDot:2
+14 SET DA=V4
SET DA(1)=V2
SET DIE="^SDWL(409.6,"_V2_",2,"
SET DR=".04///"_$$NOW^XLFDT_";.05///"_ACKCODE
+15 DO ^DIE
KILL DIE
End DoDot:2
+16 SET V3=0
FOR
SET V3=$ORDER(^SDWL(409.6,"AMSG",BATCH,V1,V2,V3))
IF 'V3
QUIT
Begin DoDot:2
+17 SET ZNODE=$GET(^SDWL(409.6,V2,1,V3,0))
IF ZNODE=""
QUIT
+18 ;4th piece is the message #
+19 ;next line screens for accepted batch + accepted message + status final and can be deleted
+20 IF '$DATA(^SDWL(409.6,"AE","Y",V2,V3))&('$DATA(^TMP("SDRPA06",$JOB,$PIECE(ZNODE,"^",4))))
Begin DoDot:3
+21 SET DIK="^SDWL(409.6,"_V2_",1,"
+22 SET DA(1)=V2
SET DA=V3
DO ^DIK
+23 ;diagnostics
SET ^XTMP("SDRPA-"_BATCH,+$PIECE(ZNODE,"^",4),0)=ZNODE
End DoDot:3
+24 ;next line screens for accepted batch + error message
+25 IF $DATA(^TMP("SDRPA06",$JOB,$PIECE(ZNODE,"^",4)))
Begin DoDot:3
+26 SET DA=V3
SET DA(1)=V2
SET DIE="^SDWL(409.6,"_V2_",1,"
+27 SET DR="7////"_$ORDER(^SCPT(404.472,"B",$GET(^TMP("SDRPA06",$JOB,$PIECE(ZNODE,"^",4))),""))
DO ^DIE
+28 IF $DATA(^SDWL(409.6,"AE","Y",V2,V3))
QUIT
+29 IF $DATA(^SDWL(409.6,"AE","N",V2,V3))
Begin DoDot:4
+30 SET DR="4///Y"
DO ^DIE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+31 QUIT
CLEAN(RUN) ;housekeeping
+1 ;clean up batch previous to current one by checking for "AE",("S" or "R") xref and
+2 ;deleting if entry in xref exists
+3 ;RUN : run # (ien of multiple entry)
+4 ;V1 : previous run # (ien of multiple entry)
+5 ;V2 : ien (ien in multiple)
+6 IF ($GET(RUN)="")
QUIT
+7 NEW V1,V2,V3
+8 SET V1=$ORDER(^SDWL(409.6,RUN),-1)
IF 'V1
QUIT
+9 FOR V3="R","S"
SET V2=0
FOR
SET V2=$ORDER(^SDWL(409.6,"AE",V3,V1,V2))
IF 'V2
QUIT
Begin DoDot:1
+10 SET ZNODE=$GET(^SDWL(409.6,V1,1,V2,0))
+11 SET DIK="^SDWL(409.6,"_V1_",1,"
+12 SET DA(1)=V1
SET DA=V2
DO ^DIK
+13 ;diagnostics
SET ^XTMP("SDRPA-"_$PIECE(ZNODE,"^",3),"CLEAN",+$PIECE(ZNODE,"^",4),0)=ZNODE
End DoDot:1
+14 QUIT
MSG(BATCHIDO,TYPE,RUNIEN,BATCHID) ;acknowledgement notification to mail group
+1 ;BATCHID : Our Message ID
+2 ;BATCHIDO: Batch Control ID
+3 ;TYPE : type of message (accept with rejects - 1, whole accept 2, whole reject -3)
+4 ;RUNIEN : run ien associated with this batch
+5 ;SDAMX : message text array
+6 ;XMSUB : subject
+7 ;XMY : addressee
+8 ;XMTEXT : location of text array
+9 ;XMDUZ : sender of the message
+10 ;RUNZ : zero node of run associated with this batch
+11 NEW RUNZ,SDAMX,V0,V1,V2,V3,XMSUB,XMY,XMTEXT,XMDUZ
+12 IF BATCHID=""
QUIT
+13 LOCK +^SDWL(409.6,RUNIEN,2,0)
+14 SET V0=$PIECE($GET(^SDWL(409.6,RUNIEN,2,0)),"^",4)
+15 SET (V1,V3)=0
FOR
SET V1=$ORDER(^SDWL(409.6,RUNIEN,2,V1))
IF 'V1
QUIT
Begin DoDot:1
+16 IF $PIECE($GET(^SDWL(409.6,RUNIEN,2,V1,0)),"^",4)'=""
SET V3=V3+1
End DoDot:1
+17 LOCK -^SDWL(409.6,RUNIEN,2,0)
+18 SET RUNZ=$GET(^SDWL(409.6,RUNIEN,0))
+19 SET XMSUB="PAIT BATCH ACKNOWLEGEMENT "_BATCHIDO
+20 SET XMY("G.SD-PAIT")=""
+21 SET XMY("S.SD-PAIT-SERVER@FORUM.VA.GOV")=""
+22 SET XMTEXT="SDAMX("
+23 SET XMDUZ="POSTMASTER"
+24 IF TYPE=1
Begin DoDot:1
+25 SET SDAMX(1)=" Station Number: "_$PIECE($$SITE^VASITE(),"^",3)
+26 SET SDAMX(2)="Batch Control ID: "_BATCHIDO
+27 SET SDAMX(3)=" Message ID: "_BATCHID
+28 SET SDAMX(4)=" Log Entry: "_RUNIEN
+29 SET SDAMX(5)=" Run Date: "_$$FMTE^XLFDT($PIECE(RUNZ,"^",7))
+30 SET SDAMX(6)=" Status: Acknowledged - with rejections "
+31 SET SDAMX(7)=" "_V3_" of "_V0_" ACKs received for this run date"
+32 SET SDAMX(8)=""
+33 SET SDAMX(9)="Use option SD-PAIT REJECTED Rejected Transmissions to view the rejections."
End DoDot:1
+34 IF TYPE=2
Begin DoDot:1
+35 SET SDAMX(1)=" Station Number: "_$PIECE($$SITE^VASITE(),"^",3)
+36 SET SDAMX(2)="Batch Control ID: "_BATCHIDO
+37 SET SDAMX(3)=" Message ID: "_BATCHID
+38 SET SDAMX(4)=" Log Entry: "_RUNIEN
+39 SET SDAMX(5)=" Run Date: "_$$FMTE^XLFDT($PIECE(RUNZ,"^",7))
+40 SET SDAMX(6)=" Status: Acknowledged - No Rejections"
+41 SET SDAMX(7)=" "_V3_" of "_V0_" ACKs received for this run date"
End DoDot:1
+42 IF TYPE=3
Begin DoDot:1
+43 SET SDAMX(1)=" Station Number: "_$PIECE($$SITE^VASITE(),"^",3)
+44 SET SDAMX(2)="Batch Control ID: "_BATCHIDO
+45 SET SDAMX(3)=" Message ID: "_BATCHID
+46 SET SDAMX(4)=" Log Entry: "_RUNIEN
+47 SET SDAMX(5)=" Run Date: "_$$FMTE^XLFDT($PIECE(RUNZ,"^",7))
+48 SET SDAMX(6)=" Status: Acknowledged - Entire Batch Rejected"
+49 SET SDAMX(7)=" "_V3_" of "_V0_" ACKs received for this run date"
End DoDot:1
+50 DO ^XMD
+51 QUIT
OURB(RUNIEN,BATCHIDO) ;match batch id to msg control id ("AMSG" xref)
+1 ;RUNIEN : the ien in file 409.6 of the run
+2 ;BATCHIDO : batchid pulled from the ACK message
+3 ;V2 : returns 0 if none, or msg control id
+4 NEW V1,V2,VNODE
+5 SET V2=0
+6 IF '$GET(RUNIEN)
QUIT V2
+7 IF '$GET(BATCHIDO)
QUIT V2
+8 IF $GET(^SDWL(409.6,RUNIEN,2,0))=""
QUIT V2
+9 SET V1=0
FOR
SET V1=$ORDER(^SDWL(409.6,RUNIEN,2,"B",BATCHIDO,V1))
IF 'V1
QUIT
Begin DoDot:1
+10 SET VNODE=$GET(^SDWL(409.6,RUNIEN,2,V1,0))
IF VNODE=""
QUIT
+11 IF $PIECE(VNODE,"^",3)=""
QUIT
+12 SET V2=$PIECE(VNODE,"^",3)
QUIT
End DoDot:1
+13 QUIT V2
RUNIEN(BATCHID) ;get runien
+1 NEW V1,V2
+2 SET V2=0
+3 SET V1=999999999
FOR
SET V1=$ORDER(^SDWL(409.6,V1),-1)
IF 'V1!(V2)
QUIT
Begin DoDot:1
+4 IF $ORDER(^SDWL(409.6,V1,2,"B",BATCHID,""))
SET V2=V1
QUIT
End DoDot:1
+5 QUIT V2
