- 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
