| 1 | RCXVACK ;DAOU/ALA-AR Data Extraction HL7 Query/ACK ;28-JUL-03
|
|---|
| 2 | ;;4.5;Accounts Receivable;**201**;Mar 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ;** Program Description **
|
|---|
| 5 | ; This program will handle an acknowledgment message
|
|---|
| 6 | ; from either Vitria or Boston Allocation Resource
|
|---|
| 7 | ; Center
|
|---|
| 8 | ;
|
|---|
| 9 | EN ; Entry point
|
|---|
| 10 | ;
|
|---|
| 11 | ; Load the HL7 message into temporary global
|
|---|
| 12 | K ^TMP($J,"RCXVACK")
|
|---|
| 13 | F SEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
|
|---|
| 14 | . S CNT=0
|
|---|
| 15 | . S ^TMP($J,"RCXVACK",SEGCNT,CNT)=HLNODE
|
|---|
| 16 | . F S CNT=$O(HLNODE(CNT)) Q:'CNT D
|
|---|
| 17 | .. S ^TMP($J,"RCXVACK",SEGCNT,CNT)=HLNODE(CNT)
|
|---|
| 18 | ;
|
|---|
| 19 | S SEGMT=$G(^TMP($J,"RCXVACK",1,0))
|
|---|
| 20 | I $E(SEGMT,1,3)'="MSH" S MSG(1)="MSH Segment is not the first segment found" D ERR G EXIT
|
|---|
| 21 | S HLFS=$E(SEGMT,4)
|
|---|
| 22 | S RCI=0,QRY=0,ACK=0
|
|---|
| 23 | F S RCI=$O(^TMP($J,"RCXVACK",RCI)) Q:'RCI D Q:ACK
|
|---|
| 24 | . I $P(^TMP($J,"RCXVACK",RCI,0),HLFS,1)="MSA" S ACK=1 D ACK Q
|
|---|
| 25 | . ;
|
|---|
| 26 | . I $P(^TMP($J,"RCXVACK",RCI,0),HLFS,1)="QRD" D QRY
|
|---|
| 27 | ;
|
|---|
| 28 | EXIT K RCI,ACK,QRY,NDAYS,FDATE,RCXSEG,RREFR,RN,RCXVDA,DTMRCD,RCXVBTN,HLFS
|
|---|
| 29 | K RCVXDSC,RTASKS,ZTDESC,ZTRTN,ZTDTH,RREFR,RCXVFFD,RCXVFTD,CURDT,CDOW
|
|---|
| 30 | K HL,HLNEXT,HLNODE,HLQUIT,MSG,RCXVUPD,SEGCNT,SEGMT
|
|---|
| 31 | K ^TMP("RCXVA",$J),^TMP($J,"RCXVACK")
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | ERR ;
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | ACK ; Set Acknowledgement
|
|---|
| 38 | S RCI=$O(^TMP($J,"RCXVACK",RCI)) Q:'RCI
|
|---|
| 39 | I $P(^TMP($J,"RCXVACK",RCI,0),HLFS,1)'="QRD" G ACK
|
|---|
| 40 | S RREFR="^TMP($J,""RCXVACK"",RCI)"
|
|---|
| 41 | D SPAR^RCXVUTIL(RREFR)
|
|---|
| 42 | ;
|
|---|
| 43 | S DTMRCD=$G(RCXSEG(2)),RCXVBTN=$G(RCXSEG(5))
|
|---|
| 44 | ;
|
|---|
| 45 | K ^TMP("RCXVA",$J)
|
|---|
| 46 | D FIND^DIC(348.4,"","","P",RCXVBTN,"","B","","","^TMP(""RCXVA"",$J)")
|
|---|
| 47 | S RN=$P($G(^TMP("RCXVA",$J,"DILIST",0)),U,1)
|
|---|
| 48 | I RN=0 Q
|
|---|
| 49 | S RCXVDA=$P($G(^TMP("RCXVA",$J,"DILIST",RN,0)),U,1)
|
|---|
| 50 | S RCXVUPD(348.4,RCXVDA_",",.08)=$$FMDATE^HLFNC(DTMRCD)
|
|---|
| 51 | S RCXVUPD(348.4,RCXVDA_",",.03)="C"
|
|---|
| 52 | D FILE^DIE("I","RCXVUPD","RCXVERR")
|
|---|
| 53 | Q
|
|---|
| 54 | ;
|
|---|
| 55 | QRY ; Process Query
|
|---|
| 56 | S RREFR="^TMP($J,""RCXVACK"",RCI)"
|
|---|
| 57 | D SPAR^RCXVUTIL(RREFR)
|
|---|
| 58 | ;
|
|---|
| 59 | S RCXVFFD=$P($G(RCXSEG(12)),U,1),RCXVFTD=$P($G(RCXSEG(12)),U,2)
|
|---|
| 60 | S RCXVFFD=$$FMDATE^HLFNC(RCXVFFD)
|
|---|
| 61 | S RCXVFTD=$$FMDATE^HLFNC(RCXVFTD)
|
|---|
| 62 | ;
|
|---|
| 63 | ; Get the next Saturday date
|
|---|
| 64 | S CURDT=$$DT^XLFDT()
|
|---|
| 65 | S CDOW=$$DOW^XLFDT(CURDT,1),NDAYS=6-CDOW
|
|---|
| 66 | S FDATE=$$FMADD^XLFDT(CURDT,NDAYS)
|
|---|
| 67 | ;
|
|---|
| 68 | S RCVXDSC="REQUESTED CBO HISTORICAL EXTRACT"
|
|---|
| 69 | S ZTDESC=RCVXDSC,ZTRTN="HIS^RCXVTSK",ZTIO=""
|
|---|
| 70 | S ZTSAVE("RCXVFTD")="",ZTSAVE("RCXVFFD")=""
|
|---|
| 71 | S ZTDTH=FDATE_".06"
|
|---|
| 72 | D ^%ZTLOAD
|
|---|
| 73 | Q
|
|---|
