BCSVDQR1.m

BCSVDQR1 ;IHS/SD/SDR - BCSV*1.0 Reports ; 12/21/2008 00:29

 ;;1.0;BCSV;;APR 23, 2010

 ;

GETFILE ;

 K DIR,DIC,DIE,DA,X,Y

 S DIR(0)="F^Ar"

 S DIR("A")="Enter path"

 D ^DIR K DIR

 Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)

 S BCSVPATH=Y

 ;filename

 K DIR,DIC,DIE,DA,X,Y

 S DIR(0)="F^Ar"

 S DIR("A")="Enter filename"

 D ^DIR K DIR

 Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)

 S BCSVFNAM=Y

 Q

MAPCK ;EP

 D GETFILE

 Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)

 ;

 F BCSVFILE="ICD0","ICD9","ICPT","DIC|81.3" D

 .K ^BCSVT(BCSVFILE)

 .S BCSVIENI=0

 .F  S BCSVIENI=$O(^XCSV(BCSVFILE,"MAP",BCSVIENI)) Q:'BCSVIENI  D

 ..S BCSVIENV=+$G(^XCSV(BCSVFILE,"MAP",BCSVIENI))  ;VA IEN

 ..I '$D(^BCSVT(BCSVFILE,BCSVIENV)) S ^BCSVT(BCSVFILE,BCSVIENV)=BCSVIENI Q

 ..I $D(^BCSVT(BCSVFILE,BCSVIENV)) D

 ...I $G(^BCSVT(BCSVFILE,"DUP",BCSVIENV))'="" D  Q

 ....S ^BCSVT(BCSVFILE,"DUP",BCSVIENV)=$G(^BCSVT(BCSVFILE,"DUP",BCSVIENV))_"^"_BCSVIENI

 ...;

 ...S ^BCSVT(BCSVFILE,"DUP",BCSVIENV)=$G(^BCSVT(BCSVFILE,BCSVIENV))_"^"_BCSVIENI

 ;

 ;write

 D OPEN^%ZISH("BCSVFILE",BCSVPATH,BCSVFNAM,"W")

 Q:POP

 U IO(0) W !!,"Writing report...."

 U IO

 D NOW^%DTC

 S Y=%

 D DD^%DT

 W !,"Report:-- MAP CHECK REPORT",?53,"Date: ",Y

 W !,"File:---- ",BCSVFNAM

 W !

 F BCSV=1:1:80 W "="

 W !,"The following items appear to have duplicate mapping."

 W !,"*  IHS Values"

 W !,"=> VA Value",!!

 F BCSV=1:1:80 W "="

 F BCSVFILE="ICD0","ICD9","ICPT","DIC|81.3" D

 .S BCSVVA=0

 .F  S BCSVVA=$O(^BCSVT(BCSVFILE,"DUP",BCSVVA)) Q:'BCSVVA  D

 ..S BCSVIHS=$G(^BCSVT(BCSVFILE,"DUP",BCSVVA))

 ..W !,"=> "_$P($G(^XCSV(BCSVFILE,"DATA",BCSVVA,0)),U)

 ..W ?15

 ..I BCSVFILE="ICPT"!(BCSVFILE="DIC|81.3") W $P($G(^XCSV(BCSVFILE,"DATA",BCSVVA,0)),U,2)

 ..I BCSVFILE="ICD9" W $P($G(^XCSV(BCSVFILE,"DATA",BCSVVA,0)),U,3)

 ..I BCSVFILE="ICD0" W $P($G(^XCSV(BCSVFILE,"DATA",BCSVVA,0)),U,4)

 ..W " ("_BCSVVA_")"

 ..I $L(BCSVIHS,"^")>0 D

 ...F BCSVJ=1:1:$L(BCSVIHS,"^") D

 ....S BCSVIEN=$P(BCSVIHS,"^",BCSVJ)

 ....W !,"*  "

 ....I BCSVFILE="ICPT" D

 .....W $P($G(^BCSVTMP("BCSV-CPT",BCSVIEN,0)),U)

 .....W ?15,$P($G(^BCSVTMP("BCSV-CPT",BCSVIEN,0)),U,2)

 ....I BCSVFILE="ICD9" D

 .....W $P($G(^BCSVTMP("BCSV-ICD9",BCSVIEN,0)),U)

 .....W ?15,$P($G(^BCSVTMP("BCSV-ICD9",BCSVIEN,0)),U,3)

 ....I BCSVFILE="ICD0" D

 .....W $P($G(^BCSVTMP("BCSV-ICD0",BCSVIEN,0)),U)

 .....W ?15,$P($G(^BCSVTMP("BCSV-ICD0",BCSVIEN,0)),U,4)

 ....W " ("_BCSVIEN_")"

 ..W !

 .K ^BCSVT(BCSVFILE)

 D CLOSE^%ZISH("BCSVFILE")

 Q

 ;

