BCSVP2 ;IHS/MSC/BWF - CSV Patch 1 ;3-Mar-2010 19:05;BF
;;1.0;BCSV;**2**;APR 23,2010
;=================================================================
; BCSV patch 2 post install
PRE ;
I '$D(^XPD(9.6,"B","BCSV*1.0*1")) S XPDABORT=1
I $G(XPDABORT) D BMES^XPDUTL("BCSV*1.0*1 must be installed to continue!") Q
Q
POST ;
N ICDCODE,SIEN,AGELOW,AGEHIGH,ICD90,OALOW,OAHIGH,ICDCODE
S REPONLY=$G(REPONLY)
I $G(REPONLY) D DISPHDR
; grab old age ranges and put them back into the ICD file.
S X=0 F S X=$O(^ICD9(X)) Q:'X D
.S ICDCODE=$P(^ICD9(X,0),U,1)_" "
.; get source ien
.S SIEN=$O(^XCSVICD9("BA",ICDCODE,0)) Q:'SIEN
.S IHSIEN=$O(^ICD9("BA",ICDCODE,0)) Q:'IHSIEN
.S AGELOW=$$AGELOW(SIEN,IHSIEN),AGEHIGH=$$AGEHIGH(SIEN,IHSIEN)
.S ICD90=$G(^ICD9(IHSIEN,0)),OALOW=$P(ICD90,U,14),OAHIGH=$P(ICD90,U,15)
.I OALOW="",AGELOW="",OAHIGH="",AGEHIGH="" Q
.I OALOW=AGELOW,OAHIGH=AGEHIGH Q
.I REPONLY D DISP(ICDCODE,AGELOW,AGEHIGH,OALOW,OAHIGH) Q
.S FDA(80,X_",",14)=AGELOW
.S FDA(80,X_",",15)=AGEHIGH
.D FILE^DIE(,"FDA","ERR")
D FIXICM
D ICDUPD
Q
FIXICM ; kill off entries that were added in the wrong place
N QUIT,LINE,KIEN,NIEN
S QUIT=0
F I=1:1 D Q:QUIT
.S LINE=$P($T(DAT+I),";;",2) I LINE=" Q"!(LINE']"") S QUIT=1 Q
.K KIEN,NIEN
.S KIEN=$P(LINE,":"),NIEN(1)=$P(LINE,":",2)
.S DIK="^ICM(",DA=KIEN D ^DIK
.; if an entry already exists here, do not file it again
.I '$D(^ICM(NIEN(1))) D
..K FDA S FDA(80.3,"+1,",.01)=$P($G(^XCSV("ICM","DATA",NIEN(1),0)),U,1)
..D UPDATE^DIE(,"FDA","NIEN","BCSVERR") K FDA
.; add data back into entry
.M ^ICM(NIEN(1))=^XCSV("ICM","DATA",NIEN(1))
.; reindex
S DIK="^ICM(" D IXALL^DIK
Q
;
ICDUPD ;
N DRG,BCSVDT,BCSVSIEN,BCSVDESC
S DRG=0 F S DRG=$O(^ICD(DRG)) Q:'DRG D
.S BCSVDT=$O(^ICD(DRG,68,"B",9999999),-1) Q:'BCSVDT
.S BCSVSIEN=$O(^ICD(DRG,68,"B",BCSVDT,0)) Q:'BCSVSIEN
.S BCSVDESC=$$GET1^DIQ(80.2681,"1,"_BCSVSIEN_","_DRG_",",.01,"E")
.S FDA(80.21,"1,"_DRG_",",.01)=BCSVDESC
.D FILE^DIE(,"FDA") K FDA
Q
AGELOW(IEN,IHSIEN) ;
N ALOW
Q:'IEN
; first check to see if there is a value in piece 14
S ALOW=$P(^XCSVICD9(IEN,0),U,14)
I 'ALOW S ALOW=$P($G(^ICD9(IHSIEN,9999999)),U)
Q ALOW
AGEHIGH(IEN,IHSIEN) ;
N AHIGH
Q:'IEN
S AHIGH=$P(^XCSVICD9(IEN,0),U,15)
I 'AHIGH S AHIGH=$P($G(^ICD9(IHSIEN,9999999)),U,2)
Q AHIGH
;
DISP(CODE,NALOW,NAHIGH,OALOW,OAHIGH) ;
W !,CODE,?20,OALOW,?35,NALOW,?50,OAHIGH,?65,NAHIGH
Q
DISPHDR ;
W @IOF
W !,"ICD CODE",?20,"CSV AGE LOW",?35,"IHS AGE LOW",?50,"CSV AGE HIGH",?65,"IHS AGE HIGH"
W !,"--------",?20,"-----------",?35,"-----------",?50,"------------",?65,"------------"
Q
DAT ;
;;100:26
;;101:27
;;102:28
;;103:98
Q
BCSVP2 ;IHS/MSC/BWF - CSV Patch 1 ;3-Mar-2010 19:05;BF
+1 ;;1.0;BCSV;**2**;APR 23,2010
+2 ;=================================================================
+3 ; BCSV patch 2 post install
PRE ;
+1 IF '$DATA(^XPD(9.6,"B","BCSV*1.0*1"))
SET XPDABORT=1
+2 IF $GET(XPDABORT)
DO BMES^XPDUTL("BCSV*1.0*1 must be installed to continue!")
QUIT
+3 QUIT
POST ;
+1 NEW ICDCODE,SIEN,AGELOW,AGEHIGH,ICD90,OALOW,OAHIGH,ICDCODE
+2 SET REPONLY=$GET(REPONLY)
+3 IF $GET(REPONLY)
DO DISPHDR
+4 ; grab old age ranges and put them back into the ICD file.
+5 SET X=0
FOR
SET X=$ORDER(^ICD9(X))
IF 'X
QUIT
Begin DoDot:1
+6 SET ICDCODE=$PIECE(^ICD9(X,0),U,1)_" "
+7 ; get source ien
+8 SET SIEN=$ORDER(^XCSVICD9("BA",ICDCODE,0))
IF 'SIEN
QUIT
+9 SET IHSIEN=$ORDER(^ICD9("BA",ICDCODE,0))
IF 'IHSIEN
QUIT
+10 SET AGELOW=$$AGELOW(SIEN,IHSIEN)
SET AGEHIGH=$$AGEHIGH(SIEN,IHSIEN)
+11 SET ICD90=$GET(^ICD9(IHSIEN,0))
SET OALOW=$PIECE(ICD90,U,14)
SET OAHIGH=$PIECE(ICD90,U,15)
+12 IF OALOW=""
IF AGELOW=""
IF OAHIGH=""
IF AGEHIGH=""
QUIT
+13 IF OALOW=AGELOW
IF OAHIGH=AGEHIGH
QUIT
+14 IF REPONLY
DO DISP(ICDCODE,AGELOW,AGEHIGH,OALOW,OAHIGH)
QUIT
+15 SET FDA(80,X_",",14)=AGELOW
+16 SET FDA(80,X_",",15)=AGEHIGH
+17 DO FILE^DIE(,"FDA","ERR")
End DoDot:1
+18 DO FIXICM
+19 DO ICDUPD
+20 QUIT
FIXICM ; kill off entries that were added in the wrong place
+1 NEW QUIT,LINE,KIEN,NIEN
+2 SET QUIT=0
+3 FOR I=1:1
Begin DoDot:1
+4 SET LINE=$PIECE($TEXT(DAT+I),";;",2)
IF LINE=" Q"!(LINE']"")
SET QUIT=1
QUIT
+5 KILL KIEN,NIEN
+6 SET KIEN=$PIECE(LINE,":")
SET NIEN(1)=$PIECE(LINE,":",2)
+7 SET DIK="^ICM("
SET DA=KIEN
DO ^DIK
+8 ; if an entry already exists here, do not file it again
+9 IF '$DATA(^ICM(NIEN(1)))
Begin DoDot:2
+10 KILL FDA
SET FDA(80.3,"+1,",.01)=$PIECE($GET(^XCSV("ICM","DATA",NIEN(1),0)),U,1)
+11 DO UPDATE^DIE(,"FDA","NIEN","BCSVERR")
KILL FDA
End DoDot:2
+12 ; add data back into entry
+13 MERGE ^ICM(NIEN(1))=^XCSV("ICM","DATA",NIEN(1))
+14 ; reindex
End DoDot:1
IF QUIT
QUIT
+15 SET DIK="^ICM("
DO IXALL^DIK
+16 QUIT
+17 ;
ICDUPD ;
+1 NEW DRG,BCSVDT,BCSVSIEN,BCSVDESC
+2 SET DRG=0
FOR
SET DRG=$ORDER(^ICD(DRG))
IF 'DRG
QUIT
Begin DoDot:1
+3 SET BCSVDT=$ORDER(^ICD(DRG,68,"B",9999999),-1)
IF 'BCSVDT
QUIT
+4 SET BCSVSIEN=$ORDER(^ICD(DRG,68,"B",BCSVDT,0))
IF 'BCSVSIEN
QUIT
+5 SET BCSVDESC=$$GET1^DIQ(80.2681,"1,"_BCSVSIEN_","_DRG_",",.01,"E")
+6 SET FDA(80.21,"1,"_DRG_",",.01)=BCSVDESC
+7 DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:1
+8 QUIT
AGELOW(IEN,IHSIEN) ;
+1 NEW ALOW
+2 IF 'IEN
QUIT
+3 ; first check to see if there is a value in piece 14
+4 SET ALOW=$PIECE(^XCSVICD9(IEN,0),U,14)
+5 IF 'ALOW
SET ALOW=$PIECE($GET(^ICD9(IHSIEN,9999999)),U)
+6 QUIT ALOW
AGEHIGH(IEN,IHSIEN) ;
+1 NEW AHIGH
+2 IF 'IEN
QUIT
+3 SET AHIGH=$PIECE(^XCSVICD9(IEN,0),U,15)
+4 IF 'AHIGH
SET AHIGH=$PIECE($GET(^ICD9(IHSIEN,9999999)),U,2)
+5 QUIT AHIGH
+6 ;
DISP(CODE,NALOW,NAHIGH,OALOW,OAHIGH) ;
+1 WRITE !,CODE,?20,OALOW,?35,NALOW,?50,OAHIGH,?65,NAHIGH
+2 QUIT
DISPHDR ;
+1 WRITE @IOF
+2 WRITE !,"ICD CODE",?20,"CSV AGE LOW",?35,"IHS AGE LOW",?50,"CSV AGE HIGH",?65,"IHS AGE HIGH"
+3 WRITE !,"--------",?20,"-----------",?35,"-----------",?50,"------------",?65,"------------"
+4 QUIT
DAT ;
+1 ;;100:26
+2 ;;101:27
+3 ;;102:28
+4 ;;103:98
+5 QUIT
