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