PRECSV ;EP

 S BCSVANS=1

 I +$$VERSION^XPDUTL("BCSV")>0 D

 .K DIR,DIC,DIE,DA,X,Y

 .S DIR(0)="YA"

 .S DIR("A",1)="The Conversion is complete at this time so the data reported"

 .S DIR("A",2)="may be inaccurate."

 .S DIR("A")="Are you sure you want to run this report? "

 .S DIR("B")="N"

 .D ^DIR K DIR

 .S BCSVANS=+Y

 Q:BCSVANS'=1  ;they exited out of report

 ;

 D GETFILE

 Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)

 ;

 ;

 D OPEN^%ZISH("BCSVFILE",BCSVPATH,BCSVFNAM,"W")

 Q:POP

 U IO(0) W !!,"Writing report...."

 U IO

 D NOW^%DTC

 S Y=%

 D DD^%DT

 W !,"Report:-- POST-CONVERSION DATA QUALITY REPORT  Date: ",Y

 W !,"File:---- ",BCSVFNAM

 ;D CPTADDS  ;counts and writes adds to IHS file

 ;D ICD0ADDS

 ;D ICD9ADDS

 W !,"File^IEN^Code^field^IHS value^VA value"

 D CPTDIFFS

 ;D CMODDIFF

 D ICD0DIFF

 D ICD9DIFF

 D CLOSE^%ZISH("BCSVFILE")

 Q

 ;

