74 lines
2.2 KiB
Mathematica
74 lines
2.2 KiB
Mathematica
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
|