BCSVDQR ;IHS/SD/SDR - BCSV*1.0 install ; 12/21/2008 00:29
;;1.0;BCSV;;APR 23, 2010
;
PRECMRG ; EP - This tag should be run to get IHS data into a temp space to
; compare with later. If this isn't done, there won't be anything
; to compare to for the report.
CPT ;
S BCSVI=0
S BCSVCNT=0
F S BCSVI=$O(^ICPT(BCSVI)) Q:'BCSVI D
.M ^BCSVTMP("BCSV-CPT",BCSVI)=^ICPT(BCSVI)
.S BCSVCNT=+$G(BCSVCNT)+1
W !,"CPT : "_BCSVCNT
ICD0 ;
S BCSVI=0
S BCSVCNT=0
F S BCSVI=$O(^ICD0(BCSVI)) Q:'BCSVI D
.M ^BCSVTMP("BCSV-ICD0",BCSVI)=^ICD0(BCSVI)
.S BCSVCNT=+$G(BCSVCNT)+1
W !,"ICD0: "_BCSVCNT
ICD9 ;
S BCSVI=0
S BCSVCNT=0
F S BCSVI=$O(^ICD9(BCSVI)) Q:'BCSVI D
.M ^BCSVTMP("BCSV-ICD9",BCSVI)=^ICD9(BCSVI)
.S BCSVCNT=+$G(BCSVCNT)+1
W !,"ICD9: "_BCSVCNT
;
Q
;
PRECSV ; EP - Pre-Conversion Report
D PRECSV^BCSVDQR1
Q
;
MAPCK ; EP - Map Check Report
D MAPCK^BCSVDQR1
Q
;
POSTCSV ; EP - Post-Conversion Report
S BCSVANS=1
I +$$VERSION^XPDUTL("BCSV")<1 D
.K DIR,DIC,DIE,DA,X,Y
.S DIR(0)="YA"
.S DIR("A",1)="The Conversion is not 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
;path
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
;
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(^ICPT(BCSVI)) Q:'BCSVI D
.I '$D(^BCSVTMP("BCSV-CPT",BCSVI,0)) W !,"CPT^"_BCSVI_"^"_$P($G(^ICPT(BCSVI,0)),U)_"^Not found(IHS)" Q
.;
.I $P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,3)'=$P($G(^ICPT(BCSVI,0)),U,3) D
..W !,"CPT^"_BCSVI_"^"_$P($G(^ICPT(BCSVI,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(^ICPT(BCSVI,0)),U,3)
.;
.I $P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,4)'=$P($G(^ICPT(BCSVI,0)),U,4) D
..W !,"CPT^"_BCSVI_"^"_$P($G(^ICPT(BCSVI,0)),U)
..W "^Inactive Flag^"_$P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,4)_"^"_$P($G(^ICPT(BCSVI,0)),U,4)
.;
.I $P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,5)'=$P($G(^ICPT(BCSVI,9999999)),U,5) D
..W !,"CPT^"_BCSVI_"^"_$P($G(^ICPT(BCSVI,0)),U)
..W "^ASC Pymt Grp^"_$P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,5)_"^"_$P($G(^ICPT(BCSVI,9999999)),U,5)
.;
.I $P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,6)'=$P($G(^ICPT(BCSVI,9999999)),U,6) D
..W !,"CPT^"_BCSVI_"^"_$P($G(^ICPT(BCSVI,0)),U)
..W "^Dt Added^"_$P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,6)_"^"_$P($G(^ICPT(BCSVI,9999999)),U,6)
.;
.I $P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,7)'=$P($G(^ICPT(BCSVI,9999999)),U,7) D
..W !,"CPT^"_BCSVI_"^"_$P($G(^ICPT(BCSVI,0)),U)
..W "^Dt Deleted^"_$P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,7)_"^"_$P($G(^ICPT(BCSVI,9999999)),U,7)
.;
.I $P($G(^BCSVTMP("BCSV-CPT",BCSVI,9999999)),U,2)'=$P($G(^ICPT(BCSVI,9999999)),U,2) D
..W !,"CPT^"_BCSVI_"^"_$P($G(^ICPT(BCSVI,0)),U)
..W "^Default Rev. Code^"
..W $P($G(^BCSVTMP("BCSV-CPT",BCSVI,9999999)),U,2)_"^"_$P($G(^ICPT(BCSVI,9999999)),U,2)
.;
.;short desc check
.S BCSVMDT=9999999
.S BCSVMDT=$O(^ICPT(BCSVI,61,"B",BCSVMDT),-1) ;get most recent entry
.I BCSVMDT'="" D
..S BCSVMIEN=$O(^ICPT(BCSVI,61,"B",BCSVMDT,0))
..I BCSVMIEN="" D Q
...W !,"CPT^"_BCSVI_"^"_$P($G(^ICPT(BCSVI,0)),U)
...W "^Short Desc^"_$P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,2)_"^NONE"
..I $$UPC^ABMERUTL($P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,2))'=$$UPC^ABMERUTL($P($G(^ICPT(BCSVI,61,BCSVMIEN,0)),U,2)) D
...W !,"CPT^"_BCSVI_"^"_$P($G(^ICPT(BCSVI,0)),U)
...W "^Short Desc^"_$P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,2)_"^"_$P($G(^ICPT(BCSVI,61,BCSVMIEN,0)),U,2)
.;
.;desc check
.S BCSVMDT=9999999
.S BCSVODSC=""
.S BCSVNDSC=""
.S BCSVMDT=$O(^ICPT(BCSVI,62,"B",BCSVMDT),-1) ;get most recent entry
.I BCSVMDT'="" D
..S BCSVDIEN=$O(^ICPT(BCSVI,62,"B",BCSVMDT,0))
..S BCSVMIEN=0
..F S BCSVMIEN=$O(^ICPT(BCSVI,62,BCSVDIEN,1,BCSVMIEN)) Q:'BCSVMIEN D
...S BCSVNDSC=BCSVNDSC_" "_$G(^ICPT(BCSVI,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(^ICPT(BCSVI,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(^ICD9(BCSVI)) Q:'BCSVI D
.I '$D(^BCSVTMP("BCSV-ICD9",BCSVI,0)) W !,"ICD9^"_BCSVI_"^"_$P($G(^ICD9(BCSVI,0)),U)_"^Not found(IHS)" Q
.;
.;Identifier
.I $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,2)'=$P($G(^ICD9(BCSVI,0)),U,2) D
..W !,"ICD9^"_BCSVI_"^"_$P($G(^ICD9(BCSVI,0)),U)_"^Identifer^"
..W $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,2)_"^"_$P($G(^ICD9(BCSVI,0)),U,2)
.;Diagnosis
.S BCSVMDT=9999999
.S BCSVMDT=$O(^ICD9(BCSVI,67,"B",BCSVMDT),-1) ;get most recent entry
.I BCSVMDT'="" D
..S BCSVMIEN=$O(^ICD9(BCSVI,67,"B",BCSVMDT,0))
..I BCSVMIEN="" D Q
...W !,"ICD9^"_BCSVI_"^"_$P($G(^ICD9(BCSVI,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(^ICD9(BCSVI,67,BCSVMIEN,0)),U,2)," ")) D
...W !,"ICD9^"_BCSVI_"^"_$P($G(^ICD9(BCSVI,0)),U)_"^Diagnosis^"
...W $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,3)_"^"_$P($G(^ICD9(BCSVI,67,BCSVMIEN,0)),U,2)
.;Inactive Flag
.I $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,9)'=$P($G(^ICD9(BCSVI,0)),U,9) D
..W !,"ICD9^"_BCSVI_"^"_$P($G(^ICD9(BCSVI,0)),U)_"^Inactive Flag^"
..W $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,9)_"^"_$P($G(^ICD9(BCSVI,0)),U,9)
.;Inactive Date
.I $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,11)'=$P($G(^ICD9(BCSVI,0)),U,11) D
..W !,"ICD9^"_BCSVI_"^"_$P($G(^ICD9(BCSVI,0)),U)_"^Inactive Date^"
..W $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,11)_"^"_$P($G(^ICD9(BCSVI,0)),U,11)
.;Lower age
.I $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U)'=$P($G(^ICD9(BCSVI,0)),U,14) D
..W !,"ICD9^"_BCSVI_"^"_$P($G(^ICD9(BCSVI,0)),U)_"^Lower Age^"
..W $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U)_"^"_$P($G(^ICD9(BCSVI,0)),U,14)
.;Upper age
.I $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U,2)'=$P($G(^ICD9(BCSVI,0)),U,15) D
..W !,"ICD9^"_BCSVI_"^"_$P($G(^ICD9(BCSVI,0)),U)_"^Upper Age^"
..W $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U,2)_"^"_$P($G(^ICD9(BCSVI,0)),U,15)
.;Date Added
.I $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U,4)'=$P($G(^ICD9(BCSVI,0)),U,16) D
..W !,"ICD9^"_BCSVI_"^"_$P($G(^ICD9(BCSVI,0)),U)
..W "^Date Added^"_$P($G(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U,4)_"^"_$P($G(^ICD9(BCSVI,0)),U,16)
.;Description
.S BCSVODSC=$P($G(^BCSVTMP("BCSV-ICD9",BCSVI,1)),U)
.S BCSVMDT=$O(^ICD9(BCSVI,"B",9999999))
.I BCSVMDT'="" D
..S BCSVMIEN=$O(^ICD9(BCSVI,"B",BCSVMDT,0))
..S BCSVNDSC=$G(^ICD9(BCSVI,68,BCSVMIEN,1))
..I $$UPC^ABMERUTL($TR(BCSVODSC," "))'=$$UPC^ABMERUTL($TR(BCSVNDSC," ")) D
...W !,"ICD9^"_BCSVI_"^"_$P($G(^ICD9(BCSVI,0)),U)_"^Desc^"_BCSVODSC_"^"_BCSVNDSC
Q
;
ICD0DIFF ;
S BCSVI=0
F S BCSVI=$O(^ICD0(BCSVI)) Q:'BCSVI D
.I '$D(^BCSVTMP("BCSV-ICD0",BCSVI,0)) W !,"ICD0^"_BCSVI_"^"_$P($G(^ICD0(BCSVI,0)),U)_"^Not found(IHS)" Q
.;
.;Identifier
.I $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,2)'=$P($G(^ICD0(BCSVI,0)),U,2) D
..W !,"ICD0^"_BCSVI_"^"_$P($G(^ICD0(BCSVI,0)),U)_"^Identifer^"
..W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,2)_"^"_$P($G(^ICD9(BCSVI,0)),U,2)
.;Operation/Procedure
.S BCSVMDT=9999999
.S BCSVMDT=$O(^ICD0(BCSVI,67,"B",BCSVMDT),-1) ;get most recent entry
.I BCSVMDT'="" D
..S BCSVMIEN=$O(^ICD0(BCSVI,67,"B",BCSVMDT,0))
..I BCSVMIEN="" D Q
...W !,"ICD0^"_BCSVI_"^"_$P($G(^ICD0(BCSVI,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(^ICD0(BCSVI,67,BCSVMIEN,0)),U,2)," ")) D
...W !,"ICD0^"_BCSVI_"^"_$P($G(^ICD0(BCSVI,0)),U)_"^Diagnosis^"
...W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,4)_"^"_$P($G(^ICD0(BCSVI,67,BCSVMIEN,0)),U,2)
.;Inactive Flag
.I $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,9)'=$P($G(^ICD0(BCSVI,0)),U,9) D
..W !,"ICD0^"_BCSVI_"^"_$P($G(^ICD0(BCSVI,0)),U)_"^Inactive Flag^"
..W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,9)_"^"_$P($G(^ICD0(BCSVI,0)),U,9)
.;Inactive Date
.I $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,11)'=$P($G(^ICD0(BCSVI,0)),U,11) D
..W !,"ICD0^"_BCSVI_"^"_$P($G(^ICD0(BCSVI,0)),U)_"^Inactive Date^"
..W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,11)_"^"_$P($G(^ICD0(BCSVI,0)),U,11)
.;Lower age
.I $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U)'=$P($G(^ICD0(BCSVI,9999999)),U) D
..W !,"ICD0^"_BCSVI_"^"_$P($G(^ICD0(BCSVI,0)),U)_"^Lower Age^"
..W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U)_"^"_$P($G(^ICD0(BCSVI,9999999)),U)
.;Upper age
.I $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U,2)'=$P($G(^ICD0(BCSVI,9999999)),U,2) D
..W !,"ICD0^"_BCSVI_"^"_$P($G(^ICD0(BCSVI,0)),U)_"^Upper Age^"
..W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U,2)_"^"_$P($G(^ICD0(BCSVI,9999999)),U,2)
.;Date Added
.I $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U,4)'=$P($G(^ICD0(BCSVI,0)),U,12) D
..W !,"ICD0^"_BCSVI_"^"_$P($G(^ICD0(BCSVI,0)),U)_"^Date Added^"
..W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U,4)_"^"_$P($G(^ICD0(BCSVI,0)),U,12)
.;Description
.S BCSVODSC=$P($G(^BCSVTMP("BCSV-ICD0",BCSVI,1)),U)
.S BCSVMDT=$O(^ICD0(BCSVI,"B",9999999))
.I BCSVMDT'="" D
..S BCSVMIEN=$O(^ICD0(BCSVI,"B",BCSVMDT,0))
..S BCSVNDSC=$G(^ICD0(BCSVI,68,BCSVMIEN,1))
..I $$UPC^ABMERUTL($TR(BCSVODSC," "))'=$$UPC^ABMERUTL($TR(BCSVNDSC," ")) D
...W !,"ICD0^"_BCSVI_"^"_$P($G(^ICD0(BCSVI,0)),U)_"^Desc^"_BCSVODSC_"^"_BCSVNDSC
Q
CPTADDS ;
S BCSVI=0
S BCSVCNT=0
W !,"Look for additions to IHS:"
W !?5,"IEN",?25,"CPT"
F S BCSVI=$O(^ICPT(BCSVI)) Q:'BCSVI D
.S BCSVCNT=+$G(BCSVCNT)+1
.I '$D(^BCSVTMP("BCSV-CPT",BCSVI)) W !?5,BCSVI,?25,$P($G(^ICPT(BCSVI,0)),U)
Q
;
ICD0ADDS ;
S BCSVI=0
S BCSVCNT=0
W !,"ICD0s (PXs) in CSV that aren't in IHS:"
F S BCSVI=$O(^ICD0(BCSVI)) Q:'BCSVI D
.S BCSVCNT=+$G(BCSVCNT)+1
.I '$D(^BCSVTMP("BCSV-ICD0",BCSVI,0)) W !?5,BCSVI
W !,"ICD0: "_BCSVCNT
Q
ICD9ADDS ;
S BCSVI=0
S BCSVCNT=0
W !,"ICD9s (DXs) in CSV that aren't in IHS:"
F S BCSVI=$O(^ICD9(BCSVI)) Q:'BCSVI D
.S BCSVCNT=+$G(BCSVCNT)+1
.I '$D(^BCSVTMP("BCSV-ICD9",BCSVI,0)) W !?5,BCSVI
W !,"ICD9: "_BCSVCNT
;;
S BCSVI=0
Q
BCSVDQR ;IHS/SD/SDR - BCSV*1.0 install ; 12/21/2008 00:29
+1 ;;1.0;BCSV;;APR 23, 2010
+2 ;
PRECMRG ; EP - This tag should be run to get IHS data into a temp space to
+1 ; compare with later. If this isn't done, there won't be anything
+2 ; to compare to for the report.
CPT ;
+1 SET BCSVI=0
+2 SET BCSVCNT=0
+3 FOR
SET BCSVI=$ORDER(^ICPT(BCSVI))
IF 'BCSVI
QUIT
Begin DoDot:1
+4 MERGE ^BCSVTMP("BCSV-CPT",BCSVI)=^ICPT(BCSVI)
+5 SET BCSVCNT=+$GET(BCSVCNT)+1
End DoDot:1
+6 WRITE !,"CPT : "_BCSVCNT
ICD0 ;
+1 SET BCSVI=0
+2 SET BCSVCNT=0
+3 FOR
SET BCSVI=$ORDER(^ICD0(BCSVI))
IF 'BCSVI
QUIT
Begin DoDot:1
+4 MERGE ^BCSVTMP("BCSV-ICD0",BCSVI)=^ICD0(BCSVI)
+5 SET BCSVCNT=+$GET(BCSVCNT)+1
End DoDot:1
+6 WRITE !,"ICD0: "_BCSVCNT
ICD9 ;
+1 SET BCSVI=0
+2 SET BCSVCNT=0
+3 FOR
SET BCSVI=$ORDER(^ICD9(BCSVI))
IF 'BCSVI
QUIT
Begin DoDot:1
+4 MERGE ^BCSVTMP("BCSV-ICD9",BCSVI)=^ICD9(BCSVI)
+5 SET BCSVCNT=+$GET(BCSVCNT)+1
End DoDot:1
+6 WRITE !,"ICD9: "_BCSVCNT
+7 ;
+8 QUIT
+9 ;
PRECSV ; EP - Pre-Conversion Report
+1 DO PRECSV^BCSVDQR1
+2 QUIT
+3 ;
MAPCK ; EP - Map Check Report
+1 DO MAPCK^BCSVDQR1
+2 QUIT
+3 ;
POSTCSV ; EP - Post-Conversion Report
+1 SET BCSVANS=1
+2 IF +$$VERSION^XPDUTL("BCSV")<1
Begin DoDot:1
+3 KILL DIR,DIC,DIE,DA,X,Y
+4 SET DIR(0)="YA"
+5 SET DIR("A",1)="The Conversion is not 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 ;path
+13 KILL DIR,DIC,DIE,DA,X,Y
+14 SET DIR(0)="F^Ar"
+15 SET DIR("A")="Enter path"
+16 DO ^DIR
KILL DIR
+17 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT
+18 SET BCSVPATH=Y
+19 ;filename
+20 KILL DIR,DIC,DIE,DA,X,Y
+21 SET DIR(0)="F^Ar"
+22 SET DIR("A")="Enter filename"
+23 DO ^DIR
KILL DIR
+24 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT
+25 SET BCSVFNAM=Y
+26 ;
+27 DO OPEN^%ZISH("BCSVFILE",BCSVPATH,BCSVFNAM,"W")
+28 IF POP
QUIT
+29 USE IO(0)
WRITE !!,"Writing report...."
+30 USE IO
+31 DO NOW^%DTC
+32 SET Y=%
+33 DO DD^%DT
+34 WRITE !,"Report:-- POST-CONVERSION DATA QUALITY REPORT Date: ",Y
+35 WRITE !,"File:---- ",BCSVFNAM
+36 ;D CPTADDS ;counts and writes adds to IHS file
+37 ;D ICD0ADDS
+38 ;D ICD9ADDS
+39 WRITE !,"File^IEN^Code^field^IHS value^VA value"
+40 DO CPTDIFFS
+41 DO CMODDIFF
+42 DO ICD0DIFF
+43 DO ICD9DIFF
+44 DO CLOSE^%ZISH("BCSVFILE")
+45 QUIT
CPTDIFFS ;
+1 SET BCSVI=0
+2 FOR
SET BCSVI=$ORDER(^ICPT(BCSVI))
IF 'BCSVI
QUIT
Begin DoDot:1
+3 IF '$DATA(^BCSVTMP("BCSV-CPT",BCSVI,0))
WRITE !,"CPT^"_BCSVI_"^"_$PIECE($GET(^ICPT(BCSVI,0)),U)_"^Not found(IHS)"
QUIT
+4 ;
+5 IF $PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,3)'=$PIECE($GET(^ICPT(BCSVI,0)),U,3)
Begin DoDot:2
+6 WRITE !,"CPT^"_BCSVI_"^"_$PIECE($GET(^ICPT(BCSVI,0)),U)
+7 WRITE "^CPT Category^"
+8 WRITE $SELECT($PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,3)'="":$PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,3),1:"NONE")
+9 WRITE "^"_$PIECE($GET(^ICPT(BCSVI,0)),U,3)
End DoDot:2
+10 ;
+11 IF $PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,4)'=$PIECE($GET(^ICPT(BCSVI,0)),U,4)
Begin DoDot:2
+12 WRITE !,"CPT^"_BCSVI_"^"_$PIECE($GET(^ICPT(BCSVI,0)),U)
+13 WRITE "^Inactive Flag^"_$PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,4)_"^"_$PIECE($GET(^ICPT(BCSVI,0)),U,4)
End DoDot:2
+14 ;
+15 IF $PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,5)'=$PIECE($GET(^ICPT(BCSVI,9999999)),U,5)
Begin DoDot:2
+16 WRITE !,"CPT^"_BCSVI_"^"_$PIECE($GET(^ICPT(BCSVI,0)),U)
+17 WRITE "^ASC Pymt Grp^"_$PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,5)_"^"_$PIECE($GET(^ICPT(BCSVI,9999999)),U,5)
End DoDot:2
+18 ;
+19 IF $PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,6)'=$PIECE($GET(^ICPT(BCSVI,9999999)),U,6)
Begin DoDot:2
+20 WRITE !,"CPT^"_BCSVI_"^"_$PIECE($GET(^ICPT(BCSVI,0)),U)
+21 WRITE "^Dt Added^"_$PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,6)_"^"_$PIECE($GET(^ICPT(BCSVI,9999999)),U,6)
End DoDot:2
+22 ;
+23 IF $PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,7)'=$PIECE($GET(^ICPT(BCSVI,9999999)),U,7)
Begin DoDot:2
+24 WRITE !,"CPT^"_BCSVI_"^"_$PIECE($GET(^ICPT(BCSVI,0)),U)
+25 WRITE "^Dt Deleted^"_$PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,7)_"^"_$PIECE($GET(^ICPT(BCSVI,9999999)),U,7)
End DoDot:2
+26 ;
+27 IF $PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,9999999)),U,2)'=$PIECE($GET(^ICPT(BCSVI,9999999)),U,2)
Begin DoDot:2
+28 WRITE !,"CPT^"_BCSVI_"^"_$PIECE($GET(^ICPT(BCSVI,0)),U)
+29 WRITE "^Default Rev. Code^"
+30 WRITE $PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,9999999)),U,2)_"^"_$PIECE($GET(^ICPT(BCSVI,9999999)),U,2)
End DoDot:2
+31 ;
+32 ;short desc check
+33 SET BCSVMDT=9999999
+34 ;get most recent entry
SET BCSVMDT=$ORDER(^ICPT(BCSVI,61,"B",BCSVMDT),-1)
+35 IF BCSVMDT'=""
Begin DoDot:2
+36 SET BCSVMIEN=$ORDER(^ICPT(BCSVI,61,"B",BCSVMDT,0))
+37 IF BCSVMIEN=""
Begin DoDot:3
+38 WRITE !,"CPT^"_BCSVI_"^"_$PIECE($GET(^ICPT(BCSVI,0)),U)
+39 WRITE "^Short Desc^"_$PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,2)_"^NONE"
End DoDot:3
QUIT
+40 IF $$UPC^ABMERUTL($PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,2))'=$$UPC^ABMERUTL($PIECE($GET(^ICPT(BCSVI,61,BCSVMIEN,0)),U,2))
Begin DoDot:3
+41 WRITE !,"CPT^"_BCSVI_"^"_$PIECE($GET(^ICPT(BCSVI,0)),U)
+42 WRITE "^Short Desc^"_$PIECE($GET(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,2)_"^"_$PIECE($GET(^ICPT(BCSVI,61,BCSVMIEN,0)),U,2)
End DoDot:3
End DoDot:2
+43 ;
+44 ;desc check
+45 SET BCSVMDT=9999999
+46 SET BCSVODSC=""
+47 SET BCSVNDSC=""
+48 ;get most recent entry
SET BCSVMDT=$ORDER(^ICPT(BCSVI,62,"B",BCSVMDT),-1)
+49 IF BCSVMDT'=""
Begin DoDot:2
+50 SET BCSVDIEN=$ORDER(^ICPT(BCSVI,62,"B",BCSVMDT,0))
+51 SET BCSVMIEN=0
+52 FOR
SET BCSVMIEN=$ORDER(^ICPT(BCSVI,62,BCSVDIEN,1,BCSVMIEN))
IF 'BCSVMIEN
QUIT
Begin DoDot:3
+53 SET BCSVNDSC=BCSVNDSC_" "_$GET(^ICPT(BCSVI,62,BCSVDIEN,1,BCSVMIEN,0))
End DoDot:3
+54 SET BCSVMIEN=0
+55 FOR
SET BCSVMIEN=$ORDER(^BCSVTMP("BCSV-CPT",BCSVI,"D",BCSVMIEN))
IF 'BCSVMIEN
QUIT
Begin DoDot:3
+56 SET BCSVODSC=BCSVODSC_" "_$GET(^BCSVTMP("BCSV-CPT",BCSVI,"D",BCSVMIEN,0))
End DoDot:3
+57 IF $$UPC^ABMERUTL($TRANSLATE(BCSVNDSC," "))'=$$UPC^ABMERUTL($TRANSLATE(BCSVODSC," "))
Begin DoDot:3
+58 WRITE !,"CPT^"_BCSVI_"^"_$PIECE($GET(^ICPT(BCSVI,0)),U)_"^Desc^"_BCSVODSC_"^"_BCSVNDSC
End DoDot:3
End DoDot:2
+59 ;
End DoDot:1
+60 QUIT
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
ICD9DIFF ;
+1 SET BCSVI=0
+2 FOR
SET BCSVI=$ORDER(^ICD9(BCSVI))
IF 'BCSVI
QUIT
Begin DoDot:1
+3 IF '$DATA(^BCSVTMP("BCSV-ICD9",BCSVI,0))
WRITE !,"ICD9^"_BCSVI_"^"_$PIECE($GET(^ICD9(BCSVI,0)),U)_"^Not found(IHS)"
QUIT
+4 ;
+5 ;Identifier
+6 IF $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,2)'=$PIECE($GET(^ICD9(BCSVI,0)),U,2)
Begin DoDot:2
+7 WRITE !,"ICD9^"_BCSVI_"^"_$PIECE($GET(^ICD9(BCSVI,0)),U)_"^Identifer^"
+8 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,2)_"^"_$PIECE($GET(^ICD9(BCSVI,0)),U,2)
End DoDot:2
+9 ;Diagnosis
+10 SET BCSVMDT=9999999
+11 ;get most recent entry
SET BCSVMDT=$ORDER(^ICD9(BCSVI,67,"B",BCSVMDT),-1)
+12 IF BCSVMDT'=""
Begin DoDot:2
+13 SET BCSVMIEN=$ORDER(^ICD9(BCSVI,67,"B",BCSVMDT,0))
+14 IF BCSVMIEN=""
Begin DoDot:3
+15 WRITE !,"ICD9^"_BCSVI_"^"_$PIECE($GET(^ICD9(BCSVI,0)),U)
+16 WRITE "^Diagnosis^"_$PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,2)_"^NONE"
End DoDot:3
QUIT
+17 IF $$UPC^ABMERUTL($TRANSLATE($PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,3)," "))'=$$UPC^ABMERUTL($TRANSLATE($PIECE($GET(^ICD9(BCSVI,67,BCSVMIEN,0)),U,2)," "))
Begin DoDot:3
+18 WRITE !,"ICD9^"_BCSVI_"^"_$PIECE($GET(^ICD9(BCSVI,0)),U)_"^Diagnosis^"
+19 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,3)_"^"_$PIECE($GET(^ICD9(BCSVI,67,BCSVMIEN,0)),U,2)
End DoDot:3
End DoDot:2
+20 ;Inactive Flag
+21 IF $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,9)'=$PIECE($GET(^ICD9(BCSVI,0)),U,9)
Begin DoDot:2
+22 WRITE !,"ICD9^"_BCSVI_"^"_$PIECE($GET(^ICD9(BCSVI,0)),U)_"^Inactive Flag^"
+23 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,9)_"^"_$PIECE($GET(^ICD9(BCSVI,0)),U,9)
End DoDot:2
+24 ;Inactive Date
+25 IF $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,11)'=$PIECE($GET(^ICD9(BCSVI,0)),U,11)
Begin DoDot:2
+26 WRITE !,"ICD9^"_BCSVI_"^"_$PIECE($GET(^ICD9(BCSVI,0)),U)_"^Inactive Date^"
+27 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,11)_"^"_$PIECE($GET(^ICD9(BCSVI,0)),U,11)
End DoDot:2
+28 ;Lower age
+29 IF $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U)'=$PIECE($GET(^ICD9(BCSVI,0)),U,14)
Begin DoDot:2
+30 WRITE !,"ICD9^"_BCSVI_"^"_$PIECE($GET(^ICD9(BCSVI,0)),U)_"^Lower Age^"
+31 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U)_"^"_$PIECE($GET(^ICD9(BCSVI,0)),U,14)
End DoDot:2
+32 ;Upper age
+33 IF $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U,2)'=$PIECE($GET(^ICD9(BCSVI,0)),U,15)
Begin DoDot:2
+34 WRITE !,"ICD9^"_BCSVI_"^"_$PIECE($GET(^ICD9(BCSVI,0)),U)_"^Upper Age^"
+35 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U,2)_"^"_$PIECE($GET(^ICD9(BCSVI,0)),U,15)
End DoDot:2
+36 ;Date Added
+37 IF $PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U,4)'=$PIECE($GET(^ICD9(BCSVI,0)),U,16)
Begin DoDot:2
+38 WRITE !,"ICD9^"_BCSVI_"^"_$PIECE($GET(^ICD9(BCSVI,0)),U)
+39 WRITE "^Date Added^"_$PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U,4)_"^"_$PIECE($GET(^ICD9(BCSVI,0)),U,16)
End DoDot:2
+40 ;Description
+41 SET BCSVODSC=$PIECE($GET(^BCSVTMP("BCSV-ICD9",BCSVI,1)),U)
+42 SET BCSVMDT=$ORDER(^ICD9(BCSVI,"B",9999999))
+43 IF BCSVMDT'=""
Begin DoDot:2
+44 SET BCSVMIEN=$ORDER(^ICD9(BCSVI,"B",BCSVMDT,0))
+45 SET BCSVNDSC=$GET(^ICD9(BCSVI,68,BCSVMIEN,1))
+46 IF $$UPC^ABMERUTL($TRANSLATE(BCSVODSC," "))'=$$UPC^ABMERUTL($TRANSLATE(BCSVNDSC," "))
Begin DoDot:3
+47 WRITE !,"ICD9^"_BCSVI_"^"_$PIECE($GET(^ICD9(BCSVI,0)),U)_"^Desc^"_BCSVODSC_"^"_BCSVNDSC
End DoDot:3
End DoDot:2
End DoDot:1
+48 QUIT
+49 ;
ICD0DIFF ;
+1 SET BCSVI=0
+2 FOR
SET BCSVI=$ORDER(^ICD0(BCSVI))
IF 'BCSVI
QUIT
Begin DoDot:1
+3 IF '$DATA(^BCSVTMP("BCSV-ICD0",BCSVI,0))
WRITE !,"ICD0^"_BCSVI_"^"_$PIECE($GET(^ICD0(BCSVI,0)),U)_"^Not found(IHS)"
QUIT
+4 ;
+5 ;Identifier
+6 IF $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,2)'=$PIECE($GET(^ICD0(BCSVI,0)),U,2)
Begin DoDot:2
+7 WRITE !,"ICD0^"_BCSVI_"^"_$PIECE($GET(^ICD0(BCSVI,0)),U)_"^Identifer^"
+8 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,2)_"^"_$PIECE($GET(^ICD9(BCSVI,0)),U,2)
End DoDot:2
+9 ;Operation/Procedure
+10 SET BCSVMDT=9999999
+11 ;get most recent entry
SET BCSVMDT=$ORDER(^ICD0(BCSVI,67,"B",BCSVMDT),-1)
+12 IF BCSVMDT'=""
Begin DoDot:2
+13 SET BCSVMIEN=$ORDER(^ICD0(BCSVI,67,"B",BCSVMDT,0))
+14 IF BCSVMIEN=""
Begin DoDot:3
+15 WRITE !,"ICD0^"_BCSVI_"^"_$PIECE($GET(^ICD0(BCSVI,0)),U)_"^Diagnosis^"
+16 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,2)_"^NONE"
End DoDot:3
QUIT
+17 IF $$UPC^ABMERUTL($TRANSLATE($PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,4)," "))'=$$UPC^ABMERUTL($TRANSLATE($PIECE($GET(^ICD0(BCSVI,67,BCSVMIEN,0)),U,2)," "))
Begin DoDot:3
+18 WRITE !,"ICD0^"_BCSVI_"^"_$PIECE($GET(^ICD0(BCSVI,0)),U)_"^Diagnosis^"
+19 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,4)_"^"_$PIECE($GET(^ICD0(BCSVI,67,BCSVMIEN,0)),U,2)
End DoDot:3
End DoDot:2
+20 ;Inactive Flag
+21 IF $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,9)'=$PIECE($GET(^ICD0(BCSVI,0)),U,9)
Begin DoDot:2
+22 WRITE !,"ICD0^"_BCSVI_"^"_$PIECE($GET(^ICD0(BCSVI,0)),U)_"^Inactive Flag^"
+23 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,9)_"^"_$PIECE($GET(^ICD0(BCSVI,0)),U,9)
End DoDot:2
+24 ;Inactive Date
+25 IF $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,11)'=$PIECE($GET(^ICD0(BCSVI,0)),U,11)
Begin DoDot:2
+26 WRITE !,"ICD0^"_BCSVI_"^"_$PIECE($GET(^ICD0(BCSVI,0)),U)_"^Inactive Date^"
+27 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,11)_"^"_$PIECE($GET(^ICD0(BCSVI,0)),U,11)
End DoDot:2
+28 ;Lower age
+29 IF $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U)'=$PIECE($GET(^ICD0(BCSVI,9999999)),U)
Begin DoDot:2
+30 WRITE !,"ICD0^"_BCSVI_"^"_$PIECE($GET(^ICD0(BCSVI,0)),U)_"^Lower Age^"
+31 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U)_"^"_$PIECE($GET(^ICD0(BCSVI,9999999)),U)
End DoDot:2
+32 ;Upper age
+33 IF $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U,2)'=$PIECE($GET(^ICD0(BCSVI,9999999)),U,2)
Begin DoDot:2
+34 WRITE !,"ICD0^"_BCSVI_"^"_$PIECE($GET(^ICD0(BCSVI,0)),U)_"^Upper Age^"
+35 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U,2)_"^"_$PIECE($GET(^ICD0(BCSVI,9999999)),U,2)
End DoDot:2
+36 ;Date Added
+37 IF $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U,4)'=$PIECE($GET(^ICD0(BCSVI,0)),U,12)
Begin DoDot:2
+38 WRITE !,"ICD0^"_BCSVI_"^"_$PIECE($GET(^ICD0(BCSVI,0)),U)_"^Date Added^"
+39 WRITE $PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U,4)_"^"_$PIECE($GET(^ICD0(BCSVI,0)),U,12)
End DoDot:2
+40 ;Description
+41 SET BCSVODSC=$PIECE($GET(^BCSVTMP("BCSV-ICD0",BCSVI,1)),U)
+42 SET BCSVMDT=$ORDER(^ICD0(BCSVI,"B",9999999))
+43 IF BCSVMDT'=""
Begin DoDot:2
+44 SET BCSVMIEN=$ORDER(^ICD0(BCSVI,"B",BCSVMDT,0))
+45 SET BCSVNDSC=$GET(^ICD0(BCSVI,68,BCSVMIEN,1))
+46 IF $$UPC^ABMERUTL($TRANSLATE(BCSVODSC," "))'=$$UPC^ABMERUTL($TRANSLATE(BCSVNDSC," "))
Begin DoDot:3
+47 WRITE !,"ICD0^"_BCSVI_"^"_$PIECE($GET(^ICD0(BCSVI,0)),U)_"^Desc^"_BCSVODSC_"^"_BCSVNDSC
End DoDot:3
End DoDot:2
End DoDot:1
+48 QUIT
CPTADDS ;
+1 SET BCSVI=0
+2 SET BCSVCNT=0
+3 WRITE !,"Look for additions to IHS:"
+4 WRITE !?5,"IEN",?25,"CPT"
+5 FOR
SET BCSVI=$ORDER(^ICPT(BCSVI))
IF 'BCSVI
QUIT
Begin DoDot:1
+6 SET BCSVCNT=+$GET(BCSVCNT)+1
+7 IF '$DATA(^BCSVTMP("BCSV-CPT",BCSVI))
WRITE !?5,BCSVI,?25,$PIECE($GET(^ICPT(BCSVI,0)),U)
End DoDot:1
+8 QUIT
+9 ;
ICD0ADDS ;
+1 SET BCSVI=0
+2 SET BCSVCNT=0
+3 WRITE !,"ICD0s (PXs) in CSV that aren't in IHS:"
+4 FOR
SET BCSVI=$ORDER(^ICD0(BCSVI))
IF 'BCSVI
QUIT
Begin DoDot:1
+5 SET BCSVCNT=+$GET(BCSVCNT)+1
+6 IF '$DATA(^BCSVTMP("BCSV-ICD0",BCSVI,0))
WRITE !?5,BCSVI
End DoDot:1
+7 WRITE !,"ICD0: "_BCSVCNT
+8 QUIT
ICD9ADDS ;
+1 SET BCSVI=0
+2 SET BCSVCNT=0
+3 WRITE !,"ICD9s (DXs) in CSV that aren't in IHS:"
+4 FOR
SET BCSVI=$ORDER(^ICD9(BCSVI))
IF 'BCSVI
QUIT
Begin DoDot:1
+5 SET BCSVCNT=+$GET(BCSVCNT)+1
+6 IF '$DATA(^BCSVTMP("BCSV-ICD9",BCSVI,0))
WRITE !?5,BCSVI
End DoDot:1
+7 WRITE !,"ICD9: "_BCSVCNT
+8 ;;
+9 SET BCSVI=0
+10 QUIT
