AUM131 ;IHS/OIT/NKD - ICD 9 UPDATE 08/30/2012 ;
;;13.0;TABLE MAINTENANCE;;AUG 30,2012;Build 1
;
Q
UPDATE ; EP - MAIN DRIVER
N YEAR,ROOT
F YEAR=2013 D
. S ROOT="^ICD9("
. D UPDDX(YEAR)
. S ROOT="^ICD0("
. D UPDPX(YEAR)
Q
UPDDX(YEAR) ; ICD9 DIAGNOSIS FILE DRIVER
N TYPE,ICDCNT
F TYPE="REV" D
. D RSLT^AUM13EN("ICD 9 DIAGNOSIS, "_YEAR_" "_$S(TYPE="NEW":TYPE,TYPE="REV":"REVISED",TYPE="INA":"INACTIVATED",1:"")_" CODES:",1)
. D RSLT^AUM13EN($J("",4)_"CODE"_$J("",6)_"DIAGNOSIS"_$J("",18)_"NEW"_$J("",1)_"SHORT"_$J("",1)_"LONG"_$J("",1)_"SEX"_$J("",1)_"AGE"_$J("",1)_"CC")
. D RSLT^AUM13EN($J("",4)_"----"_$J("",6)_"---------"_$J("",18)_"---"_$J("",1)_"-----"_$J("",1)_"----"_$J("",1)_"---"_$J("",1)_"---"_$J("",1)_"--")
. S ICDCNT=0 F S ICDCNT=$O(^AUMDATA(ICDCNT)) Q:'ICDCNT D
. . Q:$P(^AUMDATA(ICDCNT,0),U,2)'=(TYPE_"DX")
. . Q:$P(^AUMDATA(ICDCNT,0),U,3)'=YEAR
. . D DXUPD($P(^AUMDATA(ICDCNT,0),U,3,9),TYPE)
Q
DXUPD(AUMDATA,TYPE) ; ICD9 DIAGNOSIS FILE UPDATE
N ICDIEN,CNT,FDA,NEWIEN,ERR,ICDRES,ICDMOD
N ICDYR,ICDCOD,ICDDX,ICDDES,ICDSEX,ICDAGE,ICDRNG,ICDCC,ICDMDRG,ICDMDC,ICDDRG,ICDPYR
S (ICDMOD,ICDRNG,ICDMDC,ICDDRG)=""
S ICDYR=$P(AUMDATA,U,1),ICDYR=$E(ICDYR,3,4)+299,ICDYR=ICDYR_"1001"
S ICDCOD=$P(AUMDATA,U,2)
S ICDDX=$P(AUMDATA,U,3)
S ICDDES=$P(AUMDATA,U,4)
S ICDSEX=$P($P(AUMDATA,U,5),"~",1)
S ICDAGE=$P($P(AUMDATA,U,5),"~",2)
S ICDCC=$P(AUMDATA,U,6)
S ICDMDRG=$P(AUMDATA,U,7)
;
S ICDIEN=$O(@(ROOT_"""BA"","""_ICDCOD_" "","""")"),-1)
S:('ICDIEN&(ICDCOD'[".")) ICDCOD=ICDCOD_"."
S ICDIEN=$O(@(ROOT_"""BA"","""_ICDCOD_" "","""")"),-1)
;
I TYPE'="INA",'ICDIEN D
. K FDA,NEWIEN,ERR
. S FDA(80,"+1,",.01)=ICDCOD ; Code Number (.01)
. S FDA(80,"+1,",3)=ICDDX ; Diagnosis (3)
. D UPDATE^DIE(,"FDA","NEWIEN","ERR")
. I $D(ERR) D RSLT^AUM13EN("ERROR: Lookup/Add of CODE '"_ICDCOD_"' FAILED.") Q
. E S ICDMOD=ICDMOD_"N"_$J("",3)
. S ICDIEN=NEWIEN(1)
Q:'ICDIEN
I $L(ICDMOD)<1 S ICDMOD=" "_$J("",3)
; MDC EXTRACTOR
F CNT=1:1:$L(ICDMDRG,"~") S ICDMDC=ICDMDC_$S(CNT>1:"^",1:"")_$P($P(ICDMDRG,"~",CNT),"-",1)
F CNT=1:1:$L(ICDMDRG,"~") S ICDDRG=ICDDRG_$S(CNT>1:"^",1:"")_$TR($P($P(ICDMDRG,"~",CNT),"-",2),",","^")
; AGE RANGE EXTRACTOR
I $L(ICDAGE)>0 D
. S ICDRNG=$$GETRNG(ICDAGE)
. I $L(ICDRNG)<1 D RSLT^AUM13EN("ERROR: Incorrect Age Range")
; STORE PREVIOUS ACTIVATION DATE
S ICDPYR=$$GET1^DIQ(80,ICDIEN,16,"I")
;
K FDA
I TYPE'="INA" D
. S ICDMOD=ICDMOD_$S($$GET1^DIQ(80,ICDIEN,3,"I")'=ICDDX:"S",1:" ")_$J("",5)
. S ICDMOD=ICDMOD_$S($$GET1^DIQ(80,ICDIEN,10,"I")'=ICDDES:"L",1:" ")_$J("",4)
. S ICDMOD=ICDMOD_$S($$GET1^DIQ(80,ICDIEN,9.5,"I")'=ICDSEX:"X",1:" ")_$J("",3)
. S ICDMOD=ICDMOD_$S(($$GET1^DIQ(80,ICDIEN,14,"I")_$$GET1^DIQ(80,ICDIEN,15,"I"))'=($P(ICDRNG,"^",2)_$P(ICDRNG,"^",3)):"A",1:" ")_$J("",3)
. S ICDMOD=ICDMOD_$S($$GET1^DIQ(80,ICDIEN,70,"I")'=$S(ICDCC["CC":1,1:""):"C",1:" ")
. S FDA(80,ICDIEN_",",.01)=ICDCOD ; Code Number (.01)
. S:ICDDX]"" FDA(80,ICDIEN_",",3)=ICDDX ; Diagnosis (3)
. S:ICDMDC]"" FDA(80,ICDIEN_",",5)=$P(ICDMDC,"^",1) ; Major Diagnostic Category (5)
. S FDA(80,ICDIEN_",",9.5)=$S(ICDSEX]"":ICDSEX,1:"@") ; Sex (9.5)
. S:ICDDES]"" FDA(80,ICDIEN_",",10)=ICDDES ; Description (10)
. S:'ICDPYR FDA(80,ICDIEN_",",16)=ICDYR ; Activation Date (16)
. S:$P(ICDDRG,"^",1)]"" FDA(80,ICDIEN_",",60)=$P(ICDDRG,"^",1) ; DRGa (60)
. S:$P(ICDDRG,"^",2)]"" FDA(80,ICDIEN_",",61)=$P(ICDDRG,"^",2) ; DRGb (61)
. S:$P(ICDDRG,"^",3)]"" FDA(80,ICDIEN_",",62)=$P(ICDDRG,"^",3) ; DRGc (62)
. S:$P(ICDDRG,"^",4)]"" FDA(80,ICDIEN_",",63)=$P(ICDDRG,"^",4) ; DRGd (63)
. S:$P(ICDDRG,"^",5)]"" FDA(80,ICDIEN_",",64)=$P(ICDDRG,"^",5) ; DRGe (64)
. S:$P(ICDDRG,"^",6)]"" FDA(80,ICDIEN_",",65)=$P(ICDDRG,"^",6) ; DRGf (65)
. S FDA(80,ICDIEN_",",14)=$S($P(ICDRNG,"^",2)]"":$P(ICDRNG,"^",2),1:"@") ; Age Low (14)
. S FDA(80,ICDIEN_",",15)=$S($P(ICDRNG,"^",3)]"":$P(ICDRNG,"^",3),1:"@") ; Age High (15)
. S FDA(80,ICDIEN_",",9999999.01)=$S($P(ICDRNG,"^",2)]"":$P(ICDRNG,"^",2),1:"@") ; Lower Age (9999999.01)
. S FDA(80,ICDIEN_",",9999999.02)=$S($P(ICDRNG,"^",3)]"":$P(ICDRNG,"^",3),1:"@") ; Upper Age (9999999.02)
. S FDA(80,ICDIEN_",",70)=$S(ICDCC["CC":1,1:"@") ; Complication/Comorbidity (70)
. S FDA(80,ICDIEN_",",100)="@" ; Inactive Flag (100)
. S FDA(80,ICDIEN_",",102)="@" ; Inactive Date (102)
. S FDA(80,ICDIEN_",",2100000)=ICDYR ; Date Last Update (2100000)
. S:ICDMOD["N" FDA(80,ICDIEN_",",9999999.04)=ICDYR ; Date Added (9999999.04)
E D
. S FDA(80,ICDIEN_",",100)=1 ; Inactive Flag (100)
. S FDA(80,ICDIEN_",",102)=ICDYR ; Inactive Date (102)
. S FDA(80,ICDIEN_",",2100000)=ICDYR ; Date Last Update (2100000)
D UPDATE^DIE(,"FDA",)
; Effective Date (Versioned) (66)
K FDA
S FDA(80.066,"?+1,"_ICDIEN_",",.01)=ICDYR ; Effective Date (.01)
S FDA(80.066,"?+1,"_ICDIEN_",",.02)=$S(TYPE="INA":0,1:1) ; Status (.02)
D UPDATE^DIE(,"FDA",)
; Diagnosis (Versioned) (67)
K FDA
I TYPE'="INA" D
. S FDA(80.067,"?+1,"_ICDIEN_",",.01)=ICDYR ; Version Date (.01)
. S FDA(80.067,"?+1,"_ICDIEN_",",1)=$S(ICDDX]"":ICDDX,1:"@") ; Diagnosis (Versioned) (1)
. D UPDATE^DIE(,"FDA",)
; Description (Versioned) (68)
K FDA
I TYPE'="INA" D
. S FDA(80.068,"?+1,"_ICDIEN_",",.01)=ICDYR ; Version Date (.01)
. S FDA(80.068,"?+1,"_ICDIEN_",",1)=$S(ICDDES]"":ICDDES,1:"@") ; Description (Versioned) (1)
. D UPDATE^DIE(,"FDA",)
; DRG Grouper Effective Date (Versioned) (71)
K FDA,NEWIEN
I TYPE'="INA",ICDDRG]"" D
. S FDA(80.071,"?+1,"_ICDIEN_",",.01)=ICDYR ; DRG Grouper Effective Date (.01)
. D UPDATE^DIE(,"FDA","NEWIEN")
. I $D(NEWIEN) D
. . ; Remove previous DRGs
. . K ICDRES
. . D GETS^DIQ(80.071,NEWIEN(1)_","_ICDIEN,"1*","","ICDRES")
. . S CNT=0 F S CNT=$O(ICDRES(80.711,CNT)) Q:'CNT D
. . . S ICDRES(80.711,CNT,.01)="@"
. . D UPDATE^DIE(,"ICDRES",)
. . ; Add new DRGs
. . F CNT=1:1:$L(ICDDRG,"^") S FDA(80.711,"+"_CNT_","_NEWIEN(1)_","_ICDIEN_",",.01)=$P(ICDDRG,"^",CNT)
. . D UPDATE^DIE(,"FDA",)
; MDC Effective Date (Versioned) (72)
K FDA
I TYPE'="INA",ICDMDC]"" D
. S FDA(80.072,"?+1,"_ICDIEN_",",.01)=ICDYR ; MDC Effective Date (.01)
. S FDA(80.072,"?+1,"_ICDIEN_",",1)=$S(ICDMDC]"":$P(ICDMDC,"^",1),1:"@") ; MDC (1)
. D UPDATE^DIE(,"FDA",)
; Versioned CC (Versioned) (103)
K FDA
I TYPE'="INA",ICDCC]"" D
. S FDA(80.0103,"?+1,"_ICDIEN_",",.01)=ICDYR ; Effective Date (.01)
. S FDA(80.0103,"?+1,"_ICDIEN_",",1)=$S(ICDCC="N":0,ICDCC="CC":1,ICDCC="MCC":2,1:"@") ; Complication/Comorbidity (1)
. D UPDATE^DIE(,"FDA",)
; Restore Activation Date (16)
K FDA
I TYPE'="INA",ICDPYR'=$$GET1^DIQ(80,ICDIEN,16,"I") D
. S FDA(80,ICDIEN_",",16)=ICDPYR ; Activation Date (16)
. D UPDATE^DIE(,"FDA",)
;
S:ICDMOD["N" ICDMOD="N"
I ICDMOD'=$J("",24) D RSLT^AUM13EN($J("",4)_ICDCOD_$J("",10-$L(ICDCOD))_$E(ICDDX,1,24)_$J("",27-$L($E(ICDDX,1,24)))_ICDMOD)
;
Q
UPDPX(YEAR) ;ICD9 OPERATION/PROCEDURE FILE DRIVER
N TYPE,ICDCNT
F TYPE="REV" D
. D RSLT^AUM13EN("ICD 9 OPERATION/PROCEDURE, "_YEAR_" "_$S(TYPE="NEW":TYPE,TYPE="REV":"REVISED",TYPE="INA":"INACTIVATED",1:"")_" CODES:",1)
. D RSLT^AUM13EN($J("",4)_"CODE"_$J("",6)_"DESCRIPTION"_$J("",16)_"NEW"_$J("",1)_"SHORT"_$J("",1)_"LONG"_$J("",1)_"SEX")
. D RSLT^AUM13EN($J("",4)_"----"_$J("",6)_"-----------"_$J("",16)_"---"_$J("",1)_"-----"_$J("",1)_"----"_$J("",1)_"---")
. S ICDCNT=0 F S ICDCNT=$O(^AUMDATA(ICDCNT)) Q:'ICDCNT D
. . Q:$P(^AUMDATA(ICDCNT,0),U,2)'=(TYPE_"PX")
. . Q:$P(^AUMDATA(ICDCNT,0),U,3)'=YEAR
. . D PXUPD($P(^AUMDATA(ICDCNT,0),U,3,9),TYPE)
Q
PXUPD(AUMDATA,TYPE) ;ICD9 OPERATION/PROCEDURE FILE UPDATE
N ICDIEN,CNT,CNT2,FDA,FDAIEN,NEWIEN,ERR,ICDRES,ICDTMP,ICDMOD
N ICDYR,ICDCOD,ICDPX,ICDDES,ICDSEX,ICDMDRG,ICDMDC,ICDDRG,ICDPYR
S ICDMOD=""
S ICDYR=$P(AUMDATA,U,1),ICDYR=$E(ICDYR,3,4)+299,ICDYR=ICDYR_"1001"
S ICDCOD=$P(AUMDATA,U,2)
S ICDPX=$P(AUMDATA,U,3)
S ICDDES=$P(AUMDATA,U,4)
S ICDSEX=$P(AUMDATA,U,5)
S ICDMDRG=$P(AUMDATA,U,7)
;
S ICDIEN=$O(@(ROOT_"""BA"","""_ICDCOD_" "","""")"),-1)
;
I TYPE'="INA",'ICDIEN D
. K FDA,NEWIEN,ERR
. S FDA(80.1,"+1,",.01)=ICDCOD ; Code Number (.01)
. S FDA(80.1,"+1,",4)=ICDPX ; Operation/Procedure (4)
. D UPDATE^DIE(,"FDA","NEWIEN","ERR")
. I $D(ERR) D RSLT^AUM13EN("ERROR: Lookup/Add of CODE '"_ICDCOD_"' FAILED.") Q
. E S ICDMOD=ICDMOD_"N"_$J("",3)
. S ICDIEN=NEWIEN(1)
Q:'ICDIEN
I $L(ICDMOD)<1 S ICDMOD=" "_$J("",3)
; STORE PREVIOUS ACTIVATION DATE
S ICDPYR=$$GET1^DIQ(80.1,ICDIEN,12,"I")
;
K FDA
I TYPE'="INA" D
. S ICDMOD=ICDMOD_$S($$GET1^DIQ(80.1,ICDIEN,4,"I")'=ICDPX:"S",1:" ")_$J("",5)
. S ICDMOD=ICDMOD_$S($$GET1^DIQ(80.1,ICDIEN,10,"I")'=ICDDES:"L",1:" ")_$J("",4)
. S ICDMOD=ICDMOD_$S($$GET1^DIQ(80.1,ICDIEN,9.5,"I")'=ICDSEX:"X",1:" ")
. S FDA(80.1,ICDIEN_",",.01)=ICDCOD ; Code Number (.01)
. S:ICDPX]"" FDA(80.1,ICDIEN_",",4)=ICDPX ; Operation/Procedure (4)
. S FDA(80.1,ICDIEN_",",9.5)=$S(ICDSEX]"":ICDSEX,1:"@") ; Sex (9.5)
. S:ICDDES]"" FDA(80.1,ICDIEN_",",10)=ICDDES ; Description (10)
. S:'ICDPYR FDA(80.1,ICDIEN_",",12)=ICDYR ; Activation Date (12)
. S FDA(80.1,ICDIEN_",",100)="@" ; Inactive Flag (100)
. S FDA(80.1,ICDIEN_",",102)="@" ; Inactive Date (102)
. S FDA(80.1,ICDIEN_",",2100000)=ICDYR ; Date Last Update (2100000)
. S:ICDMOD["N" FDA(80.1,ICDIEN_",",9999999.04)=ICDYR ; Date Added (9999999.04)
E D
. S FDA(80.1,ICDIEN_",",100)=1 ; Inactive Flag (100)
. S FDA(80.1,ICDIEN_",",102)=ICDYR ; Inactive Date (102)
. S FDA(80.1,ICDIEN_",",2100000)=ICDYR ; Date Last Update (2100000)
D UPDATE^DIE(,"FDA",)
; Major Diagnostic Category (7)
K FDA,FDAIEN,ICDRES
I TYPE'="INA",ICDMDRG]"" D
. ; Remove previous MDCs
. K ICDRES
. D GETS^DIQ(80.1,ICDIEN_",","7*","","ICDRES")
. S CNT=0 F S CNT=$O(ICDRES(80.12,CNT)) Q:'CNT D
. . S ICDRES(80.12,CNT,.01)="@"
. D UPDATE^DIE(,"ICDRES",)
. K FDA,FDAIEN
. F CNT=1:1:$L(ICDMDRG,"~") S ICDTMP=$P(ICDMDRG,"~",CNT) Q:'ICDTMP D
. . S ICDMDC=$P(ICDTMP,"-",1)
. . S ICDDRG=$P(ICDTMP,"-",2)
. . S FDA(80.12,"+"_CNT_","_ICDIEN_",",.01)=ICDMDC
. . S FDAIEN(CNT)=+ICDMDC
. . F CNT2=1:1:$S($L(ICDDRG,",")<7:$L(ICDDRG,","),1:6) S FDA(80.12,"+"_CNT_","_ICDIEN_",",CNT2)=$P(ICDDRG,",",CNT2)
. . D UPDATE^DIE(,"FDA","FDAIEN")
; Effective Date (Versioned) (66)
K FDA
S FDA(80.166,"?+1,"_ICDIEN_",",.01)=ICDYR ; Effective Date (.01)
S FDA(80.166,"?+1,"_ICDIEN_",",.02)=$S(TYPE="INA":0,1:1) ; Status (.02)
D UPDATE^DIE(,"FDA",)
; Operation/Proc (Versioned) (67)
K FDA
I TYPE'="INA" D
. S FDA(80.167,"?+1,"_ICDIEN_",",.01)=ICDYR ; Version Date (.01)
. S FDA(80.167,"?+1,"_ICDIEN_",",1)=$S(ICDPX]"":ICDPX,1:"@") ; Operation/Proc (Versioned) (1)
. D UPDATE^DIE(,"FDA",)
; Description (Versioned) (68)
K FDA
I TYPE'="INA" D
. S FDA(80.168,"?+1,"_ICDIEN_",",.01)=ICDYR ; Version Date (.01)
. S FDA(80.168,"?+1,"_ICDIEN_",",1)=$S(ICDDES]"":ICDDES,1:"@") ; Description (Versioned) (1)
. D UPDATE^DIE(,"FDA",)
; DRG Grouper Effective Date (Versioned) (71)
K FDA,NEWIEN
I TYPE'="INA",ICDMDRG]"" D
. S FDA(80.171,"?+1,"_ICDIEN_",",.01)=ICDYR ; DRG Grouper Effective Date (.01)
. D UPDATE^DIE(,"FDA","NEWIEN")
. I $D(NEWIEN) D
. . ; Remove previous MDCs
. . K ICDRES
. . D GETS^DIQ(80.171,NEWIEN(1)_","_ICDIEN,"1*","","ICDRES")
. . S CNT=0 F S CNT=$O(ICDRES(80.1711,CNT)) Q:'CNT D
. . . S ICDRES(80.1711,CNT,.01)="@"
. . D UPDATE^DIE(,"ICDRES",)
. . ; Add new MDCs
. . F CNT=1:1:$L(ICDMDRG,"~") S ICDTMP=$P(ICDMDRG,"~",CNT) Q:'ICDTMP D
. . . K FDA
. . . S ICDMDC=$P(ICDTMP,"-",1)
. . . S ICDDRG=$P(ICDTMP,"-",2)
. . . S FDA(80.1711,"+1,"_NEWIEN(1)_","_ICDIEN_",",.01)=ICDMDC
. . . F CNT2=1:1:$L(ICDDRG,",") S FDA(80.17111,"+"_(CNT2+1)_",+1,"_NEWIEN(1)_","_ICDIEN_",",.01)=$P(ICDDRG,",",CNT2)
. . . D UPDATE^DIE(,"FDA",)
; Restore Activation Date (12)
K FDA
I TYPE'="INA",ICDPYR'=$$GET1^DIQ(80.1,ICDIEN,12,"I") D
. S FDA(80.1,ICDIEN_",",12)=ICDPYR ; Activation Date (12)
. D UPDATE^DIE(,"FDA",)
;
S:ICDMOD["N" ICDMOD="N"
I ICDMOD'=$J("",16) D RSLT^AUM13EN($J("",4)_ICDCOD_$J("",10-$L(ICDCOD))_$E(ICDPX,1,24)_$J("",27-$L($E(ICDPX,1,24)))_ICDMOD)
;
Q
REMVER(FILE,IEN,YEAR) ; REMOVE VERSIONED DATA MORE RECENT THAN UPDATE DATE
N RES,CNT,FDA,TMP
D LIST^DIC(FILE,","_IEN_",","@;.01","IP",,,,,,,"RES")
S CNT=0 F S CNT=$O(RES("DILIST",CNT)) Q:'CNT D
. S TMP=RES("DILIST",CNT,0)
. I $P(TMP,"^",2)>YEAR D
. . K FDA
. . S FDA(FILE,$P(TMP,"^",1)_","_IEN_",",.01)="@"
. . D UPDATE^DIE(,"FDA",)
Q
GETRNG(AGE) ; RETURN DELIMITED AGE RANGE
N CNT,TEXT,RES
F CNT=1:1 S TEXT=$P($T(AGES+CNT),";;",2) Q:TEXT="END" I $P(TEXT,"^",1)=AGE S RES=TEXT
Q:$D(RES) RES
Q ""
;
;AGE RANGES
;Medicare Age Category^Age Low^Age High
AGES ;;
;;NEWBORN^0^365
;;PEDIATRIC^0^6209
;;MATERNITY^4383^20088
;;ADULT^5478^45291
;;END
AUM131 ;IHS/OIT/NKD - ICD 9 UPDATE 08/30/2012 ;
+1 ;;13.0;TABLE MAINTENANCE;;AUG 30,2012;Build 1
+2 ;
+3 QUIT
UPDATE ; EP - MAIN DRIVER
+1 NEW YEAR,ROOT
+2 FOR YEAR=2013
Begin DoDot:1
+3 SET ROOT="^ICD9("
+4 DO UPDDX(YEAR)
+5 SET ROOT="^ICD0("
+6 DO UPDPX(YEAR)
End DoDot:1
+7 QUIT
UPDDX(YEAR) ; ICD9 DIAGNOSIS FILE DRIVER
+1 NEW TYPE,ICDCNT
+2 FOR TYPE="REV"
Begin DoDot:1
+3 DO RSLT^AUM13EN("ICD 9 DIAGNOSIS, "_YEAR_" "_$SELECT(TYPE="NEW":TYPE,TYPE="REV":"REVISED",TYPE="INA":"INACTIVATED",1:"")_" CODES:",1)
+4 DO RSLT^AUM13EN($JUSTIFY("",4)_"CODE"_$JUSTIFY("",6)_"DIAGNOSIS"_$JUSTIFY("",18)_"NEW"_$JUSTIFY("",1)_"SHORT"_$JUSTIFY("",1)_"LONG"_$JUSTIFY("",1)_"SEX"_$JUSTIFY("",1)_"AGE"_$JUSTIFY("",1)_"CC")
+5 DO RSLT^AUM13EN($JUSTIFY("",4)_"----"_$JUSTIFY("",6)_"---------"_$JUSTIFY("",18)_"---"_$JUSTIFY("",1)_"-----"_$JUSTIFY("",1)_"----"_$JUSTIFY("",1)_"---"_$JUSTIFY("",1)_"---"_$JUSTIFY("",1)_"--")
+6 SET ICDCNT=0
FOR
SET ICDCNT=$ORDER(^AUMDATA(ICDCNT))
IF 'ICDCNT
QUIT
Begin DoDot:2
+7 IF $PIECE(^AUMDATA(ICDCNT,0),U,2)'=(TYPE_"DX")
QUIT
+8 IF $PIECE(^AUMDATA(ICDCNT,0),U,3)'=YEAR
QUIT
+9 DO DXUPD($PIECE(^AUMDATA(ICDCNT,0),U,3,9),TYPE)
End DoDot:2
End DoDot:1
+10 QUIT
DXUPD(AUMDATA,TYPE) ; ICD9 DIAGNOSIS FILE UPDATE
+1 NEW ICDIEN,CNT,FDA,NEWIEN,ERR,ICDRES,ICDMOD
+2 NEW ICDYR,ICDCOD,ICDDX,ICDDES,ICDSEX,ICDAGE,ICDRNG,ICDCC,ICDMDRG,ICDMDC,ICDDRG,ICDPYR
+3 SET (ICDMOD,ICDRNG,ICDMDC,ICDDRG)=""
+4 SET ICDYR=$PIECE(AUMDATA,U,1)
SET ICDYR=$EXTRACT(ICDYR,3,4)+299
SET ICDYR=ICDYR_"1001"
+5 SET ICDCOD=$PIECE(AUMDATA,U,2)
+6 SET ICDDX=$PIECE(AUMDATA,U,3)
+7 SET ICDDES=$PIECE(AUMDATA,U,4)
+8 SET ICDSEX=$PIECE($PIECE(AUMDATA,U,5),"~",1)
+9 SET ICDAGE=$PIECE($PIECE(AUMDATA,U,5),"~",2)
+10 SET ICDCC=$PIECE(AUMDATA,U,6)
+11 SET ICDMDRG=$PIECE(AUMDATA,U,7)
+12 ;
+13 SET ICDIEN=$ORDER(@(ROOT_"""BA"","""_ICDCOD_" "","""")"),-1)
+14 IF ('ICDIEN&(ICDCOD'["."))
SET ICDCOD=ICDCOD_"."
+15 SET ICDIEN=$ORDER(@(ROOT_"""BA"","""_ICDCOD_" "","""")"),-1)
+16 ;
+17 IF TYPE'="INA"
IF 'ICDIEN
Begin DoDot:1
+18 KILL FDA,NEWIEN,ERR
+19 ; Code Number (.01)
SET FDA(80,"+1,",.01)=ICDCOD
+20 ; Diagnosis (3)
SET FDA(80,"+1,",3)=ICDDX
+21 DO UPDATE^DIE(,"FDA","NEWIEN","ERR")
+22 IF $DATA(ERR)
DO RSLT^AUM13EN("ERROR: Lookup/Add of CODE '"_ICDCOD_"' FAILED.")
QUIT
+23 IF '$TEST
SET ICDMOD=ICDMOD_"N"_$JUSTIFY("",3)
+24 SET ICDIEN=NEWIEN(1)
End DoDot:1
+25 IF 'ICDIEN
QUIT
+26 IF $LENGTH(ICDMOD)<1
SET ICDMOD=" "_$JUSTIFY("",3)
+27 ; MDC EXTRACTOR
+28 FOR CNT=1:1:$LENGTH(ICDMDRG,"~")
SET ICDMDC=ICDMDC_$SELECT(CNT>1:"^",1:"")_$PIECE($PIECE(ICDMDRG,"~",CNT),"-",1)
+29 FOR CNT=1:1:$LENGTH(ICDMDRG,"~")
SET ICDDRG=ICDDRG_$SELECT(CNT>1:"^",1:"")_$TRANSLATE($PIECE($PIECE(ICDMDRG,"~",CNT),"-",2),",","^")
+30 ; AGE RANGE EXTRACTOR
+31 IF $LENGTH(ICDAGE)>0
Begin DoDot:1
+32 SET ICDRNG=$$GETRNG(ICDAGE)
+33 IF $LENGTH(ICDRNG)<1
DO RSLT^AUM13EN("ERROR: Incorrect Age Range")
End DoDot:1
+34 ; STORE PREVIOUS ACTIVATION DATE
+35 SET ICDPYR=$$GET1^DIQ(80,ICDIEN,16,"I")
+36 ;
+37 KILL FDA
+38 IF TYPE'="INA"
Begin DoDot:1
+39 SET ICDMOD=ICDMOD_$SELECT($$GET1^DIQ(80,ICDIEN,3,"I")'=ICDDX:"S",1:" ")_$JUSTIFY("",5)
+40 SET ICDMOD=ICDMOD_$SELECT($$GET1^DIQ(80,ICDIEN,10,"I")'=ICDDES:"L",1:" ")_$JUSTIFY("",4)
+41 SET ICDMOD=ICDMOD_$SELECT($$GET1^DIQ(80,ICDIEN,9.5,"I")'=ICDSEX:"X",1:" ")_$JUSTIFY("",3)
+42 SET ICDMOD=ICDMOD_$SELECT(($$GET1^DIQ(80,ICDIEN,14,"I")_$$GET1^DIQ(80,ICDIEN,15,"I"))'=($PIECE(ICDRNG,"^",2)_$PIECE(ICDRNG,"^",3)):"A",1:" ")_$JUSTIFY("",3)
+43 SET ICDMOD=ICDMOD_$SELECT($$GET1^DIQ(80,ICDIEN,70,"I")'=$SELECT(ICDCC["CC":1,1:""):"C",1:" ")
+44 ; Code Number (.01)
SET FDA(80,ICDIEN_",",.01)=ICDCOD
+45 ; Diagnosis (3)
IF ICDDX]""
SET FDA(80,ICDIEN_",",3)=ICDDX
+46 ; Major Diagnostic Category (5)
IF ICDMDC]""
SET FDA(80,ICDIEN_",",5)=$PIECE(ICDMDC,"^",1)
+47 ; Sex (9.5)
SET FDA(80,ICDIEN_",",9.5)=$SELECT(ICDSEX]"":ICDSEX,1:"@")
+48 ; Description (10)
IF ICDDES]""
SET FDA(80,ICDIEN_",",10)=ICDDES
+49 ; Activation Date (16)
IF 'ICDPYR
SET FDA(80,ICDIEN_",",16)=ICDYR
+50 ; DRGa (60)
IF $PIECE(ICDDRG,"^",1)]""
SET FDA(80,ICDIEN_",",60)=$PIECE(ICDDRG,"^",1)
+51 ; DRGb (61)
IF $PIECE(ICDDRG,"^",2)]""
SET FDA(80,ICDIEN_",",61)=$PIECE(ICDDRG,"^",2)
+52 ; DRGc (62)
IF $PIECE(ICDDRG,"^",3)]""
SET FDA(80,ICDIEN_",",62)=$PIECE(ICDDRG,"^",3)
+53 ; DRGd (63)
IF $PIECE(ICDDRG,"^",4)]""
SET FDA(80,ICDIEN_",",63)=$PIECE(ICDDRG,"^",4)
+54 ; DRGe (64)
IF $PIECE(ICDDRG,"^",5)]""
SET FDA(80,ICDIEN_",",64)=$PIECE(ICDDRG,"^",5)
+55 ; DRGf (65)
IF $PIECE(ICDDRG,"^",6)]""
SET FDA(80,ICDIEN_",",65)=$PIECE(ICDDRG,"^",6)
+56 ; Age Low (14)
SET FDA(80,ICDIEN_",",14)=$SELECT($PIECE(ICDRNG,"^",2)]"":$PIECE(ICDRNG,"^",2),1:"@")
+57 ; Age High (15)
SET FDA(80,ICDIEN_",",15)=$SELECT($PIECE(ICDRNG,"^",3)]"":$PIECE(ICDRNG,"^",3),1:"@")
+58 ; Lower Age (9999999.01)
SET FDA(80,ICDIEN_",",9999999.01)=$SELECT($PIECE(ICDRNG,"^",2)]"":$PIECE(ICDRNG,"^",2),1:"@")
+59 ; Upper Age (9999999.02)
SET FDA(80,ICDIEN_",",9999999.02)=$SELECT($PIECE(ICDRNG,"^",3)]"":$PIECE(ICDRNG,"^",3),1:"@")
+60 ; Complication/Comorbidity (70)
SET FDA(80,ICDIEN_",",70)=$SELECT(ICDCC["CC":1,1:"@")
+61 ; Inactive Flag (100)
SET FDA(80,ICDIEN_",",100)="@"
+62 ; Inactive Date (102)
SET FDA(80,ICDIEN_",",102)="@"
+63 ; Date Last Update (2100000)
SET FDA(80,ICDIEN_",",2100000)=ICDYR
+64 ; Date Added (9999999.04)
IF ICDMOD["N"
SET FDA(80,ICDIEN_",",9999999.04)=ICDYR
End DoDot:1
+65 IF '$TEST
Begin DoDot:1
+66 ; Inactive Flag (100)
SET FDA(80,ICDIEN_",",100)=1
+67 ; Inactive Date (102)
SET FDA(80,ICDIEN_",",102)=ICDYR
+68 ; Date Last Update (2100000)
SET FDA(80,ICDIEN_",",2100000)=ICDYR
End DoDot:1
+69 DO UPDATE^DIE(,"FDA",)
+70 ; Effective Date (Versioned) (66)
+71 KILL FDA
+72 ; Effective Date (.01)
SET FDA(80.066,"?+1,"_ICDIEN_",",.01)=ICDYR
+73 ; Status (.02)
SET FDA(80.066,"?+1,"_ICDIEN_",",.02)=$SELECT(TYPE="INA":0,1:1)
+74 DO UPDATE^DIE(,"FDA",)
+75 ; Diagnosis (Versioned) (67)
+76 KILL FDA
+77 IF TYPE'="INA"
Begin DoDot:1
+78 ; Version Date (.01)
SET FDA(80.067,"?+1,"_ICDIEN_",",.01)=ICDYR
+79 ; Diagnosis (Versioned) (1)
SET FDA(80.067,"?+1,"_ICDIEN_",",1)=$SELECT(ICDDX]"":ICDDX,1:"@")
+80 DO UPDATE^DIE(,"FDA",)
End DoDot:1
+81 ; Description (Versioned) (68)
+82 KILL FDA
+83 IF TYPE'="INA"
Begin DoDot:1
+84 ; Version Date (.01)
SET FDA(80.068,"?+1,"_ICDIEN_",",.01)=ICDYR
+85 ; Description (Versioned) (1)
SET FDA(80.068,"?+1,"_ICDIEN_",",1)=$SELECT(ICDDES]"":ICDDES,1:"@")
+86 DO UPDATE^DIE(,"FDA",)
End DoDot:1
+87 ; DRG Grouper Effective Date (Versioned) (71)
+88 KILL FDA,NEWIEN
+89 IF TYPE'="INA"
IF ICDDRG]""
Begin DoDot:1
+90 ; DRG Grouper Effective Date (.01)
SET FDA(80.071,"?+1,"_ICDIEN_",",.01)=ICDYR
+91 DO UPDATE^DIE(,"FDA","NEWIEN")
+92 IF $DATA(NEWIEN)
Begin DoDot:2
+93 ; Remove previous DRGs
+94 KILL ICDRES
+95 DO GETS^DIQ(80.071,NEWIEN(1)_","_ICDIEN,"1*","","ICDRES")
+96 SET CNT=0
FOR
SET CNT=$ORDER(ICDRES(80.711,CNT))
IF 'CNT
QUIT
Begin DoDot:3
+97 SET ICDRES(80.711,CNT,.01)="@"
End DoDot:3
+98 DO UPDATE^DIE(,"ICDRES",)
+99 ; Add new DRGs
+100 FOR CNT=1:1:$LENGTH(ICDDRG,"^")
SET FDA(80.711,"+"_CNT_","_NEWIEN(1)_","_ICDIEN_",",.01)=$PIECE(ICDDRG,"^",CNT)
+101 DO UPDATE^DIE(,"FDA",)
End DoDot:2
End DoDot:1
+102 ; MDC Effective Date (Versioned) (72)
+103 KILL FDA
+104 IF TYPE'="INA"
IF ICDMDC]""
Begin DoDot:1
+105 ; MDC Effective Date (.01)
SET FDA(80.072,"?+1,"_ICDIEN_",",.01)=ICDYR
+106 ; MDC (1)
SET FDA(80.072,"?+1,"_ICDIEN_",",1)=$SELECT(ICDMDC]"":$PIECE(ICDMDC,"^",1),1:"@")
+107 DO UPDATE^DIE(,"FDA",)
End DoDot:1
+108 ; Versioned CC (Versioned) (103)
+109 KILL FDA
+110 IF TYPE'="INA"
IF ICDCC]""
Begin DoDot:1
+111 ; Effective Date (.01)
SET FDA(80.0103,"?+1,"_ICDIEN_",",.01)=ICDYR
+112 ; Complication/Comorbidity (1)
SET FDA(80.0103,"?+1,"_ICDIEN_",",1)=$SELECT(ICDCC="N":0,ICDCC="CC":1,ICDCC="MCC":2,1:"@")
+113 DO UPDATE^DIE(,"FDA",)
End DoDot:1
+114 ; Restore Activation Date (16)
+115 KILL FDA
+116 IF TYPE'="INA"
IF ICDPYR'=$$GET1^DIQ(80,ICDIEN,16,"I")
Begin DoDot:1
+117 ; Activation Date (16)
SET FDA(80,ICDIEN_",",16)=ICDPYR
+118 DO UPDATE^DIE(,"FDA",)
End DoDot:1
+119 ;
+120 IF ICDMOD["N"
SET ICDMOD="N"
+121 IF ICDMOD'=$JUSTIFY("",24)
DO RSLT^AUM13EN($JUSTIFY("",4)_ICDCOD_$JUSTIFY("",10-$LENGTH(ICDCOD))_$EXTRACT(ICDDX,1,24)_$JUSTIFY("",27-$LENGTH($EXTRACT(ICDDX,1,24)))_ICDMOD)
+122 ;
+123 QUIT
UPDPX(YEAR) ;ICD9 OPERATION/PROCEDURE FILE DRIVER
+1 NEW TYPE,ICDCNT
+2 FOR TYPE="REV"
Begin DoDot:1
+3 DO RSLT^AUM13EN("ICD 9 OPERATION/PROCEDURE, "_YEAR_" "_$SELECT(TYPE="NEW":TYPE,TYPE="REV":"REVISED",TYPE="INA":"INACTIVATED",1:"")_" CODES:",1)
+4 DO RSLT^AUM13EN($JUSTIFY("",4)_"CODE"_$JUSTIFY("",6)_"DESCRIPTION"_$JUSTIFY("",16)_"NEW"_$JUSTIFY("",1)_"SHORT"_$JUSTIFY("",1)_"LONG"_$JUSTIFY("",1)_"SEX")
+5 DO RSLT^AUM13EN($JUSTIFY("",4)_"----"_$JUSTIFY("",6)_"-----------"_$JUSTIFY("",16)_"---"_$JUSTIFY("",1)_"-----"_$JUSTIFY("",1)_"----"_$JUSTIFY("",1)_"---")
+6 SET ICDCNT=0
FOR
SET ICDCNT=$ORDER(^AUMDATA(ICDCNT))
IF 'ICDCNT
QUIT
Begin DoDot:2
+7 IF $PIECE(^AUMDATA(ICDCNT,0),U,2)'=(TYPE_"PX")
QUIT
+8 IF $PIECE(^AUMDATA(ICDCNT,0),U,3)'=YEAR
QUIT
+9 DO PXUPD($PIECE(^AUMDATA(ICDCNT,0),U,3,9),TYPE)
End DoDot:2
End DoDot:1
+10 QUIT
PXUPD(AUMDATA,TYPE) ;ICD9 OPERATION/PROCEDURE FILE UPDATE
+1 NEW ICDIEN,CNT,CNT2,FDA,FDAIEN,NEWIEN,ERR,ICDRES,ICDTMP,ICDMOD
+2 NEW ICDYR,ICDCOD,ICDPX,ICDDES,ICDSEX,ICDMDRG,ICDMDC,ICDDRG,ICDPYR
+3 SET ICDMOD=""
+4 SET ICDYR=$PIECE(AUMDATA,U,1)
SET ICDYR=$EXTRACT(ICDYR,3,4)+299
SET ICDYR=ICDYR_"1001"
+5 SET ICDCOD=$PIECE(AUMDATA,U,2)
+6 SET ICDPX=$PIECE(AUMDATA,U,3)
+7 SET ICDDES=$PIECE(AUMDATA,U,4)
+8 SET ICDSEX=$PIECE(AUMDATA,U,5)
+9 SET ICDMDRG=$PIECE(AUMDATA,U,7)
+10 ;
+11 SET ICDIEN=$ORDER(@(ROOT_"""BA"","""_ICDCOD_" "","""")"),-1)
+12 ;
+13 IF TYPE'="INA"
IF 'ICDIEN
Begin DoDot:1
+14 KILL FDA,NEWIEN,ERR
+15 ; Code Number (.01)
SET FDA(80.1,"+1,",.01)=ICDCOD
+16 ; Operation/Procedure (4)
SET FDA(80.1,"+1,",4)=ICDPX
+17 DO UPDATE^DIE(,"FDA","NEWIEN","ERR")
+18 IF $DATA(ERR)
DO RSLT^AUM13EN("ERROR: Lookup/Add of CODE '"_ICDCOD_"' FAILED.")
QUIT
+19 IF '$TEST
SET ICDMOD=ICDMOD_"N"_$JUSTIFY("",3)
+20 SET ICDIEN=NEWIEN(1)
End DoDot:1
+21 IF 'ICDIEN
QUIT
+22 IF $LENGTH(ICDMOD)<1
SET ICDMOD=" "_$JUSTIFY("",3)
+23 ; STORE PREVIOUS ACTIVATION DATE
+24 SET ICDPYR=$$GET1^DIQ(80.1,ICDIEN,12,"I")
+25 ;
+26 KILL FDA
+27 IF TYPE'="INA"
Begin DoDot:1
+28 SET ICDMOD=ICDMOD_$SELECT($$GET1^DIQ(80.1,ICDIEN,4,"I")'=ICDPX:"S",1:" ")_$JUSTIFY("",5)
+29 SET ICDMOD=ICDMOD_$SELECT($$GET1^DIQ(80.1,ICDIEN,10,"I")'=ICDDES:"L",1:" ")_$JUSTIFY("",4)
+30 SET ICDMOD=ICDMOD_$SELECT($$GET1^DIQ(80.1,ICDIEN,9.5,"I")'=ICDSEX:"X",1:" ")
+31 ; Code Number (.01)
SET FDA(80.1,ICDIEN_",",.01)=ICDCOD
+32 ; Operation/Procedure (4)
IF ICDPX]""
SET FDA(80.1,ICDIEN_",",4)=ICDPX
+33 ; Sex (9.5)
SET FDA(80.1,ICDIEN_",",9.5)=$SELECT(ICDSEX]"":ICDSEX,1:"@")
+34 ; Description (10)
IF ICDDES]""
SET FDA(80.1,ICDIEN_",",10)=ICDDES
+35 ; Activation Date (12)
IF 'ICDPYR
SET FDA(80.1,ICDIEN_",",12)=ICDYR
+36 ; Inactive Flag (100)
SET FDA(80.1,ICDIEN_",",100)="@"
+37 ; Inactive Date (102)
SET FDA(80.1,ICDIEN_",",102)="@"
+38 ; Date Last Update (2100000)
SET FDA(80.1,ICDIEN_",",2100000)=ICDYR
+39 ; Date Added (9999999.04)
IF ICDMOD["N"
SET FDA(80.1,ICDIEN_",",9999999.04)=ICDYR
End DoDot:1
+40 IF '$TEST
Begin DoDot:1
+41 ; Inactive Flag (100)
SET FDA(80.1,ICDIEN_",",100)=1
+42 ; Inactive Date (102)
SET FDA(80.1,ICDIEN_",",102)=ICDYR
+43 ; Date Last Update (2100000)
SET FDA(80.1,ICDIEN_",",2100000)=ICDYR
End DoDot:1
+44 DO UPDATE^DIE(,"FDA",)
+45 ; Major Diagnostic Category (7)
+46 KILL FDA,FDAIEN,ICDRES
+47 IF TYPE'="INA"
IF ICDMDRG]""
Begin DoDot:1
+48 ; Remove previous MDCs
+49 KILL ICDRES
+50 DO GETS^DIQ(80.1,ICDIEN_",","7*","","ICDRES")
+51 SET CNT=0
FOR
SET CNT=$ORDER(ICDRES(80.12,CNT))
IF 'CNT
QUIT
Begin DoDot:2
+52 SET ICDRES(80.12,CNT,.01)="@"
End DoDot:2
+53 DO UPDATE^DIE(,"ICDRES",)
+54 KILL FDA,FDAIEN
+55 FOR CNT=1:1:$LENGTH(ICDMDRG,"~")
SET ICDTMP=$PIECE(ICDMDRG,"~",CNT)
IF 'ICDTMP
QUIT
Begin DoDot:2
+56 SET ICDMDC=$PIECE(ICDTMP,"-",1)
+57 SET ICDDRG=$PIECE(ICDTMP,"-",2)
+58 SET FDA(80.12,"+"_CNT_","_ICDIEN_",",.01)=ICDMDC
+59 SET FDAIEN(CNT)=+ICDMDC
+60 FOR CNT2=1:1:$SELECT($LENGTH(ICDDRG,",")<7:$LENGTH(ICDDRG,","),1:6)
SET FDA(80.12,"+"_CNT_","_ICDIEN_",",CNT2)=$PIECE(ICDDRG,",",CNT2)
+61 DO UPDATE^DIE(,"FDA","FDAIEN")
End DoDot:2
End DoDot:1
+62 ; Effective Date (Versioned) (66)
+63 KILL FDA
+64 ; Effective Date (.01)
SET FDA(80.166,"?+1,"_ICDIEN_",",.01)=ICDYR
+65 ; Status (.02)
SET FDA(80.166,"?+1,"_ICDIEN_",",.02)=$SELECT(TYPE="INA":0,1:1)
+66 DO UPDATE^DIE(,"FDA",)
+67 ; Operation/Proc (Versioned) (67)
+68 KILL FDA
+69 IF TYPE'="INA"
Begin DoDot:1
+70 ; Version Date (.01)
SET FDA(80.167,"?+1,"_ICDIEN_",",.01)=ICDYR
+71 ; Operation/Proc (Versioned) (1)
SET FDA(80.167,"?+1,"_ICDIEN_",",1)=$SELECT(ICDPX]"":ICDPX,1:"@")
+72 DO UPDATE^DIE(,"FDA",)
End DoDot:1
+73 ; Description (Versioned) (68)
+74 KILL FDA
+75 IF TYPE'="INA"
Begin DoDot:1
+76 ; Version Date (.01)
SET FDA(80.168,"?+1,"_ICDIEN_",",.01)=ICDYR
+77 ; Description (Versioned) (1)
SET FDA(80.168,"?+1,"_ICDIEN_",",1)=$SELECT(ICDDES]"":ICDDES,1:"@")
+78 DO UPDATE^DIE(,"FDA",)
End DoDot:1
+79 ; DRG Grouper Effective Date (Versioned) (71)
+80 KILL FDA,NEWIEN
+81 IF TYPE'="INA"
IF ICDMDRG]""
Begin DoDot:1
+82 ; DRG Grouper Effective Date (.01)
SET FDA(80.171,"?+1,"_ICDIEN_",",.01)=ICDYR
+83 DO UPDATE^DIE(,"FDA","NEWIEN")
+84 IF $DATA(NEWIEN)
Begin DoDot:2
+85 ; Remove previous MDCs
+86 KILL ICDRES
+87 DO GETS^DIQ(80.171,NEWIEN(1)_","_ICDIEN,"1*","","ICDRES")
+88 SET CNT=0
FOR
SET CNT=$ORDER(ICDRES(80.1711,CNT))
IF 'CNT
QUIT
Begin DoDot:3
+89 SET ICDRES(80.1711,CNT,.01)="@"
End DoDot:3
+90 DO UPDATE^DIE(,"ICDRES",)
+91 ; Add new MDCs
+92 FOR CNT=1:1:$LENGTH(ICDMDRG,"~")
SET ICDTMP=$PIECE(ICDMDRG,"~",CNT)
IF 'ICDTMP
QUIT
Begin DoDot:3
+93 KILL FDA
+94 SET ICDMDC=$PIECE(ICDTMP,"-",1)
+95 SET ICDDRG=$PIECE(ICDTMP,"-",2)
+96 SET FDA(80.1711,"+1,"_NEWIEN(1)_","_ICDIEN_",",.01)=ICDMDC
+97 FOR CNT2=1:1:$LENGTH(ICDDRG,",")
SET FDA(80.17111,"+"_(CNT2+1)_",+1,"_NEWIEN(1)_","_ICDIEN_",",.01)=$PIECE(ICDDRG,",",CNT2)
+98 DO UPDATE^DIE(,"FDA",)
End DoDot:3
End DoDot:2
End DoDot:1
+99 ; Restore Activation Date (12)
+100 KILL FDA
+101 IF TYPE'="INA"
IF ICDPYR'=$$GET1^DIQ(80.1,ICDIEN,12,"I")
Begin DoDot:1
+102 ; Activation Date (12)
SET FDA(80.1,ICDIEN_",",12)=ICDPYR
+103 DO UPDATE^DIE(,"FDA",)
End DoDot:1
+104 ;
+105 IF ICDMOD["N"
SET ICDMOD="N"
+106 IF ICDMOD'=$JUSTIFY("",16)
DO RSLT^AUM13EN($JUSTIFY("",4)_ICDCOD_$JUSTIFY("",10-$LENGTH(ICDCOD))_$EXTRACT(ICDPX,1,24)_$JUSTIFY("",27-$LENGTH($EXTRACT(ICDPX,1,24)))_ICDMOD)
+107 ;
+108 QUIT
REMVER(FILE,IEN,YEAR) ; REMOVE VERSIONED DATA MORE RECENT THAN UPDATE DATE
+1 NEW RES,CNT,FDA,TMP
+2 DO LIST^DIC(FILE,","_IEN_",","@;.01","IP",,,,,,,"RES")
+3 SET CNT=0
FOR
SET CNT=$ORDER(RES("DILIST",CNT))
IF 'CNT
QUIT
Begin DoDot:1
+4 SET TMP=RES("DILIST",CNT,0)
+5 IF $PIECE(TMP,"^",2)>YEAR
Begin DoDot:2
+6 KILL FDA
+7 SET FDA(FILE,$PIECE(TMP,"^",1)_","_IEN_",",.01)="@"
+8 DO UPDATE^DIE(,"FDA",)
End DoDot:2
End DoDot:1
+9 QUIT
GETRNG(AGE) ; RETURN DELIMITED AGE RANGE
+1 NEW CNT,TEXT,RES
+2 FOR CNT=1:1
SET TEXT=$PIECE($TEXT(AGES+CNT),";;",2)
IF TEXT="END"
QUIT
IF $PIECE(TEXT,"^",1)=AGE
SET RES=TEXT
+3 IF $DATA(RES)
QUIT RES
+4 QUIT ""
+5 ;
+6 ;AGE RANGES
+7 ;Medicare Age Category^Age Low^Age High
AGES ;;
+1 ;;NEWBORN^0^365
+2 ;;PEDIATRIC^0^6209
+3 ;;MATERNITY^4383^20088
+4 ;;ADULT^5478^45291
+5 ;;END
