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

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/RCXVDC4.m (modified) (4 diffs)

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
  ;