CPTDIFFS ;

 S BCSVI=0

 F  S BCSVI=$O(^XCSV("ICPT","MAP",BCSVI)) Q:'BCSVI  D

 .S BCSVVA=$P($G(^XCSV("ICPT","MAP",BCSVI)),U)

 .I $P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,3)'=$P($G(^XCSV("ICPT","DATA",BCSVVA,0)),U,3) D

 ..W !,"CPT^"_BCSVI_"^"_$P($G(^XCSV("ICPT","DATA",BCSVVA,0)),U)

 ..W "^CPT Category^"

 ..W $S($P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,3)'="":$P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,3),1:"NONE")

 ..W "^"_$P($G(^XCSV("ICPT","DATA",BCSVVA,0)),U,3)

 .;

 .I $P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,4)'=$P($G(^XCSV("ICPT","DATA",BCSVVA,0)),U,4) D

 ..W !,"CPT^"_BCSVI_"^"_$P($G(^XCSV("ICPT","DATA",BCSVVA,0)),U)

 ..W "^Inactive Flag^"_$P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,4)_"^"_$P($G(^XCSV("ICPT","DATA",BCSVVA,0)),U,4)

 .;

 .I $P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,5)'=$P($G(^XCSV("ICPT","DATA",BCSVVA,9999999)),U,5) D

 ..W !,"CPT^"_BCSVI_"^"_$P($G(^XCSV("ICPT","DATA",BCSVVA,0)),U)_"^ASC Pymt Grp^"

 ..W $P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,5)_"^"_$P($G(^XCSV("ICPT","DATA",BCSVVA,9999999)),U,5)

 .;

 .I $P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,6)'=$P($G(^XCSV("ICPT","DATA",BCSVVA,9999999)),U,6) D

 ..W !,"CPT^"_BCSVI_"^"_$P($G(^XCSV("ICPT","DATA",BCSVVA,0)),U)

 ..W "^Dt Added^"_$P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,6)_"^"_$P($G(^XCSV("ICPT","DATA",BCSVVA,9999999)),U,6)

 .;

 .I $P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,7)'=$P($G(^XCSV("ICPT","DATA",BCSVVA,9999999)),U,7) D

 ..W !,"CPT^"_BCSVI_"^"_$P($G(^XCSV("ICPT","DATA",BCSVVA,0)),U)

 ..W "^Dt Deleted^"_$P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,7)_"^"_$P($G(^XCSV("ICPT","DATA",BCSVVA,9999999)),U,7)

 .;

 .I $P($G(^BCSVTMP("BCSV-CPT",BCSVI,9999999)),U,2)'=$P($G(^XCSV("ICPT","DATA",BCSVVA,9999999)),U,2) D

 ..W !,"CPT^"_BCSVI_"^"_$P($G(^XCSV("ICPT","DATA",BCSVVA,0)),U)

 ..W "^Default Rev. Code^"

 ..W $P($G(^BCSVTMP("BCSV-CPT",BCSVI,9999999)),U,2)_"^"_$P($G(^XCSV("ICPT","DATA",BCSVVA,9999999)),U,2)

 .;

 .;short desc check

 .S BCSVMDT=9999999

 .S BCSVMDT=$O(^XCSV("ICPT","DATA",BCSVVA,61,"B",BCSVMDT),-1)  ;get most recent entry

 .I BCSVMDT'="" D

 ..S BCSVMIEN=$O(^XCSV("ICPT","DATA",BCSVVA,61,"B",BCSVMDT,0))

 ..I BCSVMIEN="" D  Q

 ...W !,"CPT^"_BCSVI_"^"_$P($G(^XCSV("ICPT","DATA",BCSVVA,0)),U)

 ...W "^Short Desc^"_$P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,2)_"^NONE"

 ..S BCSVUPIH=$$UPC^ABMERUTL($P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,2))

 ..S BCSVUPVA=$$UPC^ABMERUTL($P($G(^XCSV("ICPT","DATA",BCSVVA,61,BCSVMIEN,0)),U,2))

 ..I BCSVUPIH'=BCSVUPVA D

 ...W !,"CPT^"_BCSVI_"^"_$P($G(^XCSV("ICPT","DATA",BCSVVA,0)),U)_"^Short Desc^"

 ...W $P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,2)_"^"_$P($G(^XCSV("ICPT","DATA",BCSVVA,61,BCSVMIEN,0)),U,2)

 .;

 .;desc check

 .S BCSVMDT=9999999

 .S BCSVODSC=""

 .S BCSVNDSC=""

 .S BCSVMDT=$O(^XCSV("ICPT","DATA",BCSVVA,62,"B",BCSVMDT),-1)  ;get most recent entry

 .I BCSVMDT'="" D

 ..S BCSVDIEN=$O(^XCSV("ICPT","DATA",BCSVVA,62,"B",BCSVMDT,0))

 ..S BCSVMIEN=0

 ..F  S BCSVMIEN=$O(^XCSV("ICPT","DATA",BCSVVA,62,BCSVDIEN,1,BCSVMIEN)) Q:'BCSVMIEN  D

 ...S BCSVNDSC=BCSVNDSC_" "_$G(^XCSV("ICPT","DATA",BCSVVA,62,BCSVDIEN,1,BCSVMIEN,0))

 ..S BCSVMIEN=0

 ..F  S BCSVMIEN=$O(^BCSVTMP("BCSV-CPT",BCSVI,"D",BCSVMIEN)) Q:'BCSVMIEN  D

 ...S BCSVODSC=BCSVODSC_" "_$G(^BCSVTMP("BCSV-CPT",BCSVI,"D",BCSVMIEN,0))

 ..I $$UPC^ABMERUTL($TR(BCSVNDSC," "))'=$$UPC^ABMERUTL($TR(BCSVODSC," ")) D

 ...W !,"CPT^"_BCSVI_"^"_$P($G(^XCSV("ICPT","DATA",BCSVVA,0)),U)_"^Desc^"_BCSVODSC_"^"_BCSVNDSC

 .;

 Q

 ;

