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

BCSVDQR.m

Go to the documentation of this file. 
  1. BCSVDQR ;IHS/SD/SDR - BCSV*1.0 install ; 12/21/2008 00:29
  1.  ;;1.0;BCSV;;APR 23, 2010
  1.  ;
  1. 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
  1.  ; to compare to for the report.
  1. CPT ;
  1.  S BCSVI=0
  1.  S BCSVCNT=0
  1.  F  S BCSVI=$O(^ICPT(BCSVI)) Q:'BCSVI  D
  1.  .M ^BCSVTMP("BCSV-CPT",BCSVI)=^ICPT(BCSVI)
  1.  .S BCSVCNT=+$G(BCSVCNT)+1
  1.  W !,"CPT : "_BCSVCNT
  1. ICD0 ;
  1.  S BCSVI=0
  1.  S BCSVCNT=0
  1.  F  S BCSVI=$O(^ICD0(BCSVI)) Q:'BCSVI  D
  1.  .M ^BCSVTMP("BCSV-ICD0",BCSVI)=^ICD0(BCSVI)
  1.  .S BCSVCNT=+$G(BCSVCNT)+1
  1.  W !,"ICD0: "_BCSVCNT
  1. ICD9 ;
  1.  S BCSVI=0
  1.  S BCSVCNT=0
  1.  F  S BCSVI=$O(^ICD9(BCSVI)) Q:'BCSVI  D
  1.  .M ^BCSVTMP("BCSV-ICD9",BCSVI)=^ICD9(BCSVI)
  1.  .S BCSVCNT=+$G(BCSVCNT)+1
  1.  W !,"ICD9: "_BCSVCNT
  1.  ;
  1.  Q
  1.  ;
  1. PRECSV ; EP - Pre-Conversion Report
  1.  D PRECSV^BCSVDQR1
  1.  Q
  1.  ;
  1. MAPCK ; EP - Map Check Report
  1.  D MAPCK^BCSVDQR1
  1.  Q
  1.  ;
  1. POSTCSV ; EP - Post-Conversion Report
  1.  S BCSVANS=1
  1.  I +$$VERSION^XPDUTL("BCSV")<1 D
  1.  .K DIR,DIC,DIE,DA,X,Y
  1.  .S DIR(0)="YA"
  1.  .S DIR("A",1)="The Conversion is not complete at this time so the data reported"
  1.  .S DIR("A",2)="may be inaccurate."
  1.  .S DIR("A")="Are you sure you want to run this report? "
  1.  .S DIR("B")="N"
  1.  .D ^DIR K DIR
  1.  .S BCSVANS=+Y
  1.  Q:BCSVANS'=1  ;they exited out of report
  1.  ;path
  1.  K DIR,DIC,DIE,DA,X,Y
  1.  S DIR(0)="F^Ar"
  1.  S DIR("A")="Enter path"
  1.  D ^DIR K DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
  1.  S BCSVPATH=Y
  1.  ;filename
  1.  K DIR,DIC,DIE,DA,X,Y
  1.  S DIR(0)="F^Ar"
  1.  S DIR("A")="Enter filename"
  1.  D ^DIR K DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)
  1.  S BCSVFNAM=Y
  1.  ;
  1.  D OPEN^%ZISH("BCSVFILE",BCSVPATH,BCSVFNAM,"W")
  1.  Q:POP
  1.  U IO(0) W !!,"Writing report...."
  1.  U IO
  1.  D NOW^%DTC
  1.  S Y=%
  1.  D DD^%DT
  1.  W !,"Report:-- POST-CONVERSION DATA QUALITY REPORT  Date: ",Y
  1.  W !,"File:---- ",BCSVFNAM
  1.  ;D CPTADDS  ;counts and writes adds to IHS file
  1.  ;D ICD0ADDS
  1.  ;D ICD9ADDS
  1.  W !,"File^IEN^Code^field^IHS value^VA value"
  1.  D CPTDIFFS
  1.  D CMODDIFF
  1.  D ICD0DIFF
  1.  D ICD9DIFF
  1.  D CLOSE^%ZISH("BCSVFILE")
  1.  Q
  1. CPTDIFFS ;
  1.  S BCSVI=0
  1.  F  S BCSVI=$O(^ICPT(BCSVI)) Q:'BCSVI  D
  1.  .I '$D(^BCSVTMP("BCSV-CPT",BCSVI,0)) W !,"CPT^"_BCSVI_"^"_$P($G(^ICPT(BCSVI,0)),U)_"^Not found(IHS)" Q
  1.  .;
  1.  .I $P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,3)'=$P($G(^ICPT(BCSVI,0)),U,3) D
  1.  ..W !,"CPT^"_BCSVI_"^"_$P($G(^ICPT(BCSVI,0)),U)
  1.  ..W "^CPT Category^"
  1.  ..W $S($P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,3)'="":$P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,3),1:"NONE")
  1.  ..W "^"_$P($G(^ICPT(BCSVI,0)),U,3)
  1.  .;
  1.  .I $P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,4)'=$P($G(^ICPT(BCSVI,0)),U,4) D
  1.  ..W !,"CPT^"_BCSVI_"^"_$P($G(^ICPT(BCSVI,0)),U)
  1.  ..W "^Inactive Flag^"_$P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,4)_"^"_$P($G(^ICPT(BCSVI,0)),U,4)
  1.  .;
  1.  .I $P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,5)'=$P($G(^ICPT(BCSVI,9999999)),U,5) D
  1.  ..W !,"CPT^"_BCSVI_"^"_$P($G(^ICPT(BCSVI,0)),U)
  1.  ..W "^ASC Pymt Grp^"_$P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,5)_"^"_$P($G(^ICPT(BCSVI,9999999)),U,5)
  1.  .;
  1.  .I $P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,6)'=$P($G(^ICPT(BCSVI,9999999)),U,6) D
  1.  ..W !,"CPT^"_BCSVI_"^"_$P($G(^ICPT(BCSVI,0)),U)
  1.  ..W "^Dt Added^"_$P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,6)_"^"_$P($G(^ICPT(BCSVI,9999999)),U,6)
  1.  .;
  1.  .I $P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,7)'=$P($G(^ICPT(BCSVI,9999999)),U,7) D
  1.  ..W !,"CPT^"_BCSVI_"^"_$P($G(^ICPT(BCSVI,0)),U)
  1.  ..W "^Dt Deleted^"_$P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,7)_"^"_$P($G(^ICPT(BCSVI,9999999)),U,7)
  1.  .;
  1.  .I $P($G(^BCSVTMP("BCSV-CPT",BCSVI,9999999)),U,2)'=$P($G(^ICPT(BCSVI,9999999)),U,2) D
  1.  ..W !,"CPT^"_BCSVI_"^"_$P($G(^ICPT(BCSVI,0)),U)
  1.  ..W "^Default Rev. Code^"
  1.  ..W $P($G(^BCSVTMP("BCSV-CPT",BCSVI,9999999)),U,2)_"^"_$P($G(^ICPT(BCSVI,9999999)),U,2)
  1.  .;
  1.  .;short desc check
  1.  .S BCSVMDT=9999999
  1.  .S BCSVMDT=$O(^ICPT(BCSVI,61,"B",BCSVMDT),-1)  ;get most recent entry
  1.  .I BCSVMDT'="" D
  1.  ..S BCSVMIEN=$O(^ICPT(BCSVI,61,"B",BCSVMDT,0))
  1.  ..I BCSVMIEN="" D  Q
  1.  ...W !,"CPT^"_BCSVI_"^"_$P($G(^ICPT(BCSVI,0)),U)
  1.  ...W "^Short Desc^"_$P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,2)_"^NONE"
  1.  ..I $$UPC^ABMERUTL($P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,2))'=$$UPC^ABMERUTL($P($G(^ICPT(BCSVI,61,BCSVMIEN,0)),U,2)) D
  1.  ...W !,"CPT^"_BCSVI_"^"_$P($G(^ICPT(BCSVI,0)),U)
  1.  ...W "^Short Desc^"_$P($G(^BCSVTMP("BCSV-CPT",BCSVI,0)),U,2)_"^"_$P($G(^ICPT(BCSVI,61,BCSVMIEN,0)),U,2)
  1.  .;
  1.  .;desc check
  1.  .S BCSVMDT=9999999
  1.  .S BCSVODSC=""
  1.  .S BCSVNDSC=""
  1.  .S BCSVMDT=$O(^ICPT(BCSVI,62,"B",BCSVMDT),-1)  ;get most recent entry
  1.  .I BCSVMDT'="" D
  1.  ..S BCSVDIEN=$O(^ICPT(BCSVI,62,"B",BCSVMDT,0))
  1.  ..S BCSVMIEN=0
  1.  ..F  S BCSVMIEN=$O(^ICPT(BCSVI,62,BCSVDIEN,1,BCSVMIEN)) Q:'BCSVMIEN  D
  1.  ...S BCSVNDSC=BCSVNDSC_" "_$G(^ICPT(BCSVI,62,BCSVDIEN,1,BCSVMIEN,0))
  1.  ..S BCSVMIEN=0
  1.  ..F  S BCSVMIEN=$O(^BCSVTMP("BCSV-CPT",BCSVI,"D",BCSVMIEN)) Q:'BCSVMIEN  D
  1.  ...S BCSVODSC=BCSVODSC_" "_$G(^BCSVTMP("BCSV-CPT",BCSVI,"D",BCSVMIEN,0))
  1.  ..I $$UPC^ABMERUTL($TR(BCSVNDSC," "))'=$$UPC^ABMERUTL($TR(BCSVODSC," ")) D
  1.  ...W !,"CPT^"_BCSVI_"^"_$P($G(^ICPT(BCSVI,0)),U)_"^Desc^"_BCSVODSC_"^"_BCSVNDSC
  1.  .;
  1.  Q
  1. CMODDIFF ;
  1.  S BCSVI=0
  1.  F  S BCSVI=$O(^DIC(81.3,BCSVI)) Q:'BCSVI  D
  1.  .S BCSVCD=$P($G(^DIC(81.3,BCSVI,0)),U)
  1.  .I '$D(^AUTTCMOD("B",BCSVCD)) W !,"CPT MOD^"_BCSVI_"^^Not found (IHS)" Q
  1.  ;;THIS CODE IS NOT COMPLETE.  NEED CLARIFICATION ON ONE-TO-MANY ISSUE
  1.  ;;VA has multiple entries for some code while IHS only has one
  1.  Q
  1. ICD9DIFF ;
  1.  S BCSVI=0
  1.  F  S BCSVI=$O(^ICD9(BCSVI)) Q:'BCSVI  D
  1.  .I '$D(^BCSVTMP("BCSV-ICD9",BCSVI,0)) W !,"ICD9^"_BCSVI_"^"_$P($G(^ICD9(BCSVI,0)),U)_"^Not found(IHS)" Q
  1.  .;
  1.  .;Identifier
  1.  .I $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,2)'=$P($G(^ICD9(BCSVI,0)),U,2) D
  1.  ..W !,"ICD9^"_BCSVI_"^"_$P($G(^ICD9(BCSVI,0)),U)_"^Identifer^"
  1.  ..W $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,2)_"^"_$P($G(^ICD9(BCSVI,0)),U,2)
  1.  .;Diagnosis
  1.  .S BCSVMDT=9999999
  1.  .S BCSVMDT=$O(^ICD9(BCSVI,67,"B",BCSVMDT),-1)  ;get most recent entry
  1.  .I BCSVMDT'="" D
  1.  ..S BCSVMIEN=$O(^ICD9(BCSVI,67,"B",BCSVMDT,0))
  1.  ..I BCSVMIEN="" D  Q
  1.  ...W !,"ICD9^"_BCSVI_"^"_$P($G(^ICD9(BCSVI,0)),U)
  1.  ...W "^Diagnosis^"_$P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,2)_"^NONE"
  1.  ..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
  1.  ...W !,"ICD9^"_BCSVI_"^"_$P($G(^ICD9(BCSVI,0)),U)_"^Diagnosis^"
  1.  ...W $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,3)_"^"_$P($G(^ICD9(BCSVI,67,BCSVMIEN,0)),U,2)
  1.  .;Inactive Flag
  1.  .I $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,9)'=$P($G(^ICD9(BCSVI,0)),U,9) D
  1.  ..W !,"ICD9^"_BCSVI_"^"_$P($G(^ICD9(BCSVI,0)),U)_"^Inactive Flag^"
  1.  ..W $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,9)_"^"_$P($G(^ICD9(BCSVI,0)),U,9)
  1.  .;Inactive Date
  1.  .I $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,11)'=$P($G(^ICD9(BCSVI,0)),U,11) D
  1.  ..W !,"ICD9^"_BCSVI_"^"_$P($G(^ICD9(BCSVI,0)),U)_"^Inactive Date^"
  1.  ..W $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,0)),U,11)_"^"_$P($G(^ICD9(BCSVI,0)),U,11)
  1.  .;Lower age
  1.  .I $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U)'=$P($G(^ICD9(BCSVI,0)),U,14) D
  1.  ..W !,"ICD9^"_BCSVI_"^"_$P($G(^ICD9(BCSVI,0)),U)_"^Lower Age^"
  1.  ..W $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U)_"^"_$P($G(^ICD9(BCSVI,0)),U,14)
  1.  .;Upper age
  1.  .I $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U,2)'=$P($G(^ICD9(BCSVI,0)),U,15) D
  1.  ..W !,"ICD9^"_BCSVI_"^"_$P($G(^ICD9(BCSVI,0)),U)_"^Upper Age^"
  1.  ..W $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U,2)_"^"_$P($G(^ICD9(BCSVI,0)),U,15)
  1.  .;Date Added
  1.  .I $P($G(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U,4)'=$P($G(^ICD9(BCSVI,0)),U,16) D
  1.  ..W !,"ICD9^"_BCSVI_"^"_$P($G(^ICD9(BCSVI,0)),U)
  1.  ..W "^Date Added^"_$P($G(^BCSVTMP("BCSV-ICD9",BCSVI,9999999)),U,4)_"^"_$P($G(^ICD9(BCSVI,0)),U,16)
  1.  .;Description
  1.  .S BCSVODSC=$P($G(^BCSVTMP("BCSV-ICD9",BCSVI,1)),U)
  1.  .S BCSVMDT=$O(^ICD9(BCSVI,"B",9999999))
  1.  .I BCSVMDT'="" D
  1.  ..S BCSVMIEN=$O(^ICD9(BCSVI,"B",BCSVMDT,0))
  1.  ..S BCSVNDSC=$G(^ICD9(BCSVI,68,BCSVMIEN,1))
  1.  ..I $$UPC^ABMERUTL($TR(BCSVODSC," "))'=$$UPC^ABMERUTL($TR(BCSVNDSC," ")) D
  1.  ...W !,"ICD9^"_BCSVI_"^"_$P($G(^ICD9(BCSVI,0)),U)_"^Desc^"_BCSVODSC_"^"_BCSVNDSC
  1.  Q
  1.  ;
  1. ICD0DIFF ;
  1.  S BCSVI=0
  1.  F  S BCSVI=$O(^ICD0(BCSVI)) Q:'BCSVI  D
  1.  .I '$D(^BCSVTMP("BCSV-ICD0",BCSVI,0)) W !,"ICD0^"_BCSVI_"^"_$P($G(^ICD0(BCSVI,0)),U)_"^Not found(IHS)" Q
  1.  .;
  1.  .;Identifier
  1.  .I $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,2)'=$P($G(^ICD0(BCSVI,0)),U,2) D
  1.  ..W !,"ICD0^"_BCSVI_"^"_$P($G(^ICD0(BCSVI,0)),U)_"^Identifer^"
  1.  ..W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,2)_"^"_$P($G(^ICD9(BCSVI,0)),U,2)
  1.  .;Operation/Procedure
  1.  .S BCSVMDT=9999999
  1.  .S BCSVMDT=$O(^ICD0(BCSVI,67,"B",BCSVMDT),-1)  ;get most recent entry
  1.  .I BCSVMDT'="" D
  1.  ..S BCSVMIEN=$O(^ICD0(BCSVI,67,"B",BCSVMDT,0))
  1.  ..I BCSVMIEN="" D  Q
  1.  ...W !,"ICD0^"_BCSVI_"^"_$P($G(^ICD0(BCSVI,0)),U)_"^Diagnosis^"
  1.  ...W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,2)_"^NONE"
  1.  ..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
  1.  ...W !,"ICD0^"_BCSVI_"^"_$P($G(^ICD0(BCSVI,0)),U)_"^Diagnosis^"
  1.  ...W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,4)_"^"_$P($G(^ICD0(BCSVI,67,BCSVMIEN,0)),U,2)
  1.  .;Inactive Flag
  1.  .I $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,9)'=$P($G(^ICD0(BCSVI,0)),U,9) D
  1.  ..W !,"ICD0^"_BCSVI_"^"_$P($G(^ICD0(BCSVI,0)),U)_"^Inactive Flag^"
  1.  ..W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,9)_"^"_$P($G(^ICD0(BCSVI,0)),U,9)
  1.  .;Inactive Date
  1.  .I $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,11)'=$P($G(^ICD0(BCSVI,0)),U,11) D
  1.  ..W !,"ICD0^"_BCSVI_"^"_$P($G(^ICD0(BCSVI,0)),U)_"^Inactive Date^"
  1.  ..W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,0)),U,11)_"^"_$P($G(^ICD0(BCSVI,0)),U,11)
  1.  .;Lower age
  1.  .I $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U)'=$P($G(^ICD0(BCSVI,9999999)),U) D
  1.  ..W !,"ICD0^"_BCSVI_"^"_$P($G(^ICD0(BCSVI,0)),U)_"^Lower Age^"
  1.  ..W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U)_"^"_$P($G(^ICD0(BCSVI,9999999)),U)
  1.  .;Upper age
  1.  .I $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U,2)'=$P($G(^ICD0(BCSVI,9999999)),U,2) D
  1.  ..W !,"ICD0^"_BCSVI_"^"_$P($G(^ICD0(BCSVI,0)),U)_"^Upper Age^"
  1.  ..W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U,2)_"^"_$P($G(^ICD0(BCSVI,9999999)),U,2)
  1.  .;Date Added
  1.  .I $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U,4)'=$P($G(^ICD0(BCSVI,0)),U,12) D
  1.  ..W !,"ICD0^"_BCSVI_"^"_$P($G(^ICD0(BCSVI,0)),U)_"^Date Added^"
  1.  ..W $P($G(^BCSVTMP("BCSV-ICD0",BCSVI,9999999)),U,4)_"^"_$P($G(^ICD0(BCSVI,0)),U,12)
  1.  .;Description
  1.  .S BCSVODSC=$P($G(^BCSVTMP("BCSV-ICD0",BCSVI,1)),U)
  1.  .S BCSVMDT=$O(^ICD0(BCSVI,"B",9999999))
  1.  .I BCSVMDT'="" D
  1.  ..S BCSVMIEN=$O(^ICD0(BCSVI,"B",BCSVMDT,0))
  1.  ..S BCSVNDSC=$G(^ICD0(BCSVI,68,BCSVMIEN,1))
  1.  ..I $$UPC^ABMERUTL($TR(BCSVODSC," "))'=$$UPC^ABMERUTL($TR(BCSVNDSC," ")) D
  1.  ...W !,"ICD0^"_BCSVI_"^"_$P($G(^ICD0(BCSVI,0)),U)_"^Desc^"_BCSVODSC_"^"_BCSVNDSC
  1.  Q
  1. CPTADDS ;
  1.  S BCSVI=0
  1.  S BCSVCNT=0
  1.  W !,"Look for additions to IHS:"
  1.  W !?5,"IEN",?25,"CPT"
  1.  F  S BCSVI=$O(^ICPT(BCSVI)) Q:'BCSVI  D
  1.  .S BCSVCNT=+$G(BCSVCNT)+1
  1.  .I '$D(^BCSVTMP("BCSV-CPT",BCSVI)) W !?5,BCSVI,?25,$P($G(^ICPT(BCSVI,0)),U)
  1.  Q
  1.  ;
  1. ICD0ADDS ;
  1.  S BCSVI=0
  1.  S BCSVCNT=0
  1.  W !,"ICD0s (PXs) in CSV that aren't in IHS:"
  1.  F  S BCSVI=$O(^ICD0(BCSVI)) Q:'BCSVI  D
  1.  .S BCSVCNT=+$G(BCSVCNT)+1
  1.  .I '$D(^BCSVTMP("BCSV-ICD0",BCSVI,0)) W !?5,BCSVI
  1.  W !,"ICD0: "_BCSVCNT
  1.  Q
  1. ICD9ADDS ;
  1.  S BCSVI=0
  1.  S BCSVCNT=0
  1.  W !,"ICD9s (DXs) in CSV that aren't in IHS:"
  1.  F  S BCSVI=$O(^ICD9(BCSVI)) Q:'BCSVI  D
  1.  .S BCSVCNT=+$G(BCSVCNT)+1
  1.  .I '$D(^BCSVTMP("BCSV-ICD9",BCSVI,0)) W !?5,BCSVI
  1.  W !,"ICD9: "_BCSVCNT
  1.  ;;
  1.  S BCSVI=0
  1.  Q