Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCXVDEQ

RCXVDEQ.m

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