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

RCXVDC4.m

Go to the documentation of this file.
RCXVDC4 ;DAOU/ALA-AR Data Extraction Data Creation ;02-JUL-03
 ;;4.5;Accounts Receivable;**201,227,228,248,251,256,262,281**;Mar 20, 1995;Build 6
 ;;Per VHA Directive 2004-038, this routine should not be modified.
 ;
 ; Procedures 
 Q
D399PC ;
 I RCXVD0="" Q
 N RCXVD,RCXVDA,RCXVB,RCXVPC,RCXVP1,RCXVP2,RCXVP3,RCXVMULT
 N RCXVDT3,RCXVCP,RCXVPCDT,RCXVPS1,RCXVPS2,RCXVPS,RCXVPSER,RCXVNPI,RCXVCNT,RCXVMH
 ;RCXVPC=PROC. CODE IEN, RCXVCP=CPT CODE IEN
 ; LOOP THRU PROC.
 S (RCXVPC,RCXVCNT)=0
 K ^TMP($J,"MTCH")
 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
 K ^TMP($J,"MTCH")
 Q
D399PCA ;
 S RCXVD=$G(^DGCR(399,RCXVD0,"CP",RCXVPC,0)) Q:RCXVD=""
 S RCXVP1=$P(RCXVD,U,1),RCXVVP="",RCXVVP1=""
 ;
 I RCXVP1'="",$P(RCXVP1,";",2)'="ICD0(" D
 . S RCXVVP="^"_$P(RCXVP1,";",2)_$P(RCXVP1,";",1)_",0)"
 . I RCXVVP'="" S RCXVVP1=$P($G(@RCXVVP),U,1)_RCXVU  ; ICD10 in *281 - CPT code will not have a ICD code qualifier, so delimiter is added to account for qualifier field.
 ;
 ; ICD10 in *281 - procedure code by calling API #5747 (80.1,ien)
 I RCXVP1'="",$P(RCXVP1,";",2)="ICD0(" D
 . S RCXVVP1=$P($$CODEC^ICDEX(80.1,$P(RCXVP1,";")),U)
 . S:RCXVVP1=-1 RCXVVP1=""
 . ; ICD10 in *281 - determine procedure code qualifier by calling API #5747
 . ; $$CODECS^ICDEX(CODE/IEN,FILE,CDT) coding system for code ien/file.
 . ; Procedure code qualifiers ICD-9, ICD-10, etc.
 . I RCXVVP1'="" S RCXVVP1=RCXVVP1_RCXVU_$P($$CODECS^ICDEX(RCXVP1,80.1,$P(RCXVD,U,2)),U,1) ; procedure code and qualifier.
 ;
 I RCXVVP1="" D  S RCXVVP1=RCXVU  ; ICD10 in *281 - need to add delimiter for ICD proc code qualifier if no proc.
 . NEW CT
 . S CT=$G(^TMP("RCXVBREC",$J,0))+1,^TMP("RCXVBREC",$J,0)=CT
 . S ^TMP("RCXVBREC",$J,CT,0)="Bill # "_$P($G(^DGCR(399,RCXVD0,0)),"^",1)_" has a bad CPT code at IEN # "_RCXVPC_" check ^DGCR(399,"_RCXVD0_",""CP"","_RCXVPC_",0)"
 S RCXVDA=RCXVBLNA_RCXVU_RCXVVP1 ; PROC. ICD10 in *281 - RCXVVP1 contains the record for the PROC and ICD code qualifier (PROC_DELIMITER_QUALIFIER). Qualifier can be NULL.
 S RCXVDT=$P(RCXVD,U,2)
 S RCXVPCDT=$E($$HLDATE^HLFNC(RCXVDT),1,8)
 S RCXVDA=RCXVDA_RCXVU_RCXVPCDT ; DT 
 S RCXVP1=$P(RCXVD,U,11),RCXVP2=""
 ;
 ; ICD10 in *281 - diagnosis code by calling API #5747 (80,ien)
 I RCXVP1'="" D
 . S RCXVP1=$P($G(^IBA(362.3,RCXVP1,0)),U,1)
 . S RCXVP2=$P($$CODEC^ICDEX(80,RCXVP1),U)
 . S:RCXVP2=-1 RCXVP2=""
 . ; ICD10 in *281 - determine diagnosis code qualifier by calling API #5747
 . ; $$CODECS^ICDEX(CODE/IEN,FILE,CDT) coding system for code ien/file.
 . ; Diagnosis code qualifiers ICD-9, ICD-10, etc.
 . I RCXVP2'="" S RCXVP2=RCXVP2_RCXVU_$P($$CODECS^ICDEX(RCXVP1,80,$P(RCXVD,U,2)),U,1) ; diagnosis code and qualifier.
 ;
 S:RCXVP2="" RCXVP2=RCXVU  ; ICD10 in *281 - need to add delimiter for ICD ASSOC DXN (1) code qualifier if no ASSOC DXN (1).
 S RCXVDA=RCXVDA_RCXVU_RCXVP2 ; ASSOC DXN (1)
 S RCXVP1=$P(RCXVD,U,7),RCXVP2=""
 I RCXVP1'="" S RCXVP2=$P($G(^SC(RCXVP1,0)),U,1)
 S RCXVDA=RCXVDA_RCXVU_RCXVP2 ; ASSC. CLNC (P) 
 S RCXVP1=$P(RCXVD,U,18),(RCXVP2,RCXVPS,RCXVPSER,RCXVNPI)=""
 I RCXVP1'="" S RCXVP2=$$GET1^DIQ(200,RCXVP1_",",.01,"E"),RCXVNPI=$P($$NPI^XUSNPI("Individual_ID",RCXVP1),RCXVU,1) S:+RCXVNPI<1 RCXVNPI="" D
 . S RCXVPS=$$GET^XUA4A72(RCXVP1,RCXVDT)
 . S RCXVPS=$P(RCXVPS,U,3)
 . S RCXVPSER=$$GET1^DIQ(200,RCXVP1_",",29,"E")
 . Q
 ;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
 ; LOOP THRU CPT
 S RCXVCP=0,RCXVMULT=0
 F  S RCXVCP=$O(^DGCR(399,RCXVD0,"CP",RCXVPC,"MOD",RCXVCP)) Q:'RCXVCP  D
 .  Q:'($D(^DGCR(399,RCXVD0,"CP",RCXVPC,"MOD",RCXVCP,0)))
 . ; ^DGCR(399,D0,CP,D1,MOD,D2,0)= (#.01) CPT MODIFIER SEQUENCE [1N]
 . ; (#.02) CPT ==>MODIFIER [2P:81.3]
 . S RCXVP1=$P($G(^DGCR(399,RCXVD0,"CP",RCXVPC,"MOD",RCXVCP,0)),U,2)
 . Q:RCXVP1=""
 . S RCXVMULT=RCXVMULT+1
 . S RCXVP2=$P($G(^DIC(81.3,RCXVP1,0)),U,1)
 . S ^TMP($J,RCXVBLN,"4-399A",RCXVCNT,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:$D(^TMP($J,"MTCH",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 ^TMP($J,"MTCH",RCXVCP)=""
 I 'RCXVFND S ^TMP($J,RCXVBLN,"4-399B",RCXVCNT)=""
 Q
 ;  
D39942 ; charge
 N X
 Q:$D(^TMP($J,"MTCH",RCXVPC))
 S RCXVD1=$G(^DGCR(399,RCXVD0,"RC",RCXVPC,0))
 Q:RCXVD1=""
 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 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
 Q
 ;