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)
+20 WRITE "^Dt Added^"_$PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,6)_"^"_$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,9999999)),U,6)
End DoDot:2
+21 ;
+22 IF $PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,7)'=$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,9999999)),U,7)
Begin DoDot:2
+23 WRITE !,"CPT^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,0)),U)
+24 WRITE "^Dt Deleted^"_$PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,7)_"^"_$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,9999999)),U,7)
End DoDot:2
+25 ;
+26 IF $PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,9999999)),U,2)'=$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,9999999)),U,2)
Begin DoDot:2
+27 WRITE !,"CPT^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,0)),U)
+28 WRITE "^Default Rev. Code^"
+29 WRITE $PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,9999999)),U,2)_"^"_$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,9999999)),U,2)
End DoDot:2
+30 ;
+31 ;short desc check
+32 SET BCSVMDT=9999999
+33 ;get most recent entry
SET BCSVMDT=$ORDER(^XCSV("ICPT","DATA",BCSVVA,61,"B",BCSVMDT),-1)
+34 IF BCSVMDT'=""
Begin DoDot:2
+35 SET BCSVMIEN=$ORDER(^XCSV("ICPT","DATA",BCSVVA,61,"B",BCSVMDT,0))
+36 IF BCSVMIEN=""
Begin DoDot:3
+37 WRITE !,"CPT^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,0)),U)
+38 WRITE "^Short Desc^"_$PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,2)_"^NONE"
End DoDot:3
QUIT
+39 SET BCSVUPIH=$$UPC^ABMERUTL($PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,2))
+40 SET BCSVUPVA=$$UPC^ABMERUTL($PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,61,BCSVMIEN,0)),U,2))
+41 IF BCSVUPIH'=BCSVUPVA
Begin DoDot:3
+42 WRITE !,"CPT^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,0)),U)_"^Short Desc^"
+43 WRITE $PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,2)_"^"_$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,61,BCSVMIEN,0)),U,2)
End DoDot:3
End DoDot:2
+44 ;
+45 ;desc check
+46 SET BCSVMDT=9999999
+47 SET BCSVODSC=""
+48 SET BCSVNDSC=""
+49 ;get most recent entry
SET BCSVMDT=$ORDER(^XCSV("ICPT","DATA",BCSVVA,62,"B",BCSVMDT),-1)
+50 IF BCSVMDT'=""
Begin DoDot:2
+51 SET BCSVDIEN=$ORDER(^XCSV("ICPT","DATA",BCSVVA,62,"B",BCSVMDT,0))
+52 SET BCSVMIEN=0
+53 FOR
SET BCSVMIEN=$ORDER(^XCSV("ICPT","DATA",BCSVVA,62,BCSVDIEN,1,BCSVMIEN))
IF 'BCSVMIEN
QUIT
Begin DoDot:3
+54 SET BCSVNDSC=BCSVNDSC_" "_$GET(^XCSV("ICPT","DATA",BCSVVA,62,BCSVDIEN,1,BCSVMIEN,0))
End DoDot:3
+55 SET BCSVMIEN=0
+56 FOR
SET BCSVMIEN=$ORDER(^BCSVTMP("BCSV-CPT",BCSVI,"D",BCSVMIEN))
IF 'BCSVMIEN
QUIT
Begin DoDot:3
+57 SET BCSVODSC=BCSVODSC_" "_$GET(^BCSVTMP("BCSV-CPT",BCSVI,"D",BCSVMIEN,0))
End DoDot:3
+58 IF $$UPC^ABMERUTL($TRANSLATE(BCSVNDSC," "))'=$$UPC^ABMERUTL($TRANSLATE(BCSVODSC," "))
Begin DoDot:3
+59 WRITE !,"CPT^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICPT","DATA",BCSVVA,0)),U)_"^Desc^"_BCSVODSC_"^"_BCSVNDSC
End DoDot:3
End DoDot:2
+60 ;
End DoDot:1
+61 QUIT
+62 ;
CMODDIFF ;
+1 SET BCSVI=0
+2 FOR
SET BCSVI=$ORDER(^DIC(81.3,BCSVI))
IF 'BCSVI
QUIT
Begin DoDot:1
+3 SET BCSVCD=$PIECE($GET(^DIC(81.3,BCSVI,0)),U)
+4 IF '$DATA(^AUTTCMOD("B",BCSVCD))
WRITE !,"CPT MOD^"_BCSVI_"^^Not found (IHS)"
QUIT
End DoDot:1
+5 ;;THIS CODE IS NOT COMPLETE. NEED CLARIFICATION ON ONE-TO-MANY ISSUE
+6 ;;VA has multiple entries for some code while IHS only has one
+7 QUIT
+8 ;
ICD9DIFF ;
+1 SET BCSVI=0
+2 FOR
SET BCSVI=$ORDER(^XCSV("ICD9","MAP",BCSVI))
IF 'BCSVI
QUIT
Begin DoDot:1
+3 SET BCSVVA=$PIECE($GET(^XCSV("ICD9","MAP",BCSVI)),U)
+4 ;Identifier
+5 IF $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,2)'=$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U,2)
Begin DoDot:2
+6 WRITE !,"ICD9^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U)_"^Identifer^"
+7 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,2)_"^"_$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U,2)
End DoDot:2
+8 ;Diagnosis
+9 SET BCSVMDT=9999999
+10 ;get most recent entry
SET BCSVMDT=$ORDER(^XCSV("ICD9","DATA",BCSVVA,67,"B",BCSVMDT),-1)
+11 IF BCSVMDT'=""
Begin DoDot:2
+12 SET BCSVMIEN=$ORDER(^XCSV("ICD9","DATA",BCSVVA,67,"B",BCSVMDT,0))
+13 IF BCSVMIEN=""
Begin DoDot:3
+14 WRITE !,"ICD9^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U)
+15 WRITE "^Diagnosis^"_$PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,2)_"^NONE"
End DoDot:3
QUIT
+16 IF $$UPC^ABMERUTL($TRANSLATE($PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,3)," "))'=$$UPC^ABMERUTL($TRANSLATE($PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,67,BCSVMIEN,0)),U,2)," "))
Begin DoDot:3
+17 WRITE !,"ICD9^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U)_"^Diagnosis^"
+18 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,3)_"^"_$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,67,BCSVMIEN,0)),U,2)
End DoDot:3
End DoDot:2
+19 ;Inactive Flag
+20 IF $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,9)'=$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U,9)
Begin DoDot:2
+21 WRITE !,"ICD9^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U)_"^Inactive Flag^"
+22 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,9)_"^"_$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U,9)
End DoDot:2
+23 ;Inactive Date
+24 IF $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,11)'=$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U,11)
Begin DoDot:2
+25 WRITE !,"ICD9^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U)_"^Inactive Date^"
+26 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,11)_"^"_$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U,11)
End DoDot:2
+27 ;Lower age
+28 IF $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U)'=$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U,14)
Begin DoDot:2
+29 WRITE !,"ICD9^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U)_"^Lower Age^"
+30 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U)_"^"_$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U,14)
End DoDot:2
+31 ;Upper age
+32 IF $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U,2)'=$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U,15)
Begin DoDot:2
+33 WRITE !,"ICD9^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U)_"^Upper Age^"
+34 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U,2)_"^"_$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U,15)
End DoDot:2
+35 ;Date Added
+36 IF $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U,4)'=$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U,16)
Begin DoDot:2
+37 WRITE !,"ICD9^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U)_"^Date Added^"
+38 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U,4)_"^"_$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U,16)
End DoDot:2
+39 ;Description
+40 SET BCSVODSC=$PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,1)),U)
+41 SET BCSVMDT=$ORDER(^XCSV("ICD9","DATA",BCSVVA,"B",9999999))
+42 IF BCSVMDT'=""
Begin DoDot:2
+43 SET BCSVMIEN=$ORDER(^XCSV("ICD9","DATA",BCSVVA,"B",BCSVMDT,0))
+44 SET BCSVNDSC=$GET(^XCSV("ICD9","DATA",BCSVVA,68,BCSVMIEN,1))
+45 IF $$UPC^ABMERUTL($TRANSLATE(BCSVODSC," "))'=$$UPC^ABMERUTL($TRANSLATE(BCSVNDSC," "))
Begin DoDot:3
+46 WRITE !,"ICD9^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICD9","DATA",BCSVVA,0)),U)_"^Desc^"_BCSVODSC_"^"_BCSVNDSC
End DoDot:3
End DoDot:2
End DoDot:1
+47 QUIT
+48 ;
ICD0DIFF ;
+1 SET BCSVI=0
+2 FOR
SET BCSVI=$ORDER(^XCSV("ICD0","MAP",BCSVI))
IF 'BCSVI
QUIT
Begin DoDot:1
+3 SET BCSVVA=$PIECE($GET(^XCSV("ICD0","MAP",BCSVI)),U)
+4 ;Identifier
+5 IF $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,2)'=$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,0)),U,2)
Begin DoDot:2
+6 WRITE !,"ICD0^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,0)),U)_"^Identifer^"
+7 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,2)_"^"_$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,0)),U,2)
End DoDot:2
+8 ;Operation/Procedure
+9 SET BCSVMDT=9999999
+10 ;get most recent entry
SET BCSVMDT=$ORDER(^XCSV("ICD0","DATA",BCSVVA,67,"B",BCSVMDT),-1)
+11 IF BCSVMDT'=""
Begin DoDot:2
+12 SET BCSVMIEN=$ORDER(^XCSV("ICD0","DATA",BCSVVA,67,"B",BCSVMDT,0))
+13 IF BCSVMIEN=""
Begin DoDot:3
+14 WRITE !,"ICD0^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,0)),U)_"^Diagnosis^"
+15 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,2)_"^NONE"
End DoDot:3
QUIT
+16 IF $$UPC^ABMERUTL($TRANSLATE($PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,4)," "))'=$$UPC^ABMERUTL($TRANSLATE($PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,67,BCSVMIEN,0)),U,2)," "))
Begin DoDot:3
+17 WRITE !,"ICD0^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,0)),U)_"^Diagnosis^"
+18 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,4)_"^"_$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,67,BCSVMIEN,0)),U,2)
End DoDot:3
End DoDot:2
+19 ;Inactive Flag
+20 IF $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,9)'=$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,0)),U,9)
Begin DoDot:2
+21 WRITE !,"ICD0^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,0)),U)_"^Inactive Flag^"
+22 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,9)_"^"_$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,0)),U,9)
End DoDot:2
+23 ;Inactive Date
+24 IF $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,11)'=$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,0)),U,11)
Begin DoDot:2
+25 WRITE !,"ICD0^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,0)),U)_"^Inactive Date^"
+26 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,11)_"^"_$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,0)),U,11)
End DoDot:2
+27 ;Lower age
+28 IF $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U)'=$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,9999999)),U)
Begin DoDot:2
+29 WRITE !,"ICD0^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,0)),U)_"^Lower Age^"
+30 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U)_"^"_$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,9999999)),U)
End DoDot:2
+31 ;Upper age
+32 IF $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U,2)'=$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,9999999)),U,2)
Begin DoDot:2
+33 WRITE !,"ICD0^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,0)),U)_"^Upper Age^"
+34 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U,2)_"^"_$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,9999999)),U,2)
End DoDot:2
+35 ;Date Added
+36 IF $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U,4)'=$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,0)),U,12)
Begin DoDot:2
+37 WRITE !,"ICD0^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,0)),U)_"^Date Added^"
+38 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U,4)_"^"_$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,0)),U,12)
End DoDot:2
+39 ;Description
+40 SET BCSVODSC=$PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,1)),U)
+41 SET BCSVMDT=$ORDER(^XCSV("ICD0","DATA",BCSVVA,"B",9999999))
+42 IF BCSVMDT'=""
Begin DoDot:2
+43 SET BCSVMIEN=$ORDER(^XCSV("ICD0","DATA",BCSVVA,"B",BCSVMDT,0))
+44 SET BCSVNDSC=$GET(^XCSV("ICD0","DATA",BCSVVA,68,BCSVMIEN,1))
+45 IF $$UPC^ABMERUTL($TRANSLATE(BCSVODSC," "))'=$$UPC^ABMERUTL($TRANSLATE(BCSVNDSC," "))
Begin DoDot:3
+46 WRITE !,"ICD0^"_BCSVI_"^"_$PIECE($GET(^XCSV("ICD0","DATA",BCSVVA,0)),U)_"^Desc^"_BCSVODSC_"^"_BCSVNDSC
End DoDot:3
End DoDot:2
End DoDot:1
+47 QUIT