CMODDIFF ;

 S BCSVI=0

 F  S BCSVI=$O(^DIC(81.3,BCSVI)) Q:'BCSVI  D

 .S BCSVCD=$P($G(^DIC(81.3,BCSVI,0)),U)

 .I '$D(^AUTTCMOD("B",BCSVCD)) W !,"CPT MOD^"_BCSVI_"^^Not found (IHS)" Q

 ;;THIS CODE IS NOT COMPLETE.  NEED CLARIFICATION ON ONE-TO-MANY ISSUE

 ;;VA has multiple entries for some code while IHS only has one

 Q

 ;

ICD9DIFF ;

 S BCSVI=0

 F  S BCSVI=$O(^XCSV("ICD9","MAP",BCSVI)) Q:'BCSVI  D

 .S BCSVVA=$P($G(^XCSV("ICD9","MAP",BCSVI)),U)

 .;Identifier

 .I $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,2)'=$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U,2) D

 ..W !,"ICD9^"_BCSVI_"^"_$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U)_"^Identifer^"

 ..W $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,2)_"^"_$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U,2)

 .;Diagnosis

 .S BCSVMDT=9999999

 .S BCSVMDT=$O(^XCSV("ICD9","DATA",BCSVVA,67,"B",BCSVMDT),-1)  ;get most recent entry

 .I BCSVMDT'="" D

 ..S BCSVMIEN=$O(^XCSV("ICD9","DATA",BCSVVA,67,"B",BCSVMDT,0))

 ..I BCSVMIEN="" D  Q

 ...W !,"ICD9^"_BCSVI_"^"_$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U)

 ...W "^Diagnosis^"_$P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,2)_"^NONE"

 ..I $$UPC^ABMERUTL($TR($P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,3)," "))'=$$UPC^ABMERUTL($TR($P($G(^XCSV("ICD9","DATA",BCSVVA,67,BCSVMIEN,0)),U,2)," ")) D

 ...W !,"ICD9^"_BCSVI_"^"_$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U)_"^Diagnosis^"

 ...W $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,3)_"^"_$P($G(^XCSV("ICD9","DATA",BCSVVA,67,BCSVMIEN,0)),U,2)

 .;Inactive Flag

 .I $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,9)'=$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U,9) D

 ..W !,"ICD9^"_BCSVI_"^"_$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U)_"^Inactive Flag^"

 ..W $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,9)_"^"_$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U,9)

 .;Inactive Date

 .I $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,11)'=$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U,11) D

 ..W !,"ICD9^"_BCSVI_"^"_$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U)_"^Inactive Date^"

 ..W $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,11)_"^"_$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U,11)

 .;Lower age

 .I $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U)'=$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U,14) D

 ..W !,"ICD9^"_BCSVI_"^"_$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U)_"^Lower Age^"

 ..W $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U)_"^"_$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U,14)

 .;Upper age

 .I $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U,2)'=$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U,15) D

 ..W !,"ICD9^"_BCSVI_"^"_$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U)_"^Upper Age^"

 ..W $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U,2)_"^"_$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U,15)

 .;Date Added

 .I $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U,4)'=$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U,16) D

 ..W !,"ICD9^"_BCSVI_"^"_$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U)_"^Date Added^"

 ..W $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U,4)_"^"_$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U,16)

 .;Description

 .S BCSVODSC=$P($G(^BCSVTMP("BCSV-ICD9",BCSVI,1)),U)

 .S BCSVMDT=$O(^XCSV("ICD9","DATA",BCSVVA,"B",9999999))

 .I BCSVMDT'="" D

 ..S BCSVMIEN=$O(^XCSV("ICD9","DATA",BCSVVA,"B",BCSVMDT,0))

 ..S BCSVNDSC=$G(^XCSV("ICD9","DATA",BCSVVA,68,BCSVMIEN,1))

 ..I $$UPC^ABMERUTL($TR(BCSVODSC," "))'=$$UPC^ABMERUTL($TR(BCSVNDSC," ")) D

 ...W !,"ICD9^"_BCSVI_"^"_$P($G(^XCSV("ICD9","DATA",BCSVVA,0)),U)_"^Desc^"_BCSVODSC_"^"_BCSVNDSC

 Q

 ;

