AUM17U ;IHS/OIT/NKD - UTILITY FOR ICD10 FY2017 - 08/18/2016 ;
;;17.0;ICD UPDATE;;AUG 18,2016;Build 1
;
Q
IEN(SYS) ; EP - FIND NEXT AVAILABLE IEN BASED ON SYS
N ROOT,CNT,IEN
S ROOT=$$ROOT^ICDEX($G(SYS)),IEN=0
I +$G(SYS)>2 F CNT=500001:1 Q:IEN S:'$D(@(ROOT_CNT_")")) IEN=CNT ; STARTING FROM 500001, FIND NEXT AVAILABLE IEN
E I +$G(SYS)<30 F CNT=499999:-1 Q:IEN S:'$D(@(ROOT_CNT_")")) IEN=CNT ; STARTING FROM 499999, FIND NEXT AVAILABLE IEN
Q IEN
;
EXC(IEN) ; EP - EXCLUDE ONE CODE FROM LOOKUP
N CODE,FDA,CNT,ERR,DIK,DA S IEN=$G(IEN) Q:'IEN "-1^Err:IEN"
S CODE=$$CODEC^ICDEX(80,IEN) Q:'$L(CODE) "-1^Err:Code"
M ^AICDZEXC(IEN)=^ICD9(IEN)
I $D(^ICD9(IEN,-9)) K ^ICD9(IEN,-9) ; DELETE -9 NODE FROM INCOMPLETE MERGE
S CNT=0 F S CNT=$O(^ICD9(IEN,66,CNT)) Q:'CNT S FDA(80.066,CNT_","_IEN_",",.01)="@"
I $D(FDA) D FILE^DIE(,"FDA","ERR")
S DIK="^ICD9(",DA=IEN D IX^DIK
D ^XBFMK
Q $S($D(ERR):"-1^Fail:"_$G(ERR("DIERR","1","TEXT",1)),1:"1^Done")
;
CMPRE ; EP - ICD10 DIAGNOSIS FILE PRE-TRANSFORM
; P1 = CODE ;P2 = HEADER ;P3 = SHORT ;P4 = LONG ;P5 = MS-DRG ;P6 = CC/MCC
; P7 = PDX CC ;P8 = AGE LOW ;P9 = AGE HIGH ;P10= SEX ;P11= UNACC PDX
N AUMC,AUMC2,AUMC3,AUMMDC,AUMTMP
S:INA P2=0
S:'P2 INA=1
S P4=$$UP^XLFSTR(P4)
; MDC/MS-DRG EXTRACTOR
S AUMMDC="" F AUMC=1:1:$L(P5,";") D
. S AUMMDC=+$P($P(P5,";",AUMC),"|",1) Q:AUMMDC'>0
. K AUMTMP
. F AUMC2=1:1:$L($P($P(P5,";",AUMC),"|",2),",") D
. . S AUMTMP=$P($P($P(P5,";",AUMC),"|",2),",",AUMC2)
. . Q:($E(AUMTMP,1)?1A)
. . F AUMC3=$P(AUMTMP,"-",1):1:$S($P(AUMTMP,"-",2)]"":$P(AUMTMP,"-",2),1:$P(AUMTMP,"-",1)) S AUMTMP(AUMC3)=""
. S AUMC2=0 F S AUMC2=$O(AUMTMP(AUMC2)) Q:'AUMC2 S P5(AUMMDC)=$G(P5(AUMMDC))_AUMC2_U
S P5A=$O(P5(0))
Q
;
PCSPRE ; EP - ICD10 OPERATION/PROCEDURE FILE PRE-TRANSFORM
; P1 = CODE ;P2 = HEADER ;P3 = SHORT ;P4 = LONG ;P5 = MS-DRG ;P6 = N/A
; P7 = N/A ;P8 = N/A ;P9 = N/A ;P10= SEX ;P11= N/A
N AUMC,AUMC2,AUMC3,AUMMDC,AUMTMP
S:INA P2=0
S:'P2 INA=1
S P4=$$UP^XLFSTR(P4)
; MDC/MS-DRG EXTRACTOR
S AUMMDC="" F AUMC=1:1:$L(P5,";") D
. S AUMMDC=+$P($P(P5,";",AUMC),"|",1) Q:AUMMDC'>0
. K AUMTMP
. F AUMC2=1:1:$L($P($P(P5,";",AUMC),"|",2),",") D
. . S AUMTMP=$P($P($P(P5,";",AUMC),"|",2),",",AUMC2)
. . Q:($E(AUMTMP,1)?1A)
. . F AUMC3=$P(AUMTMP,"-",1):1:$S($P(AUMTMP,"-",2)]"":$P(AUMTMP,"-",2),1:$P(AUMTMP,"-",1)) S AUMTMP(AUMC3)=""
. S AUMC2=0 F S AUMC2=$O(AUMTMP(AUMC2)) Q:'AUMC2 S P5(AUMMDC)=$G(P5(AUMMDC))_AUMC2_U
Q
;
CMDRG ; EP - ICD10 DIAGNOSIS FILE DRG UPDATE
N FDA,NEWIEN,AUMC,AUMC2,AUMD0,AUMU,AUMFR,AUMTO
;
D MD^ICDEX($$SYS^AUM17D(AUMT,4),AUMI,AUMDT,.AUMD0) ; DRG
S (AUMC,AUMU,AUMFR,AUMTO)="" F S AUMC=$O(P5(AUMC)) Q:'AUMC S AUMTO=AUMTO_P5(AUMC) ; INCOMING DRGS
; DIFF CHECK
I '$D(AUMD0) D
. S:AUMTO]"" AUMU=1
E D
. S AUMC=$O(AUMD0("")),AUMC2=$O(AUMD0(AUMC,"")),AUMFR=$P($G(AUMD0(AUMC,AUMC2)),";")
. S:AUMFR'=AUMTO AUMU=1
Q:'AUMU
; DRG Grouper Effective Date (Versioned) (71)
K FDA
S AUMC=0 F S AUMC=$O(^ICD9(AUMI,3,"B",AUMDT,AUMC)) Q:'AUMC S FDA(80.071,AUMC_","_AUMI_",",.01)="@"
I $D(FDA) D FILE^DIE(,"FDA")
; ENTRY IS NEEDED (TO ENSURE PROPER BEHAVIOR WHEN DRGs ARE REMOVED)
K FDA
S FDA(80.071,"?+1,"_AUMI_",",.01)=AUMDT ; DRG Grouper Effective Date (.01)
; Add new DRGs
F AUMC=1:1:$L(AUMTO,U) S:$P(AUMTO,U,AUMC)]"" FDA(80.711,"+"_(AUMC+1)_",?+1,"_AUMI_",",.01)=$P(AUMTO,U,AUMC)
;
D RLOG^AUM17D(AUML,"DRG",$TR(AUMFR,U,","),$TR(AUMTO,U,","))
D UPDATE^DIE(,"FDA",)
S:(AUMM']"") AUMM="MOD :"
Q
;
PCSDRG ; EP - ICD10 OPERATION/PROCEDURE FILE DRG UPDATE
N FDA,NEWIEN,AUMC,AUMC2,AUMD0,AUMD1,AUMU,AUMFR,AUMTO
;
D MD^ICDEX($$SYS^AUM17D(AUMT,4),AUMI,AUMDT,.AUMD0) ; DRG
S (AUMC,AUMU,AUMFR,AUMTO)="" F S AUMC=$O(P5(AUMC)) Q:'AUMC S AUMTO=AUMTO_AUMC_"|"_P5(AUMC)_";" ; INCOMING DRGS
; DIFF CHECK
I '$D(AUMD0) D
. S:AUMTO]"" AUMU=1
E D
. S AUMC="" F S AUMC=$O(AUMD0(AUMC)) Q:'AUMC S AUMC2="" F S AUMC2=$O(AUMD0(AUMC,AUMC2)) Q:'AUMC2 S AUMD1(AUMC2)=$P(AUMD0(AUMC,AUMC2),";")
. S AUMC="" F S AUMC=$O(AUMD1(AUMC)) Q:'AUMC S AUMFR=AUMFR_AUMC_"|"_AUMD1(AUMC)_";"
. S:AUMFR'=AUMTO AUMU=1
Q:'AUMU
; DRG Grouper Effective Date (Versioned) (71)
K FDA
S AUMC=0 F S AUMC=$O(^ICD0(AUMI,2,"B",AUMDT,AUMC)) Q:'AUMC S FDA(80.171,AUMC_","_AUMI_",",.01)="@"
I $D(FDA) D FILE^DIE(,"FDA")
; ENTRY IS NEEDED (TO ENSURE PROPER BEHAVIOR WHEN DRGs ARE REMOVED)
K FDA
S FDA(80.171,"?+1,"_AUMI_",",.01)=AUMDT ; DRG Grouper Effective Date (.01)
; Add new DRGs
S AUMC=0 F S AUMC=$O(P5(AUMC)) Q:'AUMC D
. S FDA(80.1711,"+"_(AUMC+1)_",?+1,"_AUMI_",",.01)=AUMC
. F AUMC2=1:1:$L(P5(AUMC),U) S:$P(P5(AUMC),U,AUMC2)]"" FDA(80.17111,"+"_(AUMC+1*1000+AUMC2)_",+"_(AUMC+1)_",?+1,"_AUMI_",",.01)=$P(P5(AUMC),U,AUMC2)
;
D RLOG^AUM17D(AUML,"DRG",$TR($TR(AUMFR,U,","),"|","-"),$TR($TR(AUMTO,U,","),"|","-"))
D UPDATE^DIE(,"FDA",)
S:(AUMM']"") AUMM="MOD :"
Q
;
AUM17U ;IHS/OIT/NKD - UTILITY FOR ICD10 FY2017 - 08/18/2016 ;
+1 ;;17.0;ICD UPDATE;;AUG 18,2016;Build 1
+2 ;
+3 QUIT
IEN(SYS) ; EP - FIND NEXT AVAILABLE IEN BASED ON SYS
+1 NEW ROOT,CNT,IEN
+2 SET ROOT=$$ROOT^ICDEX($GET(SYS))
SET IEN=0
+3 ; STARTING FROM 500001, FIND NEXT AVAILABLE IEN
IF +$GET(SYS)>2
FOR CNT=500001:1
IF IEN
QUIT
IF '$DATA(@(ROOT_CNT_")"))
SET IEN=CNT
+4 ; STARTING FROM 499999, FIND NEXT AVAILABLE IEN
IF '$TEST
IF +$GET(SYS)<30
FOR CNT=499999:-1
IF IEN
QUIT
IF '$DATA(@(ROOT_CNT_")"))
SET IEN=CNT
+5 QUIT IEN
+6 ;
EXC(IEN) ; EP - EXCLUDE ONE CODE FROM LOOKUP
+1 NEW CODE,FDA,CNT,ERR,DIK,DA
SET IEN=$GET(IEN)
IF 'IEN
QUIT "-1^Err:IEN"
+2 SET CODE=$$CODEC^ICDEX(80,IEN)
IF '$LENGTH(CODE)
QUIT "-1^Err:Code"
+3 MERGE ^AICDZEXC(IEN)=^ICD9(IEN)
+4 ; DELETE -9 NODE FROM INCOMPLETE MERGE
IF $DATA(^ICD9(IEN,-9))
KILL ^ICD9(IEN,-9)
+5 SET CNT=0
FOR
SET CNT=$ORDER(^ICD9(IEN,66,CNT))
IF 'CNT
QUIT
SET FDA(80.066,CNT_","_IEN_",",.01)="@"
+6 IF $DATA(FDA)
DO FILE^DIE(,"FDA","ERR")
+7 SET DIK="^ICD9("
SET DA=IEN
DO IX^DIK
+8 DO ^XBFMK
+9 QUIT $SELECT($DATA(ERR):"-1^Fail:"_$GET(ERR("DIERR","1","TEXT",1)),1:"1^Done")
+10 ;
CMPRE ; EP - ICD10 DIAGNOSIS FILE PRE-TRANSFORM
+1 ; P1 = CODE ;P2 = HEADER ;P3 = SHORT ;P4 = LONG ;P5 = MS-DRG ;P6 = CC/MCC
+2 ; P7 = PDX CC ;P8 = AGE LOW ;P9 = AGE HIGH ;P10= SEX ;P11= UNACC PDX
+3 NEW AUMC,AUMC2,AUMC3,AUMMDC,AUMTMP
+4 IF INA
SET P2=0
+5 IF 'P2
SET INA=1
+6 SET P4=$$UP^XLFSTR(P4)
+7 ; MDC/MS-DRG EXTRACTOR
+8 SET AUMMDC=""
FOR AUMC=1:1:$LENGTH(P5,";")
Begin DoDot:1
+9 SET AUMMDC=+$PIECE($PIECE(P5,";",AUMC),"|",1)
IF AUMMDC'>0
QUIT
+10 KILL AUMTMP
+11 FOR AUMC2=1:1:$LENGTH($PIECE($PIECE(P5,";",AUMC),"|",2),",")
Begin DoDot:2
+12 SET AUMTMP=$PIECE($PIECE($PIECE(P5,";",AUMC),"|",2),",",AUMC2)
+13 IF ($EXTRACT(AUMTMP,1)?1A)
QUIT
+14 FOR AUMC3=$PIECE(AUMTMP,"-",1):1:$SELECT($PIECE(AUMTMP,"-",2)]"":$PIECE(AUMTMP,"-",2),1:$PIECE(AUMTMP,"-",1))
SET AUMTMP(AUMC3)=""
End DoDot:2
+15 SET AUMC2=0
FOR
SET AUMC2=$ORDER(AUMTMP(AUMC2))
IF 'AUMC2
QUIT
SET P5(AUMMDC)=$GET(P5(AUMMDC))_AUMC2_U
End DoDot:1
+16 SET P5A=$ORDER(P5(0))
+17 QUIT
+18 ;
PCSPRE ; EP - ICD10 OPERATION/PROCEDURE FILE PRE-TRANSFORM
+1 ; P1 = CODE ;P2 = HEADER ;P3 = SHORT ;P4 = LONG ;P5 = MS-DRG ;P6 = N/A
+2 ; P7 = N/A ;P8 = N/A ;P9 = N/A ;P10= SEX ;P11= N/A
+3 NEW AUMC,AUMC2,AUMC3,AUMMDC,AUMTMP
+4 IF INA
SET P2=0
+5 IF 'P2
SET INA=1
+6 SET P4=$$UP^XLFSTR(P4)
+7 ; MDC/MS-DRG EXTRACTOR
+8 SET AUMMDC=""
FOR AUMC=1:1:$LENGTH(P5,";")
Begin DoDot:1
+9 SET AUMMDC=+$PIECE($PIECE(P5,";",AUMC),"|",1)
IF AUMMDC'>0
QUIT
+10 KILL AUMTMP
+11 FOR AUMC2=1:1:$LENGTH($PIECE($PIECE(P5,";",AUMC),"|",2),",")
Begin DoDot:2
+12 SET AUMTMP=$PIECE($PIECE($PIECE(P5,";",AUMC),"|",2),",",AUMC2)
+13 IF ($EXTRACT(AUMTMP,1)?1A)
QUIT
+14 FOR AUMC3=$PIECE(AUMTMP,"-",1):1:$SELECT($PIECE(AUMTMP,"-",2)]"":$PIECE(AUMTMP,"-",2),1:$PIECE(AUMTMP,"-",1))
SET AUMTMP(AUMC3)=""
End DoDot:2
+15 SET AUMC2=0
FOR
SET AUMC2=$ORDER(AUMTMP(AUMC2))
IF 'AUMC2
QUIT
SET P5(AUMMDC)=$GET(P5(AUMMDC))_AUMC2_U
End DoDot:1
+16 QUIT
+17 ;
CMDRG ; EP - ICD10 DIAGNOSIS FILE DRG UPDATE
+1 NEW FDA,NEWIEN,AUMC,AUMC2,AUMD0,AUMU,AUMFR,AUMTO
+2 ;
+3 ; DRG
DO MD^ICDEX($$SYS^AUM17D(AUMT,4),AUMI,AUMDT,.AUMD0)
+4 ; INCOMING DRGS
SET (AUMC,AUMU,AUMFR,AUMTO)=""
FOR
SET AUMC=$ORDER(P5(AUMC))
IF 'AUMC
QUIT
SET AUMTO=AUMTO_P5(AUMC)
+5 ; DIFF CHECK
+6 IF '$DATA(AUMD0)
Begin DoDot:1
+7 IF AUMTO]""
SET AUMU=1
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 SET AUMC=$ORDER(AUMD0(""))
SET AUMC2=$ORDER(AUMD0(AUMC,""))
SET AUMFR=$PIECE($GET(AUMD0(AUMC,AUMC2)),";")
+10 IF AUMFR'=AUMTO
SET AUMU=1
End DoDot:1
+11 IF 'AUMU
QUIT
+12 ; DRG Grouper Effective Date (Versioned) (71)
+13 KILL FDA
+14 SET AUMC=0
FOR
SET AUMC=$ORDER(^ICD9(AUMI,3,"B",AUMDT,AUMC))
IF 'AUMC
QUIT
SET FDA(80.071,AUMC_","_AUMI_",",.01)="@"
+15 IF $DATA(FDA)
DO FILE^DIE(,"FDA")
+16 ; ENTRY IS NEEDED (TO ENSURE PROPER BEHAVIOR WHEN DRGs ARE REMOVED)
+17 KILL FDA
+18 ; DRG Grouper Effective Date (.01)
SET FDA(80.071,"?+1,"_AUMI_",",.01)=AUMDT
+19 ; Add new DRGs
+20 FOR AUMC=1:1:$LENGTH(AUMTO,U)
IF $PIECE(AUMTO,U,AUMC)]""
SET FDA(80.711,"+"_(AUMC+1)_",?+1,"_AUMI_",",.01)=$PIECE(AUMTO,U,AUMC)
+21 ;
+22 DO RLOG^AUM17D(AUML,"DRG",$TRANSLATE(AUMFR,U,","),$TRANSLATE(AUMTO,U,","))
+23 DO UPDATE^DIE(,"FDA",)
+24 IF (AUMM']"")
SET AUMM="MOD :"
+25 QUIT
+26 ;
PCSDRG ; EP - ICD10 OPERATION/PROCEDURE FILE DRG UPDATE
+1 NEW FDA,NEWIEN,AUMC,AUMC2,AUMD0,AUMD1,AUMU,AUMFR,AUMTO
+2 ;
+3 ; DRG
DO MD^ICDEX($$SYS^AUM17D(AUMT,4),AUMI,AUMDT,.AUMD0)
+4 ; INCOMING DRGS
SET (AUMC,AUMU,AUMFR,AUMTO)=""
FOR
SET AUMC=$ORDER(P5(AUMC))
IF 'AUMC
QUIT
SET AUMTO=AUMTO_AUMC_"|"_P5(AUMC)_";"
+5 ; DIFF CHECK
+6 IF '$DATA(AUMD0)
Begin DoDot:1
+7 IF AUMTO]""
SET AUMU=1
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 SET AUMC=""
FOR
SET AUMC=$ORDER(AUMD0(AUMC))
IF 'AUMC
QUIT
SET AUMC2=""
FOR
SET AUMC2=$ORDER(AUMD0(AUMC,AUMC2))
IF 'AUMC2
QUIT
SET AUMD1(AUMC2)=$PIECE(AUMD0(AUMC,AUMC2),";")
+10 SET AUMC=""
FOR
SET AUMC=$ORDER(AUMD1(AUMC))
IF 'AUMC
QUIT
SET AUMFR=AUMFR_AUMC_"|"_AUMD1(AUMC)_";"
+11 IF AUMFR'=AUMTO
SET AUMU=1
End DoDot:1
+12 IF 'AUMU
QUIT
+13 ; DRG Grouper Effective Date (Versioned) (71)
+14 KILL FDA
+15 SET AUMC=0
FOR
SET AUMC=$ORDER(^ICD0(AUMI,2,"B",AUMDT,AUMC))
IF 'AUMC
QUIT
SET FDA(80.171,AUMC_","_AUMI_",",.01)="@"
+16 IF $DATA(FDA)
DO FILE^DIE(,"FDA")
+17 ; ENTRY IS NEEDED (TO ENSURE PROPER BEHAVIOR WHEN DRGs ARE REMOVED)
+18 KILL FDA
+19 ; DRG Grouper Effective Date (.01)
SET FDA(80.171,"?+1,"_AUMI_",",.01)=AUMDT
+20 ; Add new DRGs
+21 SET AUMC=0
FOR
SET AUMC=$ORDER(P5(AUMC))
IF 'AUMC
QUIT
Begin DoDot:1
+22 SET FDA(80.1711,"+"_(AUMC+1)_",?+1,"_AUMI_",",.01)=AUMC
+23 FOR AUMC2=1:1:$LENGTH(P5(AUMC),U)
IF $PIECE(P5(AUMC),U,AUMC2)]""
SET FDA(80.17111,"+"_(AUMC+1*1000+AUMC2)_",+"_(AUMC+1)_",?+1,"_AUMI_",",.01)=$PIECE(P5(AUMC),U,AUMC2)
End DoDot:1
+24 ;
+25 DO RLOG^AUM17D(AUML,"DRG",$TRANSLATE($TRANSLATE(AUMFR,U,","),"|","-"),$TRANSLATE($TRANSLATE(AUMTO,U,","),"|","-"))
+26 DO UPDATE^DIE(,"FDA",)
+27 IF (AUMM']"")
SET AUMM="MOD :"
+28 QUIT
+29 ;
