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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXVACK 2302 printed Nov 22, 2024@16:59:39 Page 2
RCXVACK ;DAOU/ALA-AR Data Extraction HL7 Query/ACK ;28-JUL-03
+1 ;;4.5;Accounts Receivable;**201**;Mar 20, 1995
+2 ;
+3 ;** Program Description **
+4 ; This program will handle an acknowledgment message
+5 ; from either Vitria or Boston Allocation Resource
+6 ; Center
+7 ;
EN ; Entry point
+1 ;
+2 ; Load the HL7 message into temporary global
+3 KILL ^TMP($JOB,"RCXVACK")
+4 FOR SEGCNT=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
Begin DoDot:1
+5 SET CNT=0
+6 SET ^TMP($JOB,"RCXVACK",SEGCNT,CNT)=HLNODE
+7 FOR
SET CNT=$ORDER(HLNODE(CNT))
if 'CNT
QUIT
Begin DoDot:2
+8 SET ^TMP($JOB,"RCXVACK",SEGCNT,CNT)=HLNODE(CNT)
End DoDot:2
End DoDot:1
+9 ;
+10 SET SEGMT=$GET(^TMP($JOB,"RCXVACK",1,0))
+11 IF $EXTRACT(SEGMT,1,3)'="MSH"
SET MSG(1)="MSH Segment is not the first segment found"
DO ERR
GOTO EXIT
+12 SET HLFS=$EXTRACT(SEGMT,4)
+13 SET RCI=0
SET QRY=0
SET ACK=0
+14 FOR
SET RCI=$ORDER(^TMP($JOB,"RCXVACK",RCI))
if 'RCI
QUIT
Begin DoDot:1
+15 IF $PIECE(^TMP($JOB,"RCXVACK",RCI,0),HLFS,1)="MSA"
SET ACK=1
DO ACK
QUIT
+16 ;
+17 IF $PIECE(^TMP($JOB,"RCXVACK",RCI,0),HLFS,1)="QRD"
DO QRY
End DoDot:1
if ACK
QUIT
+18 ;
EXIT KILL RCI,ACK,QRY,NDAYS,FDATE,RCXSEG,RREFR,RN,RCXVDA,DTMRCD,RCXVBTN,HLFS
+1 KILL RCVXDSC,RTASKS,ZTDESC,ZTRTN,ZTDTH,RREFR,RCXVFFD,RCXVFTD,CURDT,CDOW
+2 KILL HL,HLNEXT,HLNODE,HLQUIT,MSG,RCXVUPD,SEGCNT,SEGMT
+3 KILL ^TMP("RCXVA",$JOB),^TMP($JOB,"RCXVACK")
+4 QUIT
+5 ;
ERR ;
+1 QUIT
+2 ;
ACK ; Set Acknowledgement
+1 SET RCI=$ORDER(^TMP($JOB,"RCXVACK",RCI))
if 'RCI
QUIT
+2 IF $PIECE(^TMP($JOB,"RCXVACK",RCI,0),HLFS,1)'="QRD"
GOTO ACK
+3 SET RREFR="^TMP($J,""RCXVACK"",RCI)"
+4 DO SPAR^RCXVUTIL(RREFR)
+5 ;
+6 SET DTMRCD=$GET(RCXSEG(2))
SET RCXVBTN=$GET(RCXSEG(5))
+7 ;
+8 KILL ^TMP("RCXVA",$JOB)
+9 DO FIND^DIC(348.4,"","","P",RCXVBTN,"","B","","","^TMP(""RCXVA"",$J)")
+10 SET RN=$PIECE($GET(^TMP("RCXVA",$JOB,"DILIST",0)),U,1)
+11 IF RN=0
QUIT
+12 SET RCXVDA=$PIECE($GET(^TMP("RCXVA",$JOB,"DILIST",RN,0)),U,1)
+13 SET RCXVUPD(348.4,RCXVDA_",",.08)=$$FMDATE^HLFNC(DTMRCD)
+14 SET RCXVUPD(348.4,RCXVDA_",",.03)="C"
+15 DO FILE^DIE("I","RCXVUPD","RCXVERR")
+16 QUIT
+17 ;
QRY ; Process Query
+1 SET RREFR="^TMP($J,""RCXVACK"",RCI)"
+2 DO SPAR^RCXVUTIL(RREFR)
+3 ;
+4 SET RCXVFFD=$PIECE($GET(RCXSEG(12)),U,1)
SET RCXVFTD=$PIECE($GET(RCXSEG(12)),U,2)
+5 SET RCXVFFD=$$FMDATE^HLFNC(RCXVFFD)
+6 SET RCXVFTD=$$FMDATE^HLFNC(RCXVFTD)
+7 ;
+8 ; Get the next Saturday date
+9 SET CURDT=$$DT^XLFDT()
+10 SET CDOW=$$DOW^XLFDT(CURDT,1)
SET NDAYS=6-CDOW
+11 SET FDATE=$$FMADD^XLFDT(CURDT,NDAYS)
+12 ;
+13 SET RCVXDSC="REQUESTED CBO HISTORICAL EXTRACT"
+14 SET ZTDESC=RCVXDSC
SET ZTRTN="HIS^RCXVTSK"
SET ZTIO=""
+15 SET ZTSAVE("RCXVFTD")=""
SET ZTSAVE("RCXVFFD")=""
+16 SET ZTDTH=FDATE_".06"
+17 DO ^%ZTLOAD
+18 QUIT
