RCXVACK ;DAOU/ALA-AR Data Extraction HL7 Query/ACK ;28-JUL-03
 ;;4.5;Accounts Receivable;**201**;Mar 20, 1995
 ;
 ;** Program Description **
 ;  This program will handle an acknowledgment message
 ;  from either Vitria or Boston Allocation Resource
 ;  Center
 ;
EN ;  Entry point
 ;
 ;  Load the HL7 message into temporary global
 K ^TMP($J,"RCXVACK")
 F SEGCNT=1:1 X HLNEXT Q:HLQUIT'>0  D
 . S CNT=0
 . S ^TMP($J,"RCXVACK",SEGCNT,CNT)=HLNODE
 . F  S CNT=$O(HLNODE(CNT)) Q:'CNT  D
 .. S ^TMP($J,"RCXVACK",SEGCNT,CNT)=HLNODE(CNT)
 ;
 S SEGMT=$G(^TMP($J,"RCXVACK",1,0))
 I $E(SEGMT,1,3)'="MSH" S MSG(1)="MSH Segment is not the first segment found" D ERR G EXIT
 S HLFS=$E(SEGMT,4)
 S RCI=0,QRY=0,ACK=0
 F  S RCI=$O(^TMP($J,"RCXVACK",RCI)) Q:'RCI  D  Q:ACK
 . I $P(^TMP($J,"RCXVACK",RCI,0),HLFS,1)="MSA" S ACK=1 D ACK Q
 . ;
 . I $P(^TMP($J,"RCXVACK",RCI,0),HLFS,1)="QRD" D QRY
 ;
EXIT K RCI,ACK,QRY,NDAYS,FDATE,RCXSEG,RREFR,RN,RCXVDA,DTMRCD,RCXVBTN,HLFS
 K RCVXDSC,RTASKS,ZTDESC,ZTRTN,ZTDTH,RREFR,RCXVFFD,RCXVFTD,CURDT,CDOW
 K HL,HLNEXT,HLNODE,HLQUIT,MSG,RCXVUPD,SEGCNT,SEGMT
 K ^TMP("RCXVA",$J),^TMP($J,"RCXVACK")
 Q
 ;
ERR ;
 Q
 ;
ACK ;  Set Acknowledgement
 S RCI=$O(^TMP($J,"RCXVACK",RCI)) Q:'RCI
 I $P(^TMP($J,"RCXVACK",RCI,0),HLFS,1)'="QRD" G ACK
 S RREFR="^TMP($J,""RCXVACK"",RCI)"
 D SPAR^RCXVUTIL(RREFR)
 ;
 S DTMRCD=$G(RCXSEG(2)),RCXVBTN=$G(RCXSEG(5))
 ;
 K ^TMP("RCXVA",$J)
 D FIND^DIC(348.4,"","","P",RCXVBTN,"","B","","","^TMP(""RCXVA"",$J)")
 S RN=$P($G(^TMP("RCXVA",$J,"DILIST",0)),U,1)
 I RN=0 Q
 S RCXVDA=$P($G(^TMP("RCXVA",$J,"DILIST",RN,0)),U,1)
 S RCXVUPD(348.4,RCXVDA_",",.08)=$$FMDATE^HLFNC(DTMRCD)
 S RCXVUPD(348.4,RCXVDA_",",.03)="C"
 D FILE^DIE("I","RCXVUPD","RCXVERR")
 Q
 ;
QRY ;  Process Query
 S RREFR="^TMP($J,""RCXVACK"",RCI)"
 D SPAR^RCXVUTIL(RREFR)
 ;
 S RCXVFFD=$P($G(RCXSEG(12)),U,1),RCXVFTD=$P($G(RCXSEG(12)),U,2)
 S RCXVFFD=$$FMDATE^HLFNC(RCXVFFD)
 S RCXVFTD=$$FMDATE^HLFNC(RCXVFTD)
 ;
 ;  Get the next Saturday date
 S CURDT=$$DT^XLFDT()
 S CDOW=$$DOW^XLFDT(CURDT,1),NDAYS=6-CDOW
 S FDATE=$$FMADD^XLFDT(CURDT,NDAYS)
 ;
 S RCVXDSC="REQUESTED CBO HISTORICAL EXTRACT"
 S ZTDESC=RCVXDSC,ZTRTN="HIS^RCXVTSK",ZTIO=""
 S ZTSAVE("RCXVFTD")="",ZTSAVE("RCXVFFD")=""
 S ZTDTH=FDATE_".06"
 D ^%ZTLOAD
 Q