- AUMI10U ;IHS/OIT/NKD - UTILITY FOR ICD10 - 09/04/2018 ;
- ;;19.0;ICD UPDATE;;SEP 04,2018;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 ;P12 = POA
- 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^AUMI10D(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^AUMI10D(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^AUMI10D(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^AUMI10D(AUML,"DRG",$TR($TR(AUMFR,U,","),"|","-"),$TR($TR(AUMTO,U,","),"|","-"))
- D UPDATE^DIE(,"FDA",)
- S:(AUMM']"") AUMM="MOD :"
- Q
- ;
- AUMI10U ;IHS/OIT/NKD - UTILITY FOR ICD10 - 09/04/2018 ;
- +1 ;;19.0;ICD UPDATE;;SEP 04,2018;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 ;P12 = POA
- +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^AUMI10D(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^AUMI10D(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^AUMI10D(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^AUMI10D(AUML,"DRG",$TRANSLATE($TRANSLATE(AUMFR,U,","),"|","-"),$TRANSLATE($TRANSLATE(AUMTO,U,","),"|","-"))
- +26 DO UPDATE^DIE(,"FDA",)
- +27 IF (AUMM']"")
- SET AUMM="MOD :"
- +28 QUIT
- +29 ;
