RCXVDEQ ;DAOU/ALA-AR Data Extract Queue Trigger ;02-JUL-03
;;4.5;Accounts Receivable;**201,228,240,243,232**;Mar 20, 1995
;*****240 change in this routine for test sites only****
;
;**Program Description**
; This program will log a record who meets the
; selection criteria for the VISTA Data Extract
;
AR ; Triggers from the Accounts Receivable File (#430)
NEW DFN
;
S RCXVBLN=D0,RCXVSTAT=$P(^PRCA(430,D0,0),U,8)
I '+$P(^PRCA(430.3,RCXVSTAT,0),U,6) Q
;
S DFN=$P(^PRCA(430,D0,0),U,7)
D FIL("D")
;
K RCXVBLN,RCXVSTAT
Q
;
AT ; Triggers from the Accounts Receivable Transactions (#433)
NEW DFN
;
S RCXVBLN=$P($G(^PRCA(433,D0,0)),U,2)
I RCXVBLN="" Q
S RCXVTYP=$P($G(^PRCA(433,D0,1)),U,2)
I RCXVTYP="" Q
;
I '+$P(^PRCA(430.3,RCXVTYP,0),U,6) Q
;
S DFN=$P(^PRCA(430,RCXVBLN,0),U,7)
D FIL("D")
;
K RCXVBLN,RCXVTYP
Q
;
FIL(RCXVBTY) ; File the record into the AR Data Queue File (#348.4)
;
; If a test system has 'turned off' extract, quit
I '$$GET1^DIQ(342,"1,",20.04,"I") Q
;
; Input Parameter
; RCXVBTY = Batch Type (H=Historical, D=Daily, C=Current Fiscal Year, A=Active,E=FY05 DATA,I=CoPay Patient Data)
; RCXVBLN = Bill IEN
;
N FDA,RCXVCURB,RCVXBNM,RCVXBMX
;
; Where there has been any update/change to the system
; for a particular bill for the previous days business business (T-1).
;
; Get current batch
BTC K ^TMP("RCXVA",$J)
D FIND^DIC(348.4,"","","P",DT,"","C","I $P(^(0),U,4)=RCXVBTY","","^TMP(""RCXVA"",$J)")
S RCXVCURB=+$P($G(^TMP("RCXVA",$J,"DILIST",0)),U,1)
S RCVXCTY="",RCXVBDT="",RCXQFL=0
;
; If there is no batch for today, create a new batch
I RCXVCURB=0 D NBT G CON:'RCXQFL,BTC
;
; Check to see if batch is full.
S RCXVCURB=$P(^TMP("RCXVA",$J,"DILIST",RCXVCURB,0),U,1)
I RCXVCURB'=0 D
. S RCVXBNM=$P($G(^RCXV(RCXVCURB,0)),U,7) ; Number of record in batch
. S RCVXCTY=$P($G(^RCXV(RCXVCURB,0)),U,4) ; Current batch type
. S RCXVBDT=$P($G(^RCXV(RCXVCURB,0)),U,2) ; Batch Date
. S RCXVBST=$P($G(^RCXV(RCXVCURB,0)),U,3) ; Batch Status
S RCVXBMX=$P($G(^RC(342,1,20)),U,5) ; Max. # of record per batch
; OR if the number of records in batch exceeds the
; maximum number of records per batch --> create new batch
; change in line below for patch 240
I (RCVXBNM>RCVXBMX)!(RCVXBNM=RCVXBMX)!(RCXVBST="T")!(RCXVBST="C") D NBT G BTC:RCXQFL=1
;
CON ; Continue with updating the AR Data Queue file
S RCXVDA=$S($G(RCXVCURB)'=0:RCXVCURB,1:RCXVDA)
;
; If the Batch Type is 'R', quit
I RCXVBTY="R"!(RCXVBTY="I") Q
;
; If this bill number already exists in this batch, quit
I $D(^RCXV(RCXVDA,1,RCXVBLN)) Q
;
; File record
NEW DIC,DIE,X,DA,DLAYGO,Y,DINUM
S DA(1)=RCXVDA,DIC="^RCXV("_DA(1)_",1,",DIE=DIC,(X,DINUM)=RCXVBLN
S DLAYGO=348.41,DIC(0)="L",DIC("P")=DLAYGO
I '$D(^RCXV(DA(1),1,0)) S ^RCXV(DA(1),1,0)="^348.41^^"
K DO D FILE^DICN K DO
;
S RCUPD(348.4,RCXVDA_",",.07)=(RCVXBNM+1)
S RCUPD(348.41,RCXVBLN_","_RCXVDA_",",.02)=$G(DFN)
D FILE^DIE("","RCUPD","RCXVERR")
;
K RCXVDA,RCVXBNM,RCXVBLN,RCXVCURB,RCXVBTY,RCVXBMX,RCVXCTY,RCXVBDT
K ^TMP("RCXVA",$J),IENARRAY,RCXVBST,RCUPD,RCXVERR,RCXQFL
Q
;
NBT ; Create a new batch
N $ES,$ET
S $ET="D ER^RCXVDEQ"
L +^RCXVLK:1 E S RCXQFL=1 Q
S RCXVCURB=$P(^RCXV(0),U,3)+1
S RCVXBNM=0
S FDA(348.4,"+1,",.01)=RCXVCURB
S FDA(348.4,"+1,",.02)=DT
S FDA(348.4,"+1,",.03)="P"
S FDA(348.4,"+1,",.04)=RCXVBTY
S FDA(348.4,"+1,",.07)=RCVXBNM
D UPDATE^DIE("","FDA","IENARRAY","ERROR")
I '$D(ERROR) S RCXVDA=$G(IENARRAY(1))
L -^RCXVLK
Q
;
UDR ; Update Deposits/Receipts subfile
; If this batch payment number already exists in this batch, quit
I $D(^RCXV(RCXVDA,2,RCXVD0)) Q
;
; File record
NEW DIC,DIE,X,DA,DLAYGO,Y,DINUM
S DA(1)=RCXVDA,DIC="^RCXV("_DA(1)_",2,",DIE=DIC,(X,DINUM)=RCXVD0
S DLAYGO=348.42,DIC(0)="L",DIC("P")=DLAYGO
I '$D(^RCXV(DA(1),2,0)) S ^RCXV(DA(1),2,0)="^348.42^^"
K DO D FILE^DICN K DO
;
S RCUPD(348.4,RCXVDA_",",.07)=RCXVRNUM
D FILE^DIE("","RCUPD","RCXVERR")
K RCXVERR,RCUPD
Q
;
ER ; Unlock and log error
L -^RCXVLK
D ^%ZTER
D UNWIND^%ZTER
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXVDEQ 4166 printed Nov 22, 2024@16:59:50 Page 2
RCXVDEQ ;DAOU/ALA-AR Data Extract Queue Trigger ;02-JUL-03
+1 ;;4.5;Accounts Receivable;**201,228,240,243,232**;Mar 20, 1995
+2 ;*****240 change in this routine for test sites only****
+3 ;
+4 ;**Program Description**
+5 ; This program will log a record who meets the
+6 ; selection criteria for the VISTA Data Extract
+7 ;
AR ; Triggers from the Accounts Receivable File (#430)
+1 NEW DFN
+2 ;
+3 SET RCXVBLN=D0
SET RCXVSTAT=$PIECE(^PRCA(430,D0,0),U,8)
+4 IF '+$PIECE(^PRCA(430.3,RCXVSTAT,0),U,6)
QUIT
+5 ;
+6 SET DFN=$PIECE(^PRCA(430,D0,0),U,7)
+7 DO FIL("D")
+8 ;
+9 KILL RCXVBLN,RCXVSTAT
+10 QUIT
+11 ;
AT ; Triggers from the Accounts Receivable Transactions (#433)
+1 NEW DFN
+2 ;
+3 SET RCXVBLN=$PIECE($GET(^PRCA(433,D0,0)),U,2)
+4 IF RCXVBLN=""
QUIT
+5 SET RCXVTYP=$PIECE($GET(^PRCA(433,D0,1)),U,2)
+6 IF RCXVTYP=""
QUIT
+7 ;
+8 IF '+$PIECE(^PRCA(430.3,RCXVTYP,0),U,6)
QUIT
+9 ;
+10 SET DFN=$PIECE(^PRCA(430,RCXVBLN,0),U,7)
+11 DO FIL("D")
+12 ;
+13 KILL RCXVBLN,RCXVTYP
+14 QUIT
+15 ;
FIL(RCXVBTY) ; File the record into the AR Data Queue File (#348.4)
+1 ;
+2 ; If a test system has 'turned off' extract, quit
+3 IF '$$GET1^DIQ(342,"1,",20.04,"I")
QUIT
+4 ;
+5 ; Input Parameter
+6 ; RCXVBTY = Batch Type (H=Historical, D=Daily, C=Current Fiscal Year, A=Active,E=FY05 DATA,I=CoPay Patient Data)
+7 ; RCXVBLN = Bill IEN
+8 ;
+9 NEW FDA,RCXVCURB,RCVXBNM,RCVXBMX
+10 ;
+11 ; Where there has been any update/change to the system
+12 ; for a particular bill for the previous days business business (T-1).
+13 ;
+14 ; Get current batch
BTC KILL ^TMP("RCXVA",$JOB)
+1 DO FIND^DIC(348.4,"","","P",DT,"","C","I $P(^(0),U,4)=RCXVBTY","","^TMP(""RCXVA"",$J)")
+2 SET RCXVCURB=+$PIECE($GET(^TMP("RCXVA",$JOB,"DILIST",0)),U,1)
+3 SET RCVXCTY=""
SET RCXVBDT=""
SET RCXQFL=0
+4 ;
+5 ; If there is no batch for today, create a new batch
+6 IF RCXVCURB=0
DO NBT
if 'RCXQFL
GOTO CON
GOTO BTC
+7 ;
+8 ; Check to see if batch is full.
+9 SET RCXVCURB=$PIECE(^TMP("RCXVA",$JOB,"DILIST",RCXVCURB,0),U,1)
+10 IF RCXVCURB'=0
Begin DoDot:1
+11 ; Number of record in batch
SET RCVXBNM=$PIECE($GET(^RCXV(RCXVCURB,0)),U,7)
+12 ; Current batch type
SET RCVXCTY=$PIECE($GET(^RCXV(RCXVCURB,0)),U,4)
+13 ; Batch Date
SET RCXVBDT=$PIECE($GET(^RCXV(RCXVCURB,0)),U,2)
+14 ; Batch Status
SET RCXVBST=$PIECE($GET(^RCXV(RCXVCURB,0)),U,3)
End DoDot:1
+15 ; Max. # of record per batch
SET RCVXBMX=$PIECE($GET(^RC(342,1,20)),U,5)
+16 ; OR if the number of records in batch exceeds the
+17 ; maximum number of records per batch --> create new batch
+18 ; change in line below for patch 240
+19 IF (RCVXBNM>RCVXBMX)!(RCVXBNM=RCVXBMX)!(RCXVBST="T")!(RCXVBST="C")
DO NBT
if RCXQFL=1
GOTO BTC
+20 ;
CON ; Continue with updating the AR Data Queue file
+1 SET RCXVDA=$SELECT($GET(RCXVCURB)'=0:RCXVCURB,1:RCXVDA)
+2 ;
+3 ; If the Batch Type is 'R', quit
+4 IF RCXVBTY="R"!(RCXVBTY="I")
QUIT
+5 ;
+6 ; If this bill number already exists in this batch, quit
+7 IF $DATA(^RCXV(RCXVDA,1,RCXVBLN))
QUIT
+8 ;
+9 ; File record
+10 NEW DIC,DIE,X,DA,DLAYGO,Y,DINUM
+11 SET DA(1)=RCXVDA
SET DIC="^RCXV("_DA(1)_",1,"
SET DIE=DIC
SET (X,DINUM)=RCXVBLN
+12 SET DLAYGO=348.41
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+13 IF '$DATA(^RCXV(DA(1),1,0))
SET ^RCXV(DA(1),1,0)="^348.41^^"
+14 KILL DO
DO FILE^DICN
KILL DO
+15 ;
+16 SET RCUPD(348.4,RCXVDA_",",.07)=(RCVXBNM+1)
+17 SET RCUPD(348.41,RCXVBLN_","_RCXVDA_",",.02)=$GET(DFN)
+18 DO FILE^DIE("","RCUPD","RCXVERR")
+19 ;
+20 KILL RCXVDA,RCVXBNM,RCXVBLN,RCXVCURB,RCXVBTY,RCVXBMX,RCVXCTY,RCXVBDT
+21 KILL ^TMP("RCXVA",$JOB),IENARRAY,RCXVBST,RCUPD,RCXVERR,RCXQFL
+22 QUIT
+23 ;
NBT ; Create a new batch
+1 NEW $ESTACK,$ETRAP
+2 SET $ETRAP="D ER^RCXVDEQ"
+3 LOCK +^RCXVLK:1
IF '$TEST
SET RCXQFL=1
QUIT
+4 SET RCXVCURB=$PIECE(^RCXV(0),U,3)+1
+5 SET RCVXBNM=0
+6 SET FDA(348.4,"+1,",.01)=RCXVCURB
+7 SET FDA(348.4,"+1,",.02)=DT
+8 SET FDA(348.4,"+1,",.03)="P"
+9 SET FDA(348.4,"+1,",.04)=RCXVBTY
+10 SET FDA(348.4,"+1,",.07)=RCVXBNM
+11 DO UPDATE^DIE("","FDA","IENARRAY","ERROR")
+12 IF '$DATA(ERROR)
SET RCXVDA=$GET(IENARRAY(1))
+13 LOCK -^RCXVLK
+14 QUIT
+15 ;
UDR ; Update Deposits/Receipts subfile
+1 ; If this batch payment number already exists in this batch, quit
+2 IF $DATA(^RCXV(RCXVDA,2,RCXVD0))
QUIT
+3 ;
+4 ; File record
+5 NEW DIC,DIE,X,DA,DLAYGO,Y,DINUM
+6 SET DA(1)=RCXVDA
SET DIC="^RCXV("_DA(1)_",2,"
SET DIE=DIC
SET (X,DINUM)=RCXVD0
+7 SET DLAYGO=348.42
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+8 IF '$DATA(^RCXV(DA(1),2,0))
SET ^RCXV(DA(1),2,0)="^348.42^^"
+9 KILL DO
DO FILE^DICN
KILL DO
+10 ;
+11 SET RCUPD(348.4,RCXVDA_",",.07)=RCXVRNUM
+12 DO FILE^DIE("","RCUPD","RCXVERR")
+13 KILL RCXVERR,RCUPD
+14 QUIT
+15 ;
ER ; Unlock and log error
+1 LOCK -^RCXVLK
+2 DO ^%ZTER
+3 DO UNWIND^%ZTER
+4 QUIT
