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

RCRCUTL.m

Go to the documentation of this file.
  1. RCRCUTL ;ALB/CMS - RC REFERRAL UTILITY PROGRAM ; 16-JUN-00
  1. V ;;4.5;Accounts Receivable;**63,159,327**;Mar 20, 1995;Build 7
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;PRCA*4.5*327 Remove defunct mail address: OGCNASRI@MAIL.DOMAIN.EXT^OGCRegion8DeathNotification@mail.domain.ext
  1. ;
  1. Q
  1. ;
  1. BN ;User Select an AR Bill No.
  1. ;Returns PRCABN if exists
  1. N DIC,DA,X,Y,%Y
  1. BNA S DIC="^PRCA(430,",DIC(0)="AEQMZ"
  1. S DIC("S")="I $P(^(0),U,8)=16,$P($G(^PRCA(430.2,+$P(^(0),U,2),0)),U,6)=""T"""
  1. D ^DIC S PRCABN=+Y
  1. I $G(PRCABN)<0 K PRCABN
  1. BNQ Q
  1. ;
  1. BNVAR(PRCABN) ;Set PRCA( array with bill information
  1. ;Returns PRCA(
  1. N PRCABN0
  1. I '$G(PRCABN) G BNVARQ
  1. S PRCABN0=$G(^PRCA(430,PRCABN,0))
  1. S PRCA("BNAME")=$P(PRCABN0,U,1)
  1. S PRCA("CAT")=$P(PRCABN0,U,2)_"^"_$P($G(^PRCA(430.2,+$P(PRCABN0,U,2),0)),U,1,2)
  1. S PRCA("STATUS")=$P(PRCABN0,U,8)_"^"_$P($G(^PRCA(430.3,+$P(PRCABN0,U,8),0)),U,1,2)
  1. BNVARQ Q
  1. ;
  1. DEBT(PRCABN) ;Get Debtor Name and Address
  1. ;Send Bill Number
  1. ;Return PRCA( array nodes: DEBTNM, DEBTOR, DEBTCT, DEBTZIP, DEBTST,
  1. ; DEBTAD1, DEBTAD2, DEBTADD
  1. N PRCACT,PRCAKP,PRCAST,PRCAST1,PRCAST2,X,Y,%Y
  1. K PRCA("DEBTNM"),PRCA("DEBTOR"),PRCA("DEBTCT"),PRCA("DEBTZIP")
  1. K PRCA("DEBTST"),PRCA("DEBTAD1"),PRCA("DEBTAD2"),PRCA("DEBTADD")
  1. I '$G(PRCABN) G DEBTQ
  1. D DEBTOR^PRCAUTL
  1. I $G(PRCA("DEBTNM"))="" G DEBTQ
  1. S PRCA("DEBTCT")=$G(PRCACT,"UNK")
  1. S PRCA("DEBTZIP")=$G(PRCAKP,"UNK")
  1. S PRCA("DEBTST")=$G(PRCAST,"UNK")
  1. S PRCA("DEBTAD1")=$G(PRCAST1)
  1. S PRCA("DEBTAD2")=$G(PRCAST2)
  1. S PRCA("DEBTADD")=$G(X)
  1. DEBTQ Q
  1. ;
  1. PT(DFN) ;Get Patient information
  1. ;Return values in arrays: VA(, VADM(, VAPD(
  1. K VA,VADM,VAPD
  1. I '$D(^DPT(+$G(DFN),0)) G PTQ
  1. D DEM^VADPT,ADD^VADPT
  1. PTQ Q
  1. ;
  1. RCDOM() ;Get supporting RC Domain
  1. ;Returns Domain Name
  1. N X
  1. ;S X=$O(RCDIV(0))
  1. ;I +X S X=$P($G(RCDIV(+X)),U,6)
  1. ;I X]"" G RCDOMQ
  1. S X=$O(^RCT(349.1,"B","RC",0))
  1. S X=$P($G(^RCT(349.1,+X,3)),U,4)
  1. RCDOMQ Q X
  1. ;
  1. RCCAT(ARRAY) ;Get array of valid AR/RC Bill Categories
  1. ;Send back ARRAY(IEN)=x^AR Category Name
  1. ; x = 1 = Reconciliation, Referral and Follow-up
  1. ; x = 2 = Reconciliation Only
  1. S ARRAY(6)="2^"_$P(^PRCA(430.2,6,0),U,1)
  1. S ARRAY(7)="2^"_$P(^PRCA(430.2,7,0),U,1)
  1. S ARRAY(9)="1^"_$P(^PRCA(430.2,9,0),U,1)
  1. S ARRAY(10)="2^"_$P(^PRCA(430.2,10,0),U,1)
  1. RCCATQ Q
  1. ;
  1. REFST(PRCABN) ;Referral Status
  1. ;Return: If Referred date^code^amount
  1. ; If not Referred 0
  1. N X S X=0
  1. I $P($G(^PRCA(430,PRCABN,0)),U,8)'=16 G REFSTQ
  1. S X=$P($G(^PRCA(430,PRCABN,6)),U,4,6)
  1. I 'X S X=0
  1. REFSTQ Q X
  1. ;
  1. RETN(PRCABN) ;Returned from RC/DOJ
  1. ;Return: If Return Date send Date
  1. ; If not send 0
  1. N X S X=+$P($G(^PRCA(430,PRCABN,6)),U,11)
  1. Q X
  1. ;
  1. ACTDT(PRCABN) ;Date account activated
  1. ;Return: Date account activated
  1. N X S X=0
  1. I '$G(PRCABN) G ACTDTQ
  1. S X=+$P($G(^PRCA(430,PRCABN,6)),"^",21) I X G ACTDTQ
  1. S X=+$P($G(^PRCA(430,PRCABN,9)),"^",3) I X G ACTDTQ
  1. S X=+$P($G(^PRCA(430,PRCABN,0)),"^",10)
  1. ACTDTQ Q X
  1. ;
  1. AEOB ;File 433 Cross-Ref on Transaction Type
  1. ; -used to alert pending EOB processing when Payment in Part
  1. ; transaction is created
  1. N PRCABN,RCAT
  1. I (X'=2)!(+$G(DA)<1) G AEOBQ
  1. S PRCABN=+$P($G(^PRCA(433,DA,0)),U,2) I 'PRCABN G AEOBQ
  1. I +$P($G(^PRCA(430,PRCABN,0)),U,2)'=9 G AEOBQ
  1. I $$REFST(PRCABN)=0 G AEOBQ
  1. S ^PRCA(433,"AEOB",PRCABN,DA)=""
  1. AEOBQ Q
  1. ;
  1. ECHK ;Check to see if pending EOB Code Processing exists
  1. I $O(^PRCA(433,"AEOB",0)) W !!,*7,"*** You have Referred TP Bills pending EOB Code processing ***"
  1. ECHKQ Q
  1. ;
  1. ADDR ;Regional Counsel Addresses and Death Notification addresses.
  1. ;;OGCBOSRI@MAIL.DOMAIN.EXT^OGCRegion1DeathNotification@mail.domain.ext
  1. ;;OGCNYNRI@MAIL.DOMAIN.EXT^OGCRegion2DeathNotification@mail.domain.ext
  1. ;;OGCBALRI@MAIL.DOMAIN.EXT^OGCRegion3DeathNotification@mail.domain.ext
  1. ;;OGCPHIRI@MAIL.DOMAIN.EXT^OGCRegion4DeathNotification@mail.domain.ext
  1. ;;OGCATLRI@MAIL.DOMAIN.EXT^OGCRegion5DeathNotification@mail.domain.ext
  1. ;;OGCBAYRI@MAIL.DOMAIN.EXT^OGCRegion6DeathNotification@mail.domain.ext
  1. ;;OGCCLERI@MAIL.DOMAIN.EXT^OGCRegion7DeathNotification@mail.domain.ext
  1. ;;OGCJACRI@MAIL.DOMAIN.EXT^OGCRegion9DeathNotification@mail.domain.ext
  1. ;;OGCCHIRI@MAIL.DOMAIN.EXT^OGCRegion10DeathNotification@mail.domain.ext
  1. ;;OGCDETRI@MAIL.DOMAIN.EXT^OGCRegion11DeathNotification@mail.domain.ext
  1. ;;OGCSTLRI@MAIL.DOMAIN.EXT^OGCRegion12DeathNotification@mail.domain.ext
  1. ;;OGCWACRI@MAIL.DOMAIN.EXT^OGCRegion13DeathNotification@mail.domain.ext
  1. ;;OGCHOURI@MAIL.DOMAIN.EXT^OGCRegion14DeathNotification@mail.domain.ext
  1. ;;OGCMINRI@MAIL.DOMAIN.EXT^OGCRegion15DeathNotification@mail.domain.ext
  1. ;;OGCDENRI@MAIL.DOMAIN.EXT^OGCRegion16DeathNotification@mail.domain.ext
  1. ;;OGCLOSRI@MAIL.DOMAIN.EXT^OGCRegion17DeathNotification@mail.domain.ext
  1. ;;OGCSFCRI@MAIL.DOMAIN.EXT^OGCRegion18DeathNotification@mail.domain.ext
  1. ;;OGCPHORI@MAIL.DOMAIN.EXT^OGCRegion19DeathNotification@mail.domain.ext
  1. ;;OGCPORRI@MAIL.DOMAIN.EXT^OGCRegion20DeathNotification@mail.domain.ext
  1. ;;OGCBUFRI@MAIL.DOMAIN.EXT^OGCRegion21DeathNotification@mail.domain.ext
  1. ;;OGCINDRI@MAIL.DOMAIN.EXT^OGCRegion22DeathNotification@mail.domain.ext
  1. ;;OGCWINRI@MAIL.DOMAIN.EXT^OGCRegion23DeathNotification@mail.domain.ext
  1. ;;END
  1. ;RCRCUTL