ICD0DIFF ;

 S BCSVI=0

 F  S BCSVI=$O(^XCSV("ICD0","MAP",BCSVI)) Q:'BCSVI  D

 .S BCSVVA=$P($G(^XCSV("ICD0","MAP",BCSVI)),U)

 .;Identifier

 .I $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,2)'=$P($G(^XCSV("ICD0","DATA",BCSVVA,0)),U,2) D

 ..W !,"ICD0^"_BCSVI_"^"_$P($G(^XCSV("ICD0","DATA",BCSVVA,0)),U)_"^Identifer^"

 ..W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,2)_"^"_$P($G(^XCSV("ICD0","DATA",BCSVVA,0)),U,2)

 .;Operation/Procedure

 .S BCSVMDT=9999999

 .S BCSVMDT=$O(^XCSV("ICD0","DATA",BCSVVA,67,"B",BCSVMDT),-1)  ;get most recent entry

 .I BCSVMDT'="" D

 ..S BCSVMIEN=$O(^XCSV("ICD0","DATA",BCSVVA,67,"B",BCSVMDT,0))

 ..I BCSVMIEN="" D  Q

 ...W !,"ICD0^"_BCSVI_"^"_$P($G(^XCSV("ICD0","DATA",BCSVVA,0)),U)_"^Diagnosis^"

 ...W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,2)_"^NONE"

 ..I $$UPC^ABMERUTL($TR($P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,4)," "))'=$$UPC^ABMERUTL($TR($P($G(^XCSV("ICD0","DATA",BCSVVA,67,BCSVMIEN,0)),U,2)," ")) D

 ...W !,"ICD0^"_BCSVI_"^"_$P($G(^XCSV("ICD0","DATA",BCSVVA,0)),U)_"^Diagnosis^"

 ...W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,4)_"^"_$P($G(^XCSV("ICD0","DATA",BCSVVA,67,BCSVMIEN,0)),U,2)

 .;Inactive Flag

 .I $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,9)'=$P($G(^XCSV("ICD0","DATA",BCSVVA,0)),U,9) D

 ..W !,"ICD0^"_BCSVI_"^"_$P($G(^XCSV("ICD0","DATA",BCSVVA,0)),U)_"^Inactive Flag^"

 ..W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,9)_"^"_$P($G(^XCSV("ICD0","DATA",BCSVVA,0)),U,9)

 .;Inactive Date

 .I $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,11)'=$P($G(^XCSV("ICD0","DATA",BCSVVA,0)),U,11) D

 ..W !,"ICD0^"_BCSVI_"^"_$P($G(^XCSV("ICD0","DATA",BCSVVA,0)),U)_"^Inactive Date^"

 ..W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,11)_"^"_$P($G(^XCSV("ICD0","DATA",BCSVVA,0)),U,11)

 .;Lower age

 .I $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U)'=$P($G(^XCSV("ICD0","DATA",BCSVVA,9999999)),U) D

 ..W !,"ICD0^"_BCSVI_"^"_$P($G(^XCSV("ICD0","DATA",BCSVVA,0)),U)_"^Lower Age^"

 ..W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U)_"^"_$P($G(^XCSV("ICD0","DATA",BCSVVA,9999999)),U)

 .;Upper age

 .I $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U,2)'=$P($G(^XCSV("ICD0","DATA",BCSVVA,9999999)),U,2) D

 ..W !,"ICD0^"_BCSVI_"^"_$P($G(^XCSV("ICD0","DATA",BCSVVA,0)),U)_"^Upper Age^"

 ..W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U,2)_"^"_$P($G(^XCSV("ICD0","DATA",BCSVVA,9999999)),U,2)

 .;Date Added

 .I $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U,4)'=$P($G(^XCSV("ICD0","DATA",BCSVVA,0)),U,12) D

 ..W !,"ICD0^"_BCSVI_"^"_$P($G(^XCSV("ICD0","DATA",BCSVVA,0)),U)_"^Date Added^"

 ..W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U,4)_"^"_$P($G(^XCSV("ICD0","DATA",BCSVVA,0)),U,12)

 .;Description

 .S BCSVODSC=$P($G(^BCSVTMP("BCSV-ICD0",BCSVI,1)),U)

 .S BCSVMDT=$O(^XCSV("ICD0","DATA",BCSVVA,"B",9999999))

 .I BCSVMDT'="" D

 ..S BCSVMIEN=$O(^XCSV("ICD0","DATA",BCSVVA,"B",BCSVMDT,0))

 ..S BCSVNDSC=$G(^XCSV("ICD0","DATA",BCSVVA,68,BCSVMIEN,1))

 ..I $$UPC^ABMERUTL($TR(BCSVODSC," "))'=$$UPC^ABMERUTL($TR(BCSVNDSC," ")) D

 ...W !,"ICD0^"_BCSVI_"^"_$P($G(^XCSV("ICD0","DATA",BCSVVA,0)),U)_"^Desc^"_BCSVODSC_"^"_BCSVNDSC

 Q

BCSVDQR1  ;IHS/SD/SDR - BCSV*1.0 Reports ; 12/21/2008 00:29

 +1       ;;1.0;BCSV;;APR 23, 2010

 +2       ;

GETFILE   ;

 +1        KILL DIR,DIC,DIE,DA,X,Y

 +2        SET DIR(0)="F^Ar"

 +3        SET DIR("A")="Enter path"

 +4        DO ^DIR

           KILL DIR

 +5        IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)

               QUIT 

 +6        SET BCSVPATH=Y

 +7       ;filename

 +8        KILL DIR,DIC,DIE,DA,X,Y

 +9        SET DIR(0)="F^Ar"

 +10       SET DIR("A")="Enter filename"

 +11       DO ^DIR

           KILL DIR

 +12       IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)

               QUIT 

 +13       SET BCSVFNAM=Y

 +14       QUIT 

MAPCK     ;EP

 +1        DO GETFILE

 +2        IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)

               QUIT 

 +3       ;

 +4        FOR BCSVFILE="ICD0","ICD9","ICPT","DIC|81.3"

               Begin DoDot:1

 +5                KILL ^BCSVT(BCSVFILE)

 +6                SET BCSVIENI=0

 +7                FOR 

                       SET BCSVIENI=$ORDER(^XCSV(BCSVFILE,"MAP",BCSVIENI))

                       IF 'BCSVIENI

                           QUIT 

                       Begin DoDot:2

 +8       ;VA IEN

                           SET BCSVIENV=+$GET(^XCSV(BCSVFILE,"MAP",BCSVIENI))

 +9                        IF '$DATA(^BCSVT(BCSVFILE,BCSVIENV))

                               SET ^BCSVT(BCSVFILE,BCSVIENV)=BCSVIENI

                               QUIT 

 +10                       IF $DATA(^BCSVT(BCSVFILE,BCSVIENV))

                               Begin DoDot:3

 +11                               IF $GET(^BCSVT(BCSVFILE,"DUP",BCSVIENV))'=""

                                       Begin DoDot:4

 +12                                       SET ^BCSVT(BCSVFILE,"DUP",BCSVIENV)=$GET(^BCSVT(BCSVFILE,"DUP",BCSVIENV))_"^"_BCSVIENI

                                       End DoDot:4

                                       QUIT 

 +13      ;

 +14                               SET ^BCSVT(BCSVFILE,"DUP",BCSVIENV)=$GET(^BCSVT(BCSVFILE,BCSVIENV))_"^"_BCSVIENI

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +15      ;

 +16      ;write

 +17       DO OPEN^%ZISH("BCSVFILE",BCSVPATH,BCSVFNAM,"W")

 +18       IF POP

               QUIT 

 +19       USE IO(0)

           WRITE !!,"Writing report...."

 +20       USE IO

 +21       DO NOW^%DTC

 +22       SET Y=%

 +23       DO DD^%DT

 +24       WRITE !,"Report:-- MAP CHECK REPORT",?53,"Date: ",Y

 +25       WRITE !,"File:---- ",BCSVFNAM

 +26       WRITE !

 +27       FOR BCSV=1:1:80

               WRITE "="

 +28       WRITE !,"The following items appear to have duplicate mapping."

 +29       WRITE !,"*  IHS Values"

 +30       WRITE !,"=> VA Value",!!

 +31       FOR BCSV=1:1:80

               WRITE "="

 +32       FOR BCSVFILE="ICD0","ICD9","ICPT","DIC|81.3"

               Begin DoDot:1

 +33               SET BCSVVA=0

 +34               FOR 

                       SET BCSVVA=$ORDER(^BCSVT(BCSVFILE,"DUP",BCSVVA))

                       IF 'BCSVVA

                           QUIT 

                       Begin DoDot:2

 +35                       SET BCSVIHS=$GET(^BCSVT(BCSVFILE,"DUP",BCSVVA))

 +36                       WRITE !,"=> "_$PIECE($GET(^XCSV(BCSVFILE,"DATA",BCSVVA,0)),U)

 +37                       WRITE ?15

 +38                       IF BCSVFILE="ICPT"!(BCSVFILE="DIC|81.3")

                               WRITE $PIECE($GET(^XCSV(BCSVFILE,"DATA",BCSVVA,0)),U,2)

 +39                       IF BCSVFILE="ICD9"

                               WRITE $PIECE($GET(^XCSV(BCSVFILE,"DATA",BCSVVA,0)),U,3)

 +40                       IF BCSVFILE="ICD0"

                               WRITE $PIECE($GET(^XCSV(BCSVFILE,"DATA",BCSVVA,0)),U,4)

 +41                       WRITE " ("_BCSVVA_")"

 +42                       IF $LENGTH(BCSVIHS,"^")>0

                               Begin DoDot:3

 +43                               FOR BCSVJ=1:1:$LENGTH(BCSVIHS,"^")

                                       Begin DoDot:4

 +44                                       SET BCSVIEN=$PIECE(BCSVIHS,"^",BCSVJ)

 +45                                       WRITE !,"*  "

 +46                                       IF BCSVFILE="ICPT"

                                               Begin DoDot:5

 +47                                               WRITE $PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVIEN,0)),U)

 +48                                               WRITE ?15,$PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVIEN,0)),U,2)

                                               End DoDot:5

 +49                                       IF BCSVFILE="ICD9"

                                               Begin DoDot:5

 +50                                               WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVIEN,0)),U)

 +51                                               WRITE ?15,$PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVIEN,0)),U,3)

                                               End DoDot:5

 +52                                       IF BCSVFILE="ICD0"

                                               Begin DoDot:5

 +53                                               WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVIEN,0)),U)

 +54                                               WRITE ?15,$PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVIEN,0)),U,4)

                                               End DoDot:5

 +55                                       WRITE " ("_BCSVIEN_")"

                                       End DoDot:4

                               End DoDot:3

 +56                       WRITE !

                       End DoDot:2

 +57               KILL ^BCSVT(BCSVFILE)

               End DoDot:1

 +58       DO CLOSE^%ZISH("BCSVFILE")

 +59       QUIT 

 +60      ;

PRECSV    ;EP

 +1        SET BCSVANS=1

 +2        IF +$$VERSION^XPDUTL("BCSV")>0

               Begin DoDot:1

 +3                KILL DIR,DIC,DIE,DA,X,Y

 +4                SET DIR(0)="YA"

 +5                SET DIR("A",1)="The Conversion is complete at this time so the data reported"

 +6                SET DIR("A",2)="may be inaccurate."

 +7                SET DIR("A")="Are you sure you want to run this report? "

 +8                SET DIR("B")="N"

 +9                DO ^DIR

                   KILL DIR

 +10               SET BCSVANS=+Y

               End DoDot:1

 +11      ;they exited out of report

           IF BCSVANS'=1

               QUIT 

 +12      ;

 +13       DO GETFILE

 +14       IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)

               QUIT 

 +15      ;

 +16      ;

 +17       DO OPEN^%ZISH("BCSVFILE",BCSVPATH,BCSVFNAM,"W")

 +18       IF POP

               QUIT 

 +19       USE IO(0)

           WRITE !!,"Writing report...."

 +20       USE IO

 +21       DO NOW^%DTC

 +22       SET Y=%

 +23       DO DD^%DT

 +24       WRITE !,"Report:-- POST-CONVERSION DATA QUALITY REPORT  Date: ",Y

 +25       WRITE !,"File:---- ",BCSVFNAM

 +26      ;D CPTADDS  ;counts and writes adds to IHS file

 +27      ;D ICD0ADDS

 +28      ;D ICD9ADDS

 +29       WRITE !,"File^IEN^Code^field^IHS value^VA value"

 +30       DO CPTDIFFS

 +31      ;D CMODDIFF

 +32       DO ICD0DIFF

 +33       DO ICD9DIFF

 +34       DO CLOSE^%ZISH("BCSVFILE")

 +35       QUIT 

 +36      ;

CPTDIFFS  ;

 +1        SET BCSVI=0

 +2        FOR 

               SET BCSVI=$ORDER(^XCSV("ICPT","MAP",BCSVI))

               IF 'BCSVI

                   QUIT 

               Begin DoDot:1

 +3                SET BCSVVA=$PIECE($GET(^XCSV("ICPT","MAP",BCSVI)),U)

 +4                IF $PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,3)'=$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,0)),U,3)

                       Begin DoDot:2

 +5                        WRITE !,"CPT^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,0)),U)

 +6                        WRITE "^CPT Category^"

 +7                        WRITE $SELECT($PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,3)'="":$PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,3),1:"NONE")

 +8                        WRITE "^"_$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,0)),U,3)

                       End DoDot:2

 +9       ;

 +10               IF $PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,4)'=$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,0)),U,4)

                       Begin DoDot:2

 +11                       WRITE !,"CPT^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,0)),U)

 +12                       WRITE "^Inactive Flag^"_$PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,4)_"^"_$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,0)),U,4)

                       End DoDot:2

 +13      ;

 +14               IF $PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,5)'=$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,9999999)),U,5)

                       Begin DoDot:2

 +15                       WRITE !,"CPT^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,0)),U)_"^ASC Pymt Grp^"

 +16                       WRITE $PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,5)_"^"_$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,9999999)),U,5)

                       End DoDot:2

 +17      ;

 +18               IF $PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,6)'=$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,9999999)),U,6)

                       Begin DoDot:2

 +19                       WRITE !,"CPT^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,0)),U)