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

BCSVMD.m

Go to the documentation of this file. 
  1. BCSVMD ;IHS/CIA/BWF - CSV Phase One Management of Data ;16-Apr-2010 09:58;JSH
  1.  ;;1.0;BCSV;;APR 23, 2010;Build 44
  1.  ;=================================================================
  1.  Q
  1. INIT ;
  1.  S DLM="|",DDLM=";;"
  1.  Q
  1. GET ;EP
  1.  ; Gather data from fields that are to be moved and store for later use.\
  1.  ; Variable XREFS is used for multiple fields that have a file level xref that needs to be re-indexed.
  1.  ; Single fields with x-refs will be handled by file manager upon calling FILE^DIE
  1.  N QUIT,I,LINE,DATA,IHSFILE,IHSFLD,IHSROOT,VAFILE,VAFLD,AUMCSV,AUMDATA,DATAROOT,DEL,GLOBNODE,IHSDATA,MULT,NIHSFILE,DLM,DDLM
  1.  D INIT
  1.  S QUIT=0
  1.  F I=1:1  D  Q:QUIT
  1.  .S MULT=0
  1.  .S LINE=$T(FLDLST+I)
  1.  .S DATA=$P(LINE,DDLM,2)
  1.  .I DATA="Q"!(DATA="") S QUIT=1 Q
  1.  .S IHSFILE=$P(DATA,DLM),OIHSFLD=$P(DATA,DLM,2),NIHSFLD=$P(DATA,DLM,3),NIHSFILE=$P(DATA,DLM,4),DEL=$P(DATA,DLM,5),XREFS=$P(DATA,DLM,6)
  1.  .I IHSFILE=""!(OIHSFLD="") S QUIT=1 Q
  1.  .; Quit if the field does not exist. This is done so filemanger will not look for fields that do not exist in site.
  1.  .I '$D(^DD(IHSFILE,OIHSFLD)) Q
  1.  .I NIHSFLD="",DEL'="D" Q
  1.  .D FIELD^DID(IHSFILE,OIHSFLD,"N","GLOBAL SUBSCRIPT LOCATION;MULTIPLE-VALUED","AUMDATA")
  1.  .I $G(AUMDATA("MULTIPLE-VALUED"))=1 S MULT=1
  1.  .S IHSROOT=$$ROOT^DILFD(IHSFILE)
  1.  .S LOOPSTR=IHSROOT_"AUMCSV)"
  1.  .S AUMCSV=0
  1.  .F  S AUMCSV=$O(@LOOPSTR) Q:'AUMCSV  D
  1.  ..I MULT D  Q
  1.  ...S GLOBNODE=$P(AUMDATA("GLOBAL SUBSCRIPT LOCATION"),";")
  1.  ...I 'GLOBNODE S GLOBNODE=""""_GLOBNODE_""""
  1.  ...S DATAROOT=IHSROOT_AUMCSV_","_GLOBNODE_")"
  1.  ...I DEL="D" K @DATAROOT Q
  1.  ...S ^XTMP("AUMCSVMD","I",IHSFILE,NIHSFLD,AUMCSV,"MULT")=""
  1.  ...S ^XTMP("AUMCSVMD","I",IHSFILE,NIHSFLD,AUMCSV,"XREFS")=XREFS
  1.  ...M ^XTMP("AUMCSVMD",IHSFILE,NIHSFLD,AUMCSV)=@DATAROOT
  1.  ...I DEL'="SD" K @DATAROOT
  1.  ..I DEL="D" S FDA(IHSFILE,AUMCSV,OIHSFLD)="" D FILE^DIE(,"FDA") K FDA Q
  1.  ..S IHSDATA=$$GET1^DIQ(IHSFILE,AUMCSV,OIHSFLD,"I")
  1.  ..S FDA(IHSFILE,AUMCSV_",",OIHSFLD)="" D FILE^DIE(,"FDA") K FDA
  1.  ..I NIHSFILE'="" S ^XTMP("AUMCSVMD",NIHSFILE,NIHSFLD,AUMCSV)=IHSDATA Q
  1.  ..S ^XTMP("AUMCSVMD",IHSFILE,NIHSFLD,AUMCSV)=IHSDATA
  1.  ..I DEL'="SD" S FDA(IHSFILE,AUMCSV,OIHSFLD)="" D FILE^DIE(,"FDA") K FDA
  1.  D DELDUM,ICDSET,CALDELDD
  1.  K QUIT,I,LINE,DATA,IHSFILE,NIHSFLD,OIHSFLD,IHSROOT
  1.  Q
  1. PUT ;
  1.  ; Put the data back into the correct field(s)
  1.  N IHSFILE,NEWFLD,IEN,CNT,SUBSCRPT,ROOT,FLDDATA,FL,XREF,NEWLOC
  1.  M ^DIC(81.3)=^AUTTCMOD
  1.  S IHSFILE=0
  1.  F  S IHSFILE=$O(^XTMP("AUMCSVMD",IHSFILE)) Q:'IHSFILE  D
  1.  .S NEWFLD=0
  1.  .F  S NEWFLD=$O(^XTMP("AUMCSVMD",IHSFILE,NEWFLD)) Q:'NEWFLD  D
  1.  ..S IEN=0,CNT=0
  1.  ..F  S IEN=$O(^XTMP("AUMCSVMD",IHSFILE,NEWFLD,IEN)) Q:'IEN  D
  1.  ...I $D(^XTMP("AUMCSVMD","I",IHSFILE,NEWFLD,IEN,"MULT")) D  Q
  1.  ....S QUIT=0
  1.  ....S XREFS=$G(^XTMP("AUMCSVMD","I",IHSFILE,NEWFLD,IEN,"XREFS"))
  1.  ....D FIELD^DID(IHSFILE,NEWFLD,"N","GLOBAL SUBSCRIPT LOCATION","NEWLOC")
  1.  ....S SUBSCRPT=$G(NEWLOC("GLOBAL SUBSCRIPT LOCATION")) Q:SUBSCRPT=""
  1.  ....S SUBSCRPT=$P(SUBSCRPT,";"),SUBSCRPT=$C(34)_SUBSCRPT_$C(34)
  1.  ....S ROOT=$$ROOT^DILFD(IHSFILE)_IEN_","_SUBSCRPT_")"
  1.  ....M @ROOT=^XTMP("AUMCSVMD",IHSFILE,NEWFLD,IEN)
  1.  ....Q:XREFS=""
  1.  ....S DIK=$P(ROOT,")")_","
  1.  ....F J=1:1 D  Q:QUIT
  1.  .....S XREF=$P(XREFS,",",J)
  1.  .....I XREF="" S QUIT=1 Q
  1.  .....S DIK(1)=NEWFLD_"^"_XREF D ENALL^DIK
  1.  ...S FLDDATA=$G(^XTMP("AUMCSVMD",IHSFILE,NEWFLD,IEN))
  1.  ...S ROOT=$$ROOT^DILFD(IHSFILE)_IEN_")"
  1.  ...S FDA(IHSFILE,IEN_",",NEWFLD)=$G(FLDDATA) D FILE^DIE(,"FDA") K FDA
  1.  I $D(FDA) D FILE^DIE(,"FDA") K FDA
  1.  F FL=80,80.1,80.2,80.3,81,81.1,81.3 D
  1.  .S ^DD(FL,.01,"DEL",.01,0)="I 1"
  1.  Q
  1. SNCFLDS ;
  1.  ; Synchronization of data for new fields added to IHS dictionaries
  1.  N QUIT,I,LINE,FILE,FLDLST,TRGT,XREFS,FILE,FIELD,ROOT,LOOPSTR,IEN,JQUIT,FIELD,MULT,DLM,DDLM
  1.  N VERINFO
  1.  D INIT
  1.  D UPDCODES^BCSVUT ; Moved to insure all data items are brought in before attempting to update the data
  1.  S QUIT=0
  1.  F I=1:1 D  Q:QUIT
  1.  .S LINE=$$READ("IMPORT",I)
  1.  .I LINE="Q"!(LINE="") S QUIT=1 Q
  1.  .S FILE=$P(LINE,DLM)
  1.  .S FLDLST=$P(LINE,DLM,2)
  1.  .S TRGT=$P(LINE,DLM,3) I TRGT["(" S TRGT=$TR(TRGT,"(","|")
  1.  .S XREFS=$P(LINE,DLM,4)
  1.  .I FILE=""!(FLDLST="") S QUIT=1 Q
  1.  .I XREFS'="" D XREFS(XREFS)
  1.  .S ROOT=$$ROOT^DILFD(FILE)
  1.  .S LOOPSTR=ROOT_"IEN)"
  1.  .S IEN=0
  1.  .F  S IEN=$O(@LOOPSTR) Q:'IEN  D
  1.  ..I $D(^XCSV(TRGT,"MAP","Z",IEN)) Q
  1.  ..I FILE=80,$$GET1^DIQ(80,IEN,.01,"E")=.9999 S FUNC="VER"_$TR(FILE,".",""),INACT=1 D VERSION^BCSVUT(IEN,FUNC,INACT) Q
  1.  ..I FILE=80.1,$$GET1^DIQ(80.1,IEN,.01,"E")=333333 S FUNC="VER"_$TR(FILE,".","") D VERSION^BCSVUT(IEN,FUNC) Q
  1.  ..I '$D(^XCSV(TRGT,"MAP",IEN)) Q
  1.  ..S MAPIEN=$P(^XCSV(TRGT,"MAP",IEN),"^",1)
  1.  ..S JQUIT=0
  1.  ..F J=1:1  D  Q:JQUIT
  1.  ...S FIELD=$P(FLDLST,";",J) I FIELD="" S JQUIT=1 Q
  1.  ...; If the field is in a subfile, use the appropriate logic to get the data from ^XCSV and set into IHS files
  1.  ...D FIELD^DID(FILE,FIELD,"N","MULTIPLE-VALUED","MULT")
  1.  ...I $G(MULT("MULTIPLE-VALUED"))=1 D MULT(FILE,FIELD,TRGT,IEN,XREFS,MAPIEN) Q
  1.  ...; If the field is not in a subfile, use the single field logic.
  1.  ...D SINGLE(FILE,FIELD,TRGT,IEN,MAPIEN)
  1.  Q
  1. SNCFLDS2 ;
  1.  ; Synchronization of data for new fields added to IHS dictionaries
  1.  N QUIT,I,LINE,FILE,FLDLST,TRGT,XREFS,FILE,FIELD,ROOT,LOOPSTR,IEN,JQUIT,FIELD,DLM,DDLM,FUNC,J
  1.  D INIT
  1.  S QUIT=0
  1.  F I=1:1 D  Q:QUIT
  1.  .S LINE=$$READ("UPDATE",I)
  1.  .I LINE="Q"!(LINE="") S QUIT=1 Q
  1.  .S FILE=$P(LINE,DLM)
  1.  .S FLDLST=$P(LINE,DLM,2)
  1.  .S TRGT=$P(LINE,DLM,3) I TRGT["(" S TRGT=$TR(TRGT,"(","|")
  1.  .I '$D(^XCSV("ICD9","REVMAP")) D INDEX
  1.  .S XREFS=$P(LINE,DLM,4)
  1.  .S FUNC=$P(LINE,DLM,5)
  1.  .I FILE=""!(FLDLST="") S QUIT=1 Q
  1.  .I XREFS'="" D XREFS(XREFS)
  1.  .S ROOT=$$ROOT^DILFD(FILE)
  1.  .S LOOPSTR=ROOT_"IEN)"
  1.  .S IEN=0
  1.  .F  S IEN=$O(@LOOPSTR) Q:'IEN  D
  1.  ..I $D(^XCSV(TRGT,"MAP","Z",IEN)) Q
  1.  ..I FILE=80,$$GET1^DIQ(80,IEN,.01,"E")=.9999 Q
  1.  ..I $D(^XCSV(TRGT,"MAP",IEN)) D
  1.  ...S MAPIEN=$P(^XCSV(TRGT,"MAP",IEN),"^",1)
  1.  ...S JQUIT=0
  1.  ...F J=1:1 D  Q:JQUIT
  1.  ....S FIELD=$P(FLDLST,";",J) I FIELD="" S JQUIT=1 Q
  1.  ....; If the field is in a subfile, use the appropriate logic to get the data from ^XCSV and set into IHS files
  1.  ....D FIELD^DID(FILE,FIELD,"N","MULTIPLE-VALUED","MULT")
  1.  ....I $G(MULT("MULTIPLE-VALUED"))=1 D MULT(FILE,FIELD,TRGT,IEN,XREFS,MAPIEN) Q
  1.  ....; If the field is not in a subfile, use the single field logic.
  1.  ....D SINGLE(FILE,FIELD,TRGT,IEN,MAPIEN)
  1.  ..E  D VERSION^BCSVUT(IEN,FUNC)
  1.  D XREFUPD
  1.  ;D UPDCODES^BCSVUT
  1.  D RPALL^BCSVUT
  1.  D FIX^BCSVP1
  1.  Q
  1. BLDLST(FIL) ;
  1.  ; Build a list of all files that are located in a subfile (these are the multiples)
  1.  N SUBFIL,FLD
  1.  S SUBFIL=0
  1.  F  S SUBFIL=$O(^DD(FIL,"SB",SUBFIL)) Q:'SUBFIL  D
  1.  .S FLD=0
  1.  .F  S FLD=$O(^DD(FIL,"SB",SUBFIL,FLD)) Q:'FLD  D
  1.  ..S ^XTMP("AUMCSVMD","SB",FIL,FLD,SUBFIL)=""
  1.  Q
  1. INDEX ;
  1.  N IHSIEN,VAIEN
  1.  S IHSIEN=0
  1.  F  S IHSIEN=$O(^XCSV("ICD9","MAP",IHSIEN)) Q:'IHSIEN  D
  1.  .S VAIEN=$P($G(^XCSV("ICD9","MAP",IHSIEN)),"^")
  1.  .S ^XCSV("ICD9","REVMAP",VAIEN)=IHSIEN
  1.  Q
  1. READ(TAG,INCR) ;
  1.  N LINE
  1.  S LINE=$T(@TAG+INCR)
  1.  S DATA=$P(LINE,DDLM,2)
  1.  Q DATA
  1.  ;
  1. SINGLE(FILE,FLD,TRGT,IEN,MAPIEN) ;
  1.  ; Input - FILE - IHS File Number
  1.  ;         FLD  - IHS Field Number
  1.  ;
  1.  N ROOT,DATA,VAIEN,DATALOC,NODE,NEWDAT,DATAPC,CSVDAT,IHSDAT,PIECE,FLDZERO,FLDTYP,TARGET
  1.  S ROOT=$$ROOT^DILFD(FILE)
  1.  S DATA=$G(^XCSV(TRGT,"MAP",MAPIEN))
  1.  S VAIEN=$P(DATA,"^")
  1.  D FIELD^DID(FILE,FLD,"N","GLOBAL SUBSCRIPT LOCATION","CSVDAT")
  1.  I '$D(CSVDAT) Q
  1.  S DATALOC=$G(CSVDAT("GLOBAL SUBSCRIPT LOCATION"))
  1.  S NODE=$P(DATALOC,";",1),PIECE=$P(DATALOC,";",2)
  1.  I NODE=""!(PIECE="") Q
  1.  S NEWDAT=$G(^XCSV(TRGT,"DATA",MAPIEN,NODE))
  1.  S DATAPC=$P(NEWDAT,"^",PIECE)
  1.  S IHSDAT=$$GET1^DIQ(FILE,IEN_",",FLD)
  1.  I IHSDAT="",NEWDAT="" Q
  1.  S FLDZERO=$G(^DD(FILE,FLD,0))
  1.  S FLDTYP=$P(FLDZERO,U,2)
  1.  I FLDTYP["P" D
  1.  .S TARGET=$P(FLDZERO,U,3),TARGET=$TR($P(TARGET,","),"(","|")
  1.  .I $P(TARGET,"|",2)="" S TARGET=$P(TARGET,"|")
  1.  .Q:DATAPC=""
  1.  .I $D(^XCSV(TARGET,"MAP","B",DATAPC)) S DATAPC=$G(^XCSV(TARGET,"MAP","B",DATAPC)) Q
  1.  .E  S DATAPC=""
  1.  I FILE=80,((FLD=14)!(FLD=15)) S DATAPC=$$AGECON80^BCSVUT(DATAPC,IEN,FLD)
  1.  I FILE=81,((FLD=10.01)!(FLD=10.02)) S DATAPC=$$AGECON^BCSVUT(DATAPC)
  1.  S FDA(FILE,IEN_",",FLD)=DATAPC D FILE^DIE(,"FDA") K FDA
  1.  Q
  1. MULT(FILE,FLD,TRGT,IEN,XREFS,MAPIEN) ;
  1.  N ROOT,SUBLOC,MERGELOC,DIK,XREFFLD,XREFNM,SUBLOC2,TEMPSUB
  1.  S ROOT=$$ROOT^DILFD(FILE)
  1.  D FIELD^DID(FILE,FLD,"N","GLOBAL SUBSCRIPT LOCATION","SUBLOC")
  1.  I '$D(SUBLOC) Q
  1.  S SUBLOC=$P(SUBLOC("GLOBAL SUBSCRIPT LOCATION"),";")
  1.  S TEMPSUB=SUBLOC
  1.  I 'SUBLOC D
  1.  .I SUBLOC=0 Q
  1.  .S SUBLOC2=$C(34)_SUBLOC_$C(34)
  1.  .S MERGELOC=ROOT_IEN_","_SUBLOC2_")"
  1.  I '$D(MERGELOC) S MERGELOC=ROOT_IEN_","_SUBLOC_")"
  1.  S DIK=ROOT_IEN_","_SUBLOC_",",DA(1)=IEN
  1.  I $D(XREFDATA(SUBLOC)) D
  1.  .S XREFFLD=0
  1.  .F  S XREFFLD=$O(XREFDATA(SUBLOC,XREFFLD)) Q:'XREFFLD  D
  1.  ..S XREFNM=0
  1.  ..F  S XREFNM=$O(XREFDATA(SUBLOC,XREFFLD,XREFNM)) Q:XREFNM=""  D
  1.  ...S DIK(1)=XREFFLD_"^"_XREFNM D ENALL2^DIK
  1.  K @MERGELOC
  1.  M @MERGELOC=^XCSV(TRGT,"DATA",MAPIEN,SUBLOC)
  1.  I $D(XREFDATA(SUBLOC)) D
  1.  .S XREFFLD=0
  1.  .F  S XREFFLD=$O(XREFDATA(SUBLOC,XREFFLD)) Q:'XREFFLD  D
  1.  ..S XREFNM=0
  1.  ..F  S XREFNM=$O(XREFDATA(SUBLOC,XREFFLD,XREFNM)) Q:XREFNM=""  D
  1.  ...S DIK(1)=XREFFLD_"^"_XREFNM D ENALL^DIK
  1.  Q
  1. CLEAN(TRGT,IEN,XREFDATA,FIELD,MERGELOC,ROOT,SUBLOC) ;
  1.  N SUBIEN,CLOOPSTR,TEST,DATANODE,ROOTCHK,IHSPTR,VAPTR,XREFNM,XREFFLD
  1.  S SUBIEN=0
  1.  S CLOOPSTR=$P(MERGELOC,")"),CLOOPSTR=CLOOPSTR_",SUBIEN)"
  1.  I 'SUBLOC D
  1.  .I SUBLOC=0 Q
  1.  .S SUBLOC=$C(34)_SUBLOC_$C(34)
  1.  S TEST=ROOT_IEN_","_SUBLOC_")"
  1.  I '$D(@TEST) Q
  1.  F  S SUBIEN=$O(@CLOOPSTR) Q:'SUBIEN  D
  1.  .S DIK=ROOT_IEN_","_SUBLOC_",",DA(1)=SUBIEN
  1.  .S DATANODE=$P(CLOOPSTR,")"),DATANODE=DATANODE_",0)"
  1.  .S VAPTR=$G(@DATANODE)
  1.  .S ROOTCHK=ROOT_VAPTR_")"
  1.  .I '$D(^XCSV(TRGT,"REVMAP",VAPTR)) Q
  1.  .I '$D(@ROOTCHK)!('$D(^XCSV(TRGT,"REVMAP",VAPTR))) D
  1.  ..I $D(XREFDATA(SUBLOC)) D
  1.  ...S XREFFLD=0
  1.  ...F  S XREFFLD=$O(XREFDATA(SUBLOC,XREFFLD)) Q:'XREFFLD  D
  1.  ....K @CLOOPSTR
  1.  ....S XREFNM=0
  1.  ....F  S XREFNM=$O(XREFDATA(SUBLOC,XREFFLD,XREFNM)) Q:XREFNM=""  D
  1.  .....S DIK(1)=XREFFLD_"^"_XREFNM D EN2^DIK
  1.  .S IHSPTR=$G(^XCSV(TRGT,"REVMAP",VAPTR))
  1.  .I IHSPTR=VAPTR Q
  1.  .I IHSPTR'=VAPTR D  Q
  1.  ..I $D(XREFDATA(SUBLOC)) D
  1.  ...S XREFFLD=0
  1.  ...F  S XREFFLD=$O(XREFDATA(SUBLOC,XREFFLD)) Q:'XREFFLD  D
  1.  ....S XREFNM=0
  1.  ....F  S XREFNM=$O(XREFDATA(SUBLOC,XREFFLD,XREFNM)) Q:XREFNM=""  D
  1.  .....S DIK(1)=XREFFLD_"^"_XREFNM D EN2^DIK
  1.  ..I FIELD=20 D  Q
  1.  ...K @DATANODE
  1.  ...S ^ICD9(IEN,"N",IHSPTR,0)=IHSPTR
  1.  ...I $D(XREFDATA(SUBLOC)) D
  1.  ....S XREFFLD=0
  1.  ....F  S XREFFLD=$O(XREFDATA(SUBLOC,XREFFLD)) Q:'XREFFLD  D
  1.  .....S XREFNM=0
  1.  .....F  S XREFNM=$O(XREFDATA(SUBLOC,XREFFLD,XREFNM)) Q:XREFNM=""  D
  1.  ......S DIK(1)=XREFFLD_"^"_XREFNM D EN1^DIK
  1.  ..S @DATANODE=IHSPTR
  1.  ..I $D(XREFDATA(SUBLOC)) D
  1.  ...S XREFFLD=0
  1.  ...F  S XREFFLD=$O(XREFDATA(SUBLOC,XREFFLD)) Q:'XREFFLD  D
  1.  ....S XREFNM=0
  1.  ....F  S XREFNM=$O(XREFDATA(SUBLOC,XREFFLD,XREFNM)) Q:XREFNM=""  D
  1.  .....S DIK(1)=XREFFLD_"^"_XREFNM D EN1^DIK
  1.  Q
  1. XREFS(XREFS) ;
  1.  N QUIT,DATA,I,LOC,FLD,JQUIT,J,FLDS,XREF
  1.  S QUIT=0
  1.  S ^XTMP("XREFS",XREFS)=""
  1.  F I=1:1 D  Q:QUIT
  1.  .S DATA=$P(XREFS,";",I) I DATA="" S QUIT=1 Q
  1.  .S LOC=$P(DATA,","),FLDS=$P(DATA,",",2),XREF=$P(DATA,",",3)
  1.  .S JQUIT=0
  1.  .F J=1:1 D  Q:JQUIT
  1.  ..S FLD=$P(FLDS,"/",J) I FLD="" S JQUIT=1 Q
  1.  ..S XREFDATA(LOC,FLD,XREF)=""
  1.  Q
  1. DELDUM ;
  1.  N DA,DATA,NEWDAT
  1.  S DA(1)=0
  1.  F  S DA(1)=$O(^ICD9(DA(1))) Q:'DA(1)  D
  1.  .S DA=0
  1.  .F  S DA=$O(^ICD9(DA(1),9999999.21,DA)) Q:'DA  D
  1.  ..I $P(^ICD9(DA(1),9999999.21,DA,0),"^",2)'="" S $P(^ICD9(DA(1),9999999.21,DA,0),"^",2)=""
  1.  Q
  1. ICDSET ;
  1.  S ^ICD(541,0)="DRG541^20.041^1^99^17^1^^38.7"
  1.  S ^ICD(542,0)="DRG542^12.028^1^99^17^1^^27.5"
  1.  S ^ICD(543,0)="DRG543^4.457^1^99^1^1^^8.7"
  1.  S ^ICD("ADS","DRG541 ",3041001,541,1)=""
  1.  S ^ICD("ADS","DRG542 ",3041001,542,1)=""
  1.  S ^ICD("ADS","DRG543 ",3041001,543,1)=""
  1.  S ^ICD("B","DRG541",541)=""
  1.  S ^ICD("B","DRG542",542)=""
  1.  S ^ICD("B","DRG543",543)=""
  1.  Q
  1. CALDELDD ;
  1.  M ^TMP("BCSVMD","DIC|81.1")=^DIC(81.1)
  1.  N FL F FL=80,80.1,80.2,80.3,81,81.1 D DELDD(FL)
  1.  M ^DIC(81.1)=^TMP("BCSVMD","DIC|81.1")
  1.  Q
  1. DELDD(FILE) ;
  1.  N DIU
  1.  I '$G(FILE) Q
  1.  S DIU=FILE,DIU(0)="" D EN^DIU2
  1.  Q
  1. XREFUPD ;
  1.  N DIK,IEN
  1.  K ^ICD9("AB")
  1.  S DIK="^ICD9(",DIK(1)=".01^AB" D ENALL^DIK
  1.  S DIK="^ICPT(",DIK(1)=".01^E^F^ACT" D ENALL^DIK
  1.  S DIK(1)=".01^M"
  1.  S IEN=0 F  S IEN=$O(^DIC(81.3,IEN)) Q:'IEN  D
  1.  .S DIK="^DIC(81.3,"_IEN_",10,",DA(1)=IEN
  1.  .D ENALL^DIK
  1.  Q
  1.  ; Format for FLDLST - IHS FILE|OLD IHS FIELD|NEW IHS FIELD|NEW IHS FILE (optional)|DELETe (this is set to 'D' if we are only deleting the field, 'SD' to suppress deletion)
  1.  ; Deletion is for fields that will only be deleted, suppressing deletion is reserved for file 9999999.88. This is to prevent the deletion of fields from this file,
  1.  ; as they are being moved to 81.3, and should no longer be used. However, it is felt that the original file (9999999.88) should be left intact.
  1. FLDLST ;
  1.  ;;80|2100000|||D
  1.  ;;80|2100002|||D
  1.  ;;80.1|2100000|||D
  1.  ;;80.1|2100002|||D
  1.  ;;80.2|8|99999992|||D
  1.  ;;81|6|9999999.05
  1.  ;;81|7|9999999.06
  1.  ;;81|8|9999999.07
  1.  ;;81|4|9999999.1|||AI
  1.  ;;81|66|||D
  1.  ;;81|409.5|||D
  1.  ;;81|9999999.03|||D
  1.  ;;9999999.88|.03|9999999.01|81.3|SD
  1.  ;;9999999.88|.04|9999999.02|81.3|SD
  1.  ;;9999999.88|1|||D
  1.  ;;Q
  1.  ;
  1.  ; List of fields being brought from the VA DD structure into IHS. This is the list of fields that will need
  1.  ; to have their data moved from the VA files into the appropriate locations within the IHS files.
  1.  ; FORMAT - IHSFILE|LIST OF FIELDS TO BE GATHERED FOR DATA INSERTION INTO IHS FILES FROM XCSV GLOBAL|XCSV ROOT|FIELDS ASSOC. WITH XREF (separated by /);XREF TO RE-INDEX|VERSIONED DATA LOCATION INFORMATION
  1. IMPORT ;
  1.  ;;80.1|12;20;66;67;68;71|ICD0|66,.01,B;66,.02,ACT;67,.01,AST;68,.01,ADS
  1.  ;;80|14;15;16;66;67;68;71;72|ICD9|20,.01,B;30,.01,B;40,.01,ACC;66,.01,B;66,.02,ACT;67,.01,AST;68,.01,ADS
  1.  ;;80.2|14;15;16;66;68;71;900|ICD|68,.01,ADS
  1.  ;;81|6;7;8;10.01;10.02;10.03;50;61;62|ICPT|61,.01,AST;62,.01,ADS;50,.01,C
  1.  ;;81.1|4;5;6|DIC(81.1|
  1.  ;;81.3|.03;.04;5;7;8;10;50;60;61;62|DIC(81.3|61,.01,AST;62,.01,ASD
  1.  ;;
  1.  ;;Q
  1. UPDATE ;
  1.  ;;80.1|2;4;5;7;8;9.5;10;50;51;52;53;54;55;100|ICD0||VER801^BCSVUT
  1.  ;;80|2;3;5;5.5;5.7;5.9;9.5;10;20;30;40;60;61;62;63;64;65;70;100;101;103|ICD9|"N",.01,B;"R",.01,B;2,.01,ACC|VER80^BCSVUT
  1.  ;;80.2|.06;1;2;3;4;5;7;7.5;10;11;12;13;20;30|ICD||VER802^BCSVUT
  1.  ;;81|2;3;5;60|ICPT||VER81^BCSVUT
  1.  ;;81.1|2;3;100|DIC(81.1||VER811^BCSVUT
  1.  ;;81.3|.02|DIC(81.3||VER813^BCSVUT
  1.  ;;80.3|.001;1|ICM||VER803^BCSVUT
  1.  ;;Q
  1.  Q