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

BCSVP1.m

Go to the documentation of this file. 
  1. BCSVP1 ;IHS/MSC/BWF - CSV Patch 1 ;16-Apr-2010 09:58;JSH
  1.  ;;1.0;BCSV;;APR 23, 2010;Build 44
  1.  ;=================================================================
  1. PRE ;
  1.  I '$D(^XPD(9.6,"B","IHS CSV VA UPDATES 1.0")) S XPDABORT=1
  1.  I $G(XPDABORT) D BMES^XPDUTL("BCSV 1.0 has not been installed. This patch cannot be executed!") Q
  1. FIX ;
  1.  N BCSVNUM,BCSVIEN,CNT,FIL,EFLG,CIEN
  1.  ; fix DIC(81.3,0)
  1.  S $P(^DIC(81.3,0),U,2)="81.3I"
  1.  S BCSVNUM=$$NUM()
  1.  S $P(^DIC(81.3,0),U,4)=BCSVNUM
  1.  ; re-index M and M2 indices associated with the RANGE multiple field (#10)
  1.  W !,"Re-indexing M,M2,and MR indices in file #81.3",!!	
  1.  S (BCSVIEN,CNT)=0 F  S BCSVIEN=$O(^DIC(81.3,BCSVIEN)) Q:'BCSVIEN  D
  1.  .S DA(1)=BCSVIEN,DIK="^DIC(81.3,"_BCSVIEN_",10,"
  1.  .S DIK(1)=".01^M^M2" D ENALL^DIK
  1.  .S DIK(1)=".02^M^MR" D ENALL^DIK
  1.  ; fix .9999 AB index
  1.  S CIEN=$O(^ICD9("AB",".9999 ",0))
  1.  I 'CIEN S CIEN=$O(^ICD9("BA",".9999 ",0))
  1.  I CIEN S ^ICD9("AB",.9999,CIEN)=""
  1.  ; fix age issues as identified - note.. this is no longer needed. It has been determined that the values
  1.  ; being used are the correct values (translated) from the VA dataset.
  1.  ;D FIXAGE80(377.43,15,99),FIXAGE80(799.02,15,99)
  1.  ; fix issue where age low>age high. BCSV 1.0 caused an issue where in the event that age low was 0, the VA
  1.  ; value was put in its place due to the check being boolean. These two functions will evaluate age low and
  1.  ; age high, if age low is higher than the age high value, the age low value will be reset to 0.
  1.  D LOOP80,LOOP81
  1.  ;
  1.  ;
  1.  ;
  1.  ;Create an index of all "NEW" entries from ^XCSV(FILE,"NEW",IEN)
  1.  ;This is being done by comparing the key value (field) that is compared in mapping.
  1.  ;If there is a match, and the entry in ^XCSV was not MAPPED TO by an IHS code, we will choose that value.
  1.  ;
  1. PRE2 ;
  1.  N EFLG,OFF,FIL
  1.  D INIT^BCSVMP
  1.  F  D  Q:$G(EFLG)
  1.  .S FIL=$$NXTFIL^BCSVMP(.OFF)
  1.  .I $P(FIL,DDLM,2)="" S EFLG=1 Q
  1.  .D INDEX(FIL)
  1.  Q
  1. INDEX(FIL) ;
  1.  N SRCARY,TRGARY,LOOPGLB,TGNM,NGNM,SGLB,IEN
  1.  D SETFILE^BCSVMP($P(FIL,DDLM,2),.SRCARY,.TRGARY)
  1.  S LOOPGLB=$$GLBPATH^BCSVMP(TRGARY("NUM"),"NEW")
  1.  S SGLB=$$GLB^BCSVMP(SRCARY("NUM"))
  1.  S TGNM=$NA(^XCSV(TRGARY("GNAM"),"DATA"))
  1.  S NGNM=$NA(^XCSV(TRGARY("GNAM"),"NEW"))
  1.  S IEN=0 F  S IEN=$O(@NGNM@(IEN)) Q:'IEN  D
  1.  .I '$D(@SGLB@(IEN)) Q
  1.  .S SDATA=$G(@SGLB@(IEN,0))
  1.  .Q:SDATA=""
  1.  .S VAL=$P(SDATA,U)
  1.  .S TIEN=$$IENLKP^BCSVMP(TGNM,VAL,IEN,TRGARY("XRI"))
  1.  .D UPDGLOB(TRGARY("GNAM"),IEN,TIEN)
  1.  Q
  1. UPDGLOB(FIL,SIEN,TIEN) ;
  1.  N MGLN
  1.  S MGLN=$$GLBPATH^BCSVMP(FIL,"NEW")
  1.  I TIEN D
  1.  .S @MGLN@(SIEN)=TIEN
  1.  .S @MGLN@("B",TIEN)=SIEN
  1.  Q
  1.  ;
  1. NUM() ;
  1.  N X,VAL
  1.  S X=0 F  S X=$O(^DIC(81.3,X)) Q:'X  S VAL=$G(VAL)+1
  1.  Q VAL
  1.  ;
  1. FIXAGE80(CODE,LOW,HIGH) ;
  1.  ; INPUT  IEN - ien to file 80
  1.  ;        LOW - low age (in years)
  1.  ;        HIGH - high age (in years)
  1.  ; fix code 760.71 (age high)
  1.  N IENS
  1.  I 'CODE Q
  1.  S CODE=CODE_" "
  1.  S IEN=$O(^ICD9("AB",CODE,0))
  1.  S IENS=IEN_","
  1.  I LOW D
  1.  .S FDA(80,IENS,14)=LOW*365
  1.  .S FDA(80,IENS,9999999.01)=LOW
  1.  I HIGH D
  1.  .S FDA(80,IENS,15)=HIGH*365
  1.  .S FDA(80,IENS,9999999.02)=HIGH
  1.  I $D(FDA) D FILE^DIE(,"FDA") K FDA
  1.  Q
  1.  ;
  1. LOOP80 ;
  1.  N X,ALOW,AHIGH
  1.  S X=0 F  S X=$O(^ICD9(X)) Q:'X  D
  1.  .S ALOW=$$GET1^DIQ(80,X,14),AHIGH=$$GET1^DIQ(80,X,15)
  1.  .I ALOW<AHIGH!(ALOW="") Q
  1.  .S FDA(80,X_",",14)=0 D FILE^DIE(,"FDA") K FDA Q
  1.  Q
  1. LOOP81 ;
  1.  N X,ALOW,AHIGH
  1.  S X=0 F  S X=$O(^ICPT(X)) Q:'X  D
  1.  .S ALOW=$$GET1^DIQ(81,X,10.01),AHIGH=$$GET1^DIQ(81,X,10.02)
  1.  .I ALOW<AHIGH!(ALOW="") Q
  1.  .S FDA(81,X_",",10.01)=0 D FILE^DIE(,"FDA") K FDA Q
  1.  Q