SDRPA06 ;bp-oifo/swo pait hl7 ack handling ; 10/31/04 3:53pm
 ;;5.3;Scheduling;**290,333,349,376**;AUG 13, 1993
 ;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=""
 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 V2=$P($G(^SDWL(409.6,RUNIEN,2,V1,0)),"^",4)
 . S:V2'="" V3=V3+1
 . ;S V3=V3+1
 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