Changeset 636 for FOIAVistA/tag/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCACM.m (modified) (2 diffs)
• ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAGST.m (modified) (2 diffs)
• ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAGST1.m (modified) (2 diffs)
• ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCASVC.m (modified) (2 diffs)
• ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEM.m (modified) (2 diffs)
• ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPESR3.m (modified) (2 diffs)
• ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEX32.m (modified) (2 diffs)
• ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCFMOBR.m (modified) (2 diffs)
• ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRCXM1.m (modified) (2 diffs)
• ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCXVDC.m (modified) (2 diffs)
• ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCXVDC4.m (modified) (4 diffs)
• ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCXVFTP.m (modified) (2 diffs)

FOIAVistA/tag/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCACM.m

@@ -1 +1 @@
 PRCACM ;WASH-ISC@ALTOONA,PA/RGY-COMMENT ADJUSTMENT TRANSACTION ;6/2/95  2:41 PM
- ;;4.5;Accounts Receivable;**8,67,125,169,254**;Mar 20, 1995;Build 2
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ; DBIA 3820-A used for direct global read into file 399.
- ;
+V ;;4.5;Accounts Receivable;**8,67,125,169**;Mar 20, 1995
+ ;;Per VHA Directive 10-93-142, this routine should not be modified.
  ;This is a routine for adjustment transaction.
  NEW PRCABN,PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,DIROUT,DIRUT,DIR,DUOUT,PRCA,PRCATY
@@ -57 +55 @@
  S %DT="AERX",%DT(0)=% D ^%DT
  Q Y
-BEGIN K PRCATERM,PRCABN,PRCAEN,PRCA("CKSITE"),PRCAIBS D BILL^PRCAUTL Q:('$D(PRCABN))
- S PRCAIBS=$P($G(^DGCR(399,PRCABN,0)),U,13)        ; IB claim status - DBIA3820-A
- I PRCAIBS=1 W !!,"**  You cannot add AR Comments to an Entered/Not Reviewed claim.  **",!,*7 G BEGIN
- I PRCAIBS=2 W !!,"**  You cannot add AR Comments to an MRA Request claim.  **",!,*7 G BEGIN
- I '$D(^PRCA(430,PRCABN,2,0)),PRCAIBS=7 W !!,"**  You cannot add AR Comments to a claim Cancelled/not passed to AR.  **",!,*7 G BEGIN
+BEGIN K PRCATERM,PRCABN,PRCAEN,PRCA("CKSITE") D BILL^PRCAUTL Q:('$D(PRCABN))
+ I '$D(^PRCA(430,PRCABN,2,0)) W !!,"**  This bill was cancelled in IB before it was passed to AR.  **",!,*7 G BEGIN
  I $P($G(^PRCA(430,PRCABN,0)),"^",8)=49 W !!,"**  Comments CANNOT be entered on an ARCHIVED bill.  **",!,*7 G BEGIN
  D SETTR^PRCAUTL,PATTR^PRCAUTL S DIC="^PRCA(433," K PRCAMT,PRCAD("DELETE") Q

FOIAVistA/tag/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAGST.m

@@ -1 +1 @@
 PRCAGST ;WASH-ISC@ALTOONA,PA/CMS-Print Patient Statement ;12/12/96  9:39 AM
-V ;;4.5;Accounts Receivable;**34,181,190,249**;Mar 20, 1995;Build 2
+V ;;4.5;Accounts Receivable;**34,181,190**;Mar 20, 1995
  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  ;ENTRY WITH DEBTOR PRINT STATEMENT
@@ -12 +12 @@
  S X=X+1,ADD(X)=$P(ADD,U,7)
  W @IOF
- W !!,"Department of Veterans Affairs",?50,"Acct No.: ",$P($$SITE^VASITE(),U,3)_"/"_$E(SSN,6,9)
+ W !!,"Department of Veterans Affairs",?50,"Acct No.: ",SSN
  W !,$G(ADD(1))
  S Y=$$FPS^RCAMFN01($S($G(LDT)>0:$E(LDT,1,5),1:$E(DT,1,5))_$TR($J($$PST^RCAMFN01(DEB),2)," ",0),$S(+$E($G(LDT),6,7)>$$STD^RCCPCFN:2,1:1)) D DD^%DT

FOIAVistA/tag/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAGST1.m

@@ -1 +1 @@
 PRCAGST1 ;WASH-ISC@ALTOONA,PA/CMS-Print Patient Statement Bottom ;10/16/96  11:13 AM
-V ;;4.5;Accounts Receivable;**2,48,104,176,249**;Mar 20, 1995;Build 2
+V ;;4.5;Accounts Receivable;**2,48,104,176**;Mar 20, 1995
  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  ;ENTRY FROM PRCAGST PAGE 1
@@ -59 +59 @@
  S PAGE=$G(PAGE)+1
  I PAGE>1 W @IOF I $G(^RC(342,1,5))]"" F I=1:1:18 W !
- W !,"Department of Veterans Affairs",?50,"Acct No.:",$P($$SITE^VASITE(),U,3)_"/"_$E(SSN,6,9)
+ W !,"Department of Veterans Affairs",?50,"Acct No.: ",SSN
  W !,NAM,?50,"Page ",PAGE
  S Y="",$P(Y,"_",80)="" W !,Y

FOIAVistA/tag/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCASVC.m

@@ -1 +1 @@
 PRCASVC ;SF-ISC/YJK-ACCEPT, AMMEND AND CANCEL AR BILL ;9/6/95  2:09 PM
-V ;;4.5;Accounts Receivable;**1,21,48,90,136,138,249**;Mar 20, 1995;Build 2
+V ;;4.5;Accounts Receivable;**1,21,48,90,136,138**;Mar 20, 1995
  ;;Per VHA Directive 10-93-142, this routine should not be modified.
 REL ;Accept bill into AR
@@ -9 +9 @@
 Q3 K PRCAT,PRCAORA,PRCADEBT,DIE,DR,%
  ;  set the fund for the bill (set in routine rcxfmsuf)
- S:'$G(DA) DA=PRCASV("ARREC") S %=$$GETFUNDB^RCXFMSUF(DA)
+ S %=$$GETFUNDB^RCXFMSUF(DA)
  I "^27^28^"[("^"_PRCASV("CAT")_"^") D
  .N P

FOIAVistA/tag/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEM.m

@@ -1 +1 @@
 RCDPEM ;ALB/TMK - POST EFT, ERA MATCHING TO EFT ;05-NOV-02
- ;;4.5;Accounts Receivable;**173,255**;Mar 20, 1995;Build 1
+ ;;4.5;Accounts Receivable;**173**;Mar 20, 1995
  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  ; IA 4050 covers call to SPL1^IBCEOBAR
@@ -25 +25 @@
  ; 'Unposted' EFTs have a 0 in AMOUNT POSTED field
  S ^TMP($J,"RCTOT","EFT_DEP")=0
- S RCZ=0 F  S RCZ=$O(^RCY(344.3,"APOST",0,RCZ)) Q:'RCZ  S RC0=$G(^RCY(344.3,RCZ,0))  I RC0'="",$P(RC0,U,8),($E($P(RC0,U,6),1,3)="469")!($E($P(RC0,U,6),1,3)="569") D
+ S RCZ=0 F  S RCZ=$O(^RCY(344.3,"APOST",0,RCZ)) Q:'RCZ  S RC0=$G(^RCY(344.3,RCZ,0))  I RC0'="",$E($P(RC0,U,6),1,3)="469",$P(RC0,U,8) D
  . S ^TMP($J,"RCTOT","EFT_DEP")=^TMP($J,"RCTOT","EFT_DEP")+1
  . ; Verify check sums

FOIAVistA/tag/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPESR3.m

@@ -1 +1 @@
 RCDPESR3 ;ALB/TMK - Server auto-update utilities - EDI Lockbox ;06/06/02
- ;;4.5;Accounts Receivable;**173,214,208,255**;Mar 20, 1995;Build 1
+ ;;4.5;Accounts Receivable;**173,214,208**;Mar 20, 1995
  Q
  ;
@@ -72 +72 @@
  S (RCERR,RCTDA)=""
  ;
- I $E($P(RCTXN,U,6),1,3)'="469",$E($P(RCTXN,U,6),1,3)'="569",$E($P(RCTXN,U,6),1,3)'="HAC" D  G ADDQ ; Invalid EFT deposit number
+ I $E($P(RCTXN,U,6),1,3)'="469",$E($P(RCTXN,U,6),1,3)'="HAC" D  G ADDQ ; Invalid EFT deposit number
  . N RCDXM,RCCT
  . S RCCT=0

FOIAVistA/tag/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPEX32.m

@@ -1 +1 @@
 RCDPEX32 ;ALB/TMK - ELECTRONIC EOB EXCEPTION PROCESSING - FILE 344.4 ;10-OCT-02
- ;;4.5;Accounts Receivable;**173,249**;Mar 20, 1995;Build 2
+ ;;4.5;Accounts Receivable;**173**;Mar 20, 1995
  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  ;
@@ -48 +48 @@
  .. S ^TMP($J,"RCDP-EOB",1,Q,0)=Q0
  . S ^TMP($J,"RCDP-EOB",1,.5,0)="835ERA"
- . S RCEOB=$$DUP^IBCEOB("^TMP("_$J_",""RCDP-EOB"",1)",RCBILL) ; IA 4042
+ . S RCEOB=$$DUP^IBCEOB(RCBILL,"^TMP("_$J_",""RCDP-EOB"",1)") ; IA 4042
  . K ^TMP($J,"RCDP-EOB",1,.5,0)
  . I RCEOB D  Q

FOIAVistA/tag/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCFMOBR.m

@@ -1 +1 @@
 RCFMOBR ;WASH-ISC@ALTOONA,PA/RWT-BILL RECONCILIATIONS LIST ;11/20/96  2:30 PM
-V ;;4.5;Accounts Receivable;**2,20,40,53,249**;Mar 20, 1995;Build 2
+V ;;4.5;Accounts Receivable;**2,20,40,53**;Mar 20, 1995
  ;;Per VHA Directive 10-93-142, this routine should not be modified.
 EN ;Creates report from OBR data in file 423.6
@@ -75 +75 @@
 EN3 ;Deletes OBRs over 60 days old
  N A0,A1,A2,DA,DIK,X,X1,X2
- S A0="OBR-" F  S A0=$O(^PRCF(423.6,"B",A0)) Q:A0=""!(A0'["OBR-")  S A1=$E($P(A0,"-",2),1,8),A2=0 F  S A2=$O(^PRCF(423.6,"B",A0,A2)) Q:+A2=0  D
- .S X1=DT,X2=$$RCDT(A1) D ^%DTC I X>60 S DIK="^PRCF(423.6,",DA=A2 D ^DIK
+ S A0="OBR-" F  S A0=$O(^PRCF(423.6,"B",A0)) Q:A0=""!(A0'["OBR-")  S A1=2_$E($P(A0,"-",2),3,8),A2=0 F  S A2=$O(^PRCF(423.6,"B",A0,A2)) Q:+A2=0  D
+ .S X1=DT,X2=A1 D ^%DTC I X>60 S DIK="^PRCF(423.6,",DA=A2 D ^DIK
  Q
-RCDT(A1) ;Convert yyyymmdd to FM date
- N X,Y
- S X=A1,X=$E(X,5,6)_" "_$E(X,7,8)_", "_$E(X,1,4)
- D ^%DT
- Q Y
 PURGE ;purge unprocessed document file
  N DIR,Y,X,X1,X2,RCDT

FOIAVistA/tag/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRCXM1.m

@@ -1 +1 @@
 RCRCXM1 ;ALB/CMS - AR/RC ORIGINAL TRANSMISSION SET ;09/08/97
-V ;;4.5;Accounts Receivable;**63,122,189,249**;Mar 20, 1995;Build 2
+V ;;4.5;Accounts Receivable;**63,122,189**;Mar 20, 1995
  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  ;
@@ -40 +40 @@
  S ^TMP("RCRCVL",$J,"XM",PRCABN,2,1)="BINS^"_$P($G(RCIB("PIN")),U,5)_U_$P($G(RCIB("PIN")),U,6)_U_$P($G(RCIB("PIN")),U,7)_U_$S($G(RCIB("CRE"))]"":RCIB("CRE"),$G(RCIB("CRA"))]"":RCIB("CRA"),$G(RCIB("CRO"))]"":RCIB("CRO"),1:"")
  S ^TMP("RCRCVL",$J,"XM",PRCABN,3,1)="PAT^"_$E($G(VADM(1),RCUNK),1,30)_U_$P($G(VADM(2)),U,1)_U_$P($G(VADM(3)),U,1)_U_$P($G(VADM(5)),U)_U_$G(RCIB("SR"))_U_$G(VAPA(1))_U_$G(VAPA(2))_U_$G(VAPA(3))_U_$G(VAPA(4))_U_$P($G(VAPA(5)),U,2)_U_+$G(VAPA(6))
- S ^TMP("RCRCVL",$J,"XM",PRCABN,4,1)="INS^"_$P($G(RCIB("PIN")),U,1)_U_$G(RCIB("PIN","MMA"))_U_$P($G(RCIB("PIN")),U,2,4)
+ S ^TMP("RCRCVL",$J,"XM",PRCABN,4,1)="INS^"_$P($G(RCIB("PIN")),U,1)_U_$G(RCIB("PIN","MMA"))_U_$P($G(RCIB("PIN")),2,4)
  ;
  ; - set multiples if defined

FOIAVistA/tag/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCXVDC.m

@@ -1 +1 @@
 RCXVDC ;DAOU/ALA-AR Data Extraction Data Creation ;02-JUL-03
- ;;4.5;Accounts Receivable;**201,228,256**;Mar 20, 1995;Build 6
- ;;Per VHA Directive 2004-038, this routine should not be modified.
+ ;;4.5;Accounts Receivable;**201,228**;Mar 20, 1995
  ;
  Q
@@ -29 +28 @@
  S RCXVPC=0
  F  S RCXVPC=$O(^TMP($J,RCXVBLN,"4-399A",RCXVPC))  Q:'RCXVPC  D
- . I $G(^TMP($J,RCXVBLN,"4-399A",RCXVPC))'="" D
- .. W "399.0304:"
- .. W $G(^TMP($J,RCXVBLN,"4-399A",RCXVPC))
- .. W RCXVU
- .. F RCXVCP=1:1 Q:('$D(^TMP($J,RCXVBLN,"4-399A",RCXVPC,RCXVCP)))  D
- ... I RCXVCP>1 W "~"
- ... W $G(^TMP($J,RCXVBLN,"4-399A",RCXVPC,RCXVCP))
- ... Q
- .. W !
- . I $G(^TMP($J,RCXVBLN,"4-399B",RCXVPC))'="" W "399.042:"_$G(^TMP($J,RCXVBLN,"4-399B",RCXVPC)),!
+ . W "399.0304:"
+ . W $G(^TMP($J,RCXVBLN,"4-399A",RCXVPC))
+ . W RCXVU
+ . F RCXVCP=1:1 Q:('$D(^TMP($J,RCXVBLN,"4-399A",RCXVPC,RCXVCP)))  D
+ . . I RCXVCP>1 W "~"
+ . . W $G(^TMP($J,RCXVBLN,"4-399A",RCXVPC,RCXVCP))
+ . . Q
+ . W !
+ . I $D(^TMP($J,RCXVBLN,"4-399B",RCXVPC)) W "399.042:"_$G(^TMP($J,RCXVBLN,"4-399B",RCXVPC)),!
  . Q
  S RCXVI=""

FOIAVistA/tag/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCXVDC4.m

@@ -1 +1 @@
 RCXVDC4 ;DAOU/ALA-AR Data Extraction Data Creation ;02-JUL-03
- ;;4.5;Accounts Receivable;**201,227,228,248,251,256**;Mar 20, 1995;Build 6
+ ;;4.5;Accounts Receivable;**201,227,228,248,251**;Mar 20, 1995;Build 21
  ;;Per VHA Directive 2004-038, this routine should not be modified.
  ;
@@ -8 +8 @@
  I RCXVD0="" Q
  N RCXVD,RCXVDA,RCXVB,RCXVPC,RCXVP1,RCXVP2,RCXVP3,RCXVMULT
- N RCXVDT3,RCXVCP,RCXVPCDT,RCXVPS1,RCXVPS2,RCXVPS,RCXVPSER,RCXVNPI,RCXVCNT,RCXVMH
+ N RCXVDT3,RCXVCP,RCXVPCDT,RCXVPS1,RCXVPS2,RCXVPS,RCXVPSER,RCXVNPI
  ;RCXVPC=PROC. CODE IEN, RCXVCP=CPT CODE IEN
  ; LOOP THRU PROC.
- S RCXVMH="",(RCXVPC,RCXVCNT)=0
+ S RCXVPC=0
  F  S RCXVPC=$O(^DGCR(399,RCXVD0,"CP",RCXVPC)) Q:'RCXVPC  D D399PCA
- S RCXVPC=0
- F  S RCXVPC=$O(^DGCR(399,RCXVD0,"RC",RCXVPC)) Q:'RCXVPC  D D39942
  Q
 D399PCA ;
@@ -43 +41 @@
  ;provider^provider npi^specialty^service/section
  S RCXVDA=RCXVDA_RCXVU_RCXVP2_RCXVU_RCXVNPI_RCXVU_RCXVPS_RCXVU_RCXVPSER
- S RCXVCNT=RCXVCNT+1,^TMP($J,RCXVBLN,"4-399A",RCXVCNT)=RCXVDA
+ S ^TMP($J,RCXVBLN,"4-399A",RCXVPC)=RCXVDA
  ; LOOP THRU CPT
  S RCXVCP=0,RCXVMULT=0
@@ -54 +52 @@
  . S RCXVMULT=RCXVMULT+1
  . S RCXVP2=$P($G(^DIC(81.3,RCXVP1,0)),U,1)
- . S ^TMP($J,RCXVBLN,"4-399A",RCXVCNT,RCXVMULT)=RCXVP2
+ . S ^TMP($J,RCXVBLN,"4-399A",RCXVPC,RCXVMULT)=RCXVP2
  . Q
- ;
- ; *256 - loop through 399.042 to find CPT procedure
-MATCH N RCXVCPT1,RCXVFND,X
- S RCXVCPT1=$P(RCXVD,";",1)  ;proc
- S (RCXVFND,RCXVCP)=0
- F  S RCXVCP=$O(^DGCR(399,RCXVD0,"RC",RCXVCP)) Q:'RCXVCP!RCXVFND  D
- . Q:$F(RCXVMH,";"_RCXVCP)  ;quit if CPT proc match
- . S RCXVD1=$G(^DGCR(399,RCXVD0,"RC",RCXVCP,0))
- . Q:RCXVD1=""
- . S X=$P(RCXVD1,U,6)  ;CPT proc
- . I RCXVCPT1'="",X'="",RCXVCPT1=X D
- .. S RCXVFND=1
- .. S X=$P(RCXVD1,U)
- .. S RCXVDB=RCXVBLNA_RCXVU_$$GET1^DIQ(399.2,X_",",.01,"E") ; Revenue Code
- .. S X=$P(RCXVD1,U,6)
- .. S RCXVDB=RCXVDB_RCXVU_$$GET1^DIQ(81,X_",",.01,"E") ; Procedures [P]
- .. S RCXVDB=RCXVDB_RCXVU_RCXVPCDT ; PROC. DT
- .. S RCXVDB=RCXVDB_RCXVU_$P(RCXVD1,U,2) ; Charges
- .. S ^TMP($J,RCXVBLN,"4-399B",RCXVCNT)=RCXVDB
- .. S RCXVMH=RCXVMH_";"_RCXVCP
- I 'RCXVFND S ^TMP($J,RCXVBLN,"4-399B",RCXVCNT)=""
- Q
- ;  
-D39942 ; charge
+D39942 ; CHARGES FROM 399.042
+ ; LOOP THRU 399.042
  N X
- Q:$F(RCXVMH,";"_RCXVPC)
  S RCXVD1=$G(^DGCR(399,RCXVD0,"RC",RCXVPC,0))
- Q:RCXVD1=""
+ I RCXVD1="" Q
  S X=$P(RCXVD1,U)
  S RCXVDB=RCXVBLNA_RCXVU_$$GET1^DIQ(399.2,X_",",.01,"E") ; Revenue Code
- S RCXVDB=RCXVDB_RCXVU_""  ;No CPT proc
- S RCXVDB=RCXVDB_RCXVU_"" ; No proc dt
+ S X=$P(RCXVD1,U,6)
+ S RCXVDB=RCXVDB_RCXVU_$$GET1^DIQ(81,X_",",.01,"E") ; Procedures [P]
+ S RCXVDB=RCXVDB_RCXVU_RCXVPCDT ; PROC. DT
  S RCXVDB=RCXVDB_RCXVU_$P(RCXVD1,U,2) ; Charges
- S RCXVCNT=RCXVCNT+1
- S ^TMP($J,RCXVBLN,"4-399A",RCXVCNT)=""
- S ^TMP($J,RCXVBLN,"4-399B",RCXVCNT)=RCXVDB
+ S ^TMP($J,RCXVBLN,"4-399B",RCXVPC)=RCXVDB
  Q
  ;

FOIAVistA/tag/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCXVFTP.m

@@ -1 +1 @@
 RCXVFTP ;DAOU/ALA-FTP AR Data Extract Batch Files ;08-SEP-03
- ;;4.5;Accounts Receivable;**201,256**;Mar 20, 1995;Build 6
+ ;;4.5;Accounts Receivable;**201**;Mar 20, 1995
  ;
  ;**Program Description**
@@ -32 +32 @@
  I $$GET1^DIQ(342,"1,",20.06,"I")'="P" D
  . S RCXVIP="MORPHEUS.ARC.MED.VA.GOV"
- . S RCXVUSR="cbotest1"
+ . S RCXVUSR="cbotest"
  . S RCXVPAS="1qaz2wsx"
  ;