IBJVDEQ ;DAOU/ALA - CBO Data Extract Queue Trigger ;02-JUL-03
;;2.0;INTEGRATED BILLING;**233,301**;21-MAR-94
;
;**Program Description**
; This program will log a record who meets the
; selection criteria for the VISTA Data Extract
;
BC ; Triggers from the Bill/Claims File (#399)
; Called from the STATUS DATE field (#.14)
; Variable D0 is the internal bill# passed in by FileMan
;
NEW DFN
;
; Filter (Auth DT must exist)
S RDATES=$G(^DGCR(399,D0,"S"))
I $P(RDATES,U,10)="" Q
;
; Get the bill number
S RCBILL=$P($G(^DGCR(399,D0,0)),U,1)
; Use PRCA(430,"D",bill number to get 430 IEN
S RCXVBLN=$O(^PRCA(430,"D",RCBILL,""))
I RCXVBLN="" Q
;
S DFN=$P(^DGCR(399,D0,0),U,2)
; Retrieve all for every new bill authorized in IB
D FIL("D")
;
K RCBILL,RCXVBLN,RDATES
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)
; RCXVBLN = Bill IEN
;
NEW FDA,RCXVCURB,RCVXBNM,RCVXBMX
;
; Where there has been any update/change to the system
; for a particular bill for the previous days 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(^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
I (RCVXBNM>RCVXBMX)!(RCVXBNM=RCVXBMX)!(RCXVBST="T") D NBT G BTC:RCXQFL
;
CON ; Continue with updating the AR Data Queue file
S RCXVDA=$S($G(RCXVCURB)'=0:RCXVCURB,1:RCXVDA)
;
I $D(^RCXV(RCXVDA,1,RCXVBLN)) Q
;
; File record
NEW DIC,DIE,X,DA,DLAYGO,Y,DINUM,DO
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^^"
D FILE^DICN
;
S RCUPD(348.4,RCXVDA_",",.07)=(RCVXBNM+1)
S RCUPD(348.41,RCXVBLN_","_RCXVDA_",",.02)=DFN
D FILE^DIE("","RCUPD","RCERROR")
;
K RCXVDA,RCVXBNM,RCXVBLN,RCXVCURB,RCXVBTY,RCVXBMX,RCVXCTY,RCXVBDT
K ^TMP("RCXVA",$J),IENARRAY,RCXVBST,DINUM,ERROR,RCUPD,RCXQFL
Q
;
NBT ; Create a new batch
N $ES,$ET
S $ET="D ER^IBJVDEQ"
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
;
ER ; Unlock and log error
L -^RCXVLK
D ^%ZTER
D UNWIND^%ZTER
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJVDEQ 3375 printed Dec 13, 2024@02:24:20 Page 2
IBJVDEQ ;DAOU/ALA - CBO Data Extract Queue Trigger ;02-JUL-03
+1 ;;2.0;INTEGRATED BILLING;**233,301**;21-MAR-94
+2 ;
+3 ;**Program Description**
+4 ; This program will log a record who meets the
+5 ; selection criteria for the VISTA Data Extract
+6 ;
BC ; Triggers from the Bill/Claims File (#399)
+1 ; Called from the STATUS DATE field (#.14)
+2 ; Variable D0 is the internal bill# passed in by FileMan
+3 ;
+4 NEW DFN
+5 ;
+6 ; Filter (Auth DT must exist)
+7 SET RDATES=$GET(^DGCR(399,D0,"S"))
+8 IF $PIECE(RDATES,U,10)=""
QUIT
+9 ;
+10 ; Get the bill number
+11 SET RCBILL=$PIECE($GET(^DGCR(399,D0,0)),U,1)
+12 ; Use PRCA(430,"D",bill number to get 430 IEN
+13 SET RCXVBLN=$ORDER(^PRCA(430,"D",RCBILL,""))
+14 IF RCXVBLN=""
QUIT
+15 ;
+16 SET DFN=$PIECE(^DGCR(399,D0,0),U,2)
+17 ; Retrieve all for every new bill authorized in IB
+18 DO FIL("D")
+19 ;
+20 KILL RCBILL,RCXVBLN,RDATES
+21 QUIT
+22 ;
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)
+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 (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(^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 IF (RCVXBNM>RCVXBMX)!(RCVXBNM=RCVXBMX)!(RCXVBST="T")
DO NBT
if RCXQFL
GOTO BTC
+19 ;
CON ; Continue with updating the AR Data Queue file
+1 SET RCXVDA=$SELECT($GET(RCXVCURB)'=0:RCXVCURB,1:RCXVDA)
+2 ;
+3 IF $DATA(^RCXV(RCXVDA,1,RCXVBLN))
QUIT
+4 ;
+5 ; File record
+6 NEW DIC,DIE,X,DA,DLAYGO,Y,DINUM,DO
+7 SET DA(1)=RCXVDA
SET DIC="^RCXV("_DA(1)_",1,"
SET DIE=DIC
SET (X,DINUM)=RCXVBLN
+8 SET DLAYGO=348.41
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+9 IF '$DATA(^RCXV(DA(1),1,0))
SET ^RCXV(DA(1),1,0)="^348.41^^"
+10 DO FILE^DICN
+11 ;
+12 SET RCUPD(348.4,RCXVDA_",",.07)=(RCVXBNM+1)
+13 SET RCUPD(348.41,RCXVBLN_","_RCXVDA_",",.02)=DFN
+14 DO FILE^DIE("","RCUPD","RCERROR")
+15 ;
+16 KILL RCXVDA,RCVXBNM,RCXVBLN,RCXVCURB,RCXVBTY,RCVXBMX,RCVXCTY,RCXVBDT
+17 KILL ^TMP("RCXVA",$JOB),IENARRAY,RCXVBST,DINUM,ERROR,RCUPD,RCXQFL
+18 QUIT
+19 ;
NBT ; Create a new batch
+1 NEW $ESTACK,$ETRAP
+2 SET $ETRAP="D ER^IBJVDEQ"
+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 ;
ER ; Unlock and log error
+1 LOCK -^RCXVLK
+2 DO ^%ZTER
+3 DO UNWIND^%ZTER
+4 QUIT
