- AUMDO1C ; IHS/OIRM/DSD/JCM,AEF - UPDATE MULTIPLE SUBFILES FOR ICD9 AND ICD0 ; [ 12/03/1998 2:35 PM ]
- ;;99.1;ICD UPDATE;;DEC 03, 1998
- W !!,"ENTRY NOT PERMITTED HERE (^AUMDO1C)",! Q
- SPECNOTE ; SPECIAL NOTE FOR PROGRAMMERS
- ; ***NOTE - ALL VARIABLES ARE IN THE AUMDO("variable name') ARRAY
- ;
- EN ; ENTRY POINT FROM CALLSUB+1^AUMDO1B
- F AUMDO("MULT")="9999999.21","""DR""","""MDC""" D:$D(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_","_AUMDO("MULT")_")")) MULT
- Q ; RETURN TO ^AUMDO1B
- MULT ; UPDATE MULTIPLE IN ICD GLOBAL DETERMINED BY AUMDO("MULT")
- ; REMOVE OLD ENTRIES IF THEY EXIST
- S AUMDO("MULT LIT")=$S(AUMDO("MULT")[9:"KWD",AUMDO("MULT")["M":"MDC",1:"DRG") ; SET MULTIPLE NAME
- I '+AUMDO("MULT"),$D(@(AUMDO("ICD GL REF")_AUMDO("ICD DFN")_","_AUMDO("MULT")_")")) D MULTRMV
- ; LOOP THROUGH UPDATE MULTIPLE
- D:$Y>55 HDR^AUMDO W !,?27,"Adding new "_AUMDO("MULT LIT")_" entries"
- S AUMDO("MULT DFN")=0
- F AUMDO("L")=0:0 S AUMDO("MULT DFN")=$O(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_","_AUMDO("MULT")_","_AUMDO("MULT DFN")_")")) Q:'+AUMDO("MULT DFN") D MULTSET
- Q
- MULTSET ;
- S (X,AUMDO("MULT VAL"))=$P(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_","_AUMDO("MULT")_","_AUMDO("MULT DFN")_",0)"),U)
- S:+X X="`"_X
- I $D(@(AUMDO("ICD GL REF")_AUMDO("ICD DFN")_",9999999.21,""B"","""_AUMDO("MULT VAL")_""")")) D:$Y>55 HDR^AUMDO W !,?30,AUMDO("MULT VAL")_" exists, skipped" Q
- S DIC=AUMDO("ICD GL REF")_AUMDO("ICD DFN")_","_AUMDO("MULT")_","
- S DIC(0)="LF",DA(1)=AUMDO("ICD DFN")
- S DIC("P")=$S(AUMDO("MULT")[9:+$P(@(AUMDO("DIC(P) KWD")),U,2),AUMDO("MULT")["DR":+$P(@(AUMDO("DIC(P) DRG")),U,2),1:+$P(@(AUMDO("DIC(P) MDC")),U,2))
- S DLAYGO=$S(AUMDO("MULT")[9:AUMDO("DLAYGO KWD"),AUMDO("MULT")["DR":AUMDO("DLAYGO DRG"),1:AUMDO("DLAYGO MDC"))
- S DIADD=1
- ; I AUMDO("ICD9"),$P(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_","_AUMDO("MULT")_","_AUMDO("MULT DFN")_",0)"),U,2)]"" S DIC("DR")="1////"_$P(^(0),U,2)
- I AUMDO("MULT")["M" D
- . Q:$G(^AUMDOTMP(AUMDO("UPD DFN"),"MDC",AUMDO("MULT DFN"),"DRG"))="" ;AEF 2981030
- . S DIC("DR")=""
- . F AUMDO("DRG FLD")=1:1:6 D
- .. S DIC("DR")=DIC("DR")_AUMDO("DRG FLD")_"///"_$S($P($G(^AUMDOTMP(AUMDO("UPD DFN"),"MDC",AUMDO("MULT DFN"),"DRG")),U,AUMDO("DRG FLD"))]"":"/"_$P($G(^("DRG")),U,AUMDO("DRG FLD")),1:"@")_";" ;AEF 2981030
- . S DIC("DR")=$E(DIC("DR"),1,$L(DIC("DR"))-1) ; REMOVE SEMICOLON
- D ^DIC
- K DIC,DLAYGO,DIADD,DR
- I Y<1 D:$Y>55 HDR^AUMDO W !,?30,AUMDO("MULT VAL")_" not added" Q
- D:$Y>55 HDR^AUMDO W:AUMDO("MULT")[9 !,?30,AUMDO("MULT VAL")_" added"
- I AUMDO("MULT")["M" D
- . W !,?30,"MDC "_AUMDO("MULT VAL")_" added"
- . Q:$G(^AUMDOTMP(AUMDO("UPD DFN"),"MDC",AUMDO("MULT DFN"),"DRG"))="" ;AEF 2981030
- . W !,?30,"Adding related DRG entries for MDC code "_AUMDO("MULT DFN")
- . F AUMDO("DRG FLD")=1:1:6 D
- .. Q:$P($G(^AUMDOTMP(AUMDO("UPD DFN"),"MDC",AUMDO("MULT DFN"),"DRG")),U,AUMDO("DRG FLD"))="" ;AEF 2981030
- .. W !,?33,"DRG "_$P($G(^AUMDOTMP(AUMDO("UPD DFN"),"MDC",AUMDO("MULT DFN"),"DRG")),U,AUMDO("DRG FLD"))_" added" ;AEF 2981030
- Q
- MULTRMV ; REMOVE THE ICD SUBFILE ENTRIES FOR THIS ENTRY(DRG OR MDC)
- D:$Y>55 HDR^AUMDO W !,?27,"Removing old "_AUMDO("MULT LIT")_" entries"
- S DA=0
- F AUMDO("L")=0:0 S DA=$O(@(AUMDO("ICD GL REF")_AUMDO("ICD DFN")_","_AUMDO("MULT")_","_DA_")")) Q:'+DA S DA(1)=AUMDO("ICD DFN"),DIK=AUMDO("ICD GL REF")_AUMDO("ICD DFN")_","_AUMDO("MULT")_"," D ^DIK
- Q
- AUMDO1C ; IHS/OIRM/DSD/JCM,AEF - UPDATE MULTIPLE SUBFILES FOR ICD9 AND ICD0 ; [ 12/03/1998 2:35 PM ]
- +1 ;;99.1;ICD UPDATE;;DEC 03, 1998
- +2 WRITE !!,"ENTRY NOT PERMITTED HERE (^AUMDO1C)",!
- QUIT
- SPECNOTE ; SPECIAL NOTE FOR PROGRAMMERS
- +1 ; ***NOTE - ALL VARIABLES ARE IN THE AUMDO("variable name') ARRAY
- +2 ;
- EN ; ENTRY POINT FROM CALLSUB+1^AUMDO1B
- +1 FOR AUMDO("MULT")="9999999.21","""DR""","""MDC"""
- IF $DATA(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_","_AUMDO("MULT")_")"))
- DO MULT
- +2 ; RETURN TO ^AUMDO1B
- QUIT
- MULT ; UPDATE MULTIPLE IN ICD GLOBAL DETERMINED BY AUMDO("MULT")
- +1 ; REMOVE OLD ENTRIES IF THEY EXIST
- +2 ; SET MULTIPLE NAME
- SET AUMDO("MULT LIT")=$SELECT(AUMDO("MULT")[9:"KWD",AUMDO("MULT")["M":"MDC",1:"DRG")
- +3 IF '+AUMDO("MULT")
- IF $DATA(@(AUMDO("ICD GL REF")_AUMDO("ICD DFN")_","_AUMDO("MULT")_")"))
- DO MULTRMV
- +4 ; LOOP THROUGH UPDATE MULTIPLE
- +5 IF $Y>55
- DO HDR^AUMDO
- WRITE !,?27,"Adding new "_AUMDO("MULT LIT")_" entries"
- +6 SET AUMDO("MULT DFN")=0
- +7 FOR AUMDO("L")=0:0
- SET AUMDO("MULT DFN")=$ORDER(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_","_AUMDO("MULT")_","_AUMDO("MULT DFN")_")"))
- IF '+AUMDO("MULT DFN")
- QUIT
- DO MULTSET
- +8 QUIT
- MULTSET ;
- +1 SET (X,AUMDO("MULT VAL"))=$PIECE(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_","_AUMDO("MULT")_","_AUMDO("MULT DFN")_",0)"),U)
- +2 IF +X
- SET X="`"_X
- +3 IF $DATA(@(AUMDO("ICD GL REF")_AUMDO("ICD DFN")_",9999999.21,""B"","""_AUMDO("MULT VAL")_""")"))
- IF $Y>55
- DO HDR^AUMDO
- WRITE !,?30,AUMDO("MULT VAL")_" exists, skipped"
- QUIT
- +4 SET DIC=AUMDO("ICD GL REF")_AUMDO("ICD DFN")_","_AUMDO("MULT")_","
- +5 SET DIC(0)="LF"
- SET DA(1)=AUMDO("ICD DFN")
- +6 SET DIC("P")=$SELECT(AUMDO("MULT")[9:+$PIECE(@(AUMDO("DIC(P) KWD")),U,2),AUMDO("MULT")["DR":+$PIECE(@(AUMDO("DIC(P) DRG")),U,2),1:+$PIECE(@(AUMDO("DIC(P) MDC")),U,2))
- +7 SET DLAYGO=$SELECT(AUMDO("MULT")[9:AUMDO("DLAYGO KWD"),AUMDO("MULT")["DR":AUMDO("DLAYGO DRG"),1:AUMDO("DLAYGO MDC"))
- +8 SET DIADD=1
- +9 ; I AUMDO("ICD9"),$P(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_","_AUMDO("MULT")_","_AUMDO("MULT DFN")_",0)"),U,2)]"" S DIC("DR")="1////"_$P(^(0),U,2)
- +10 IF AUMDO("MULT")["M"
- Begin DoDot:1
- +11 ;AEF 2981030
- IF $GET(^AUMDOTMP(AUMDO("UPD DFN"),"MDC",AUMDO("MULT DFN"),"DRG"))=""
- QUIT
- +12 SET DIC("DR")=""
- +13 FOR AUMDO("DRG FLD")=1:1:6
- Begin DoDot:2
- +14 ;AEF 2981030
- SET DIC("DR")=DIC("DR")_AUMDO("DRG FLD")_"///"_$SELECT($PIECE($GET(^AUMDOTMP(AUMDO("UPD DFN"),"MDC",AUMDO("MULT DFN"),"DRG")),U,AUMDO("DRG FLD"))]"":"/"_$PIECE($GET(^("DRG")),U,AUMDO("DRG FLD")),1:"@")_";"
- End DoDot:2
- +15 ; REMOVE SEMICOLON
- SET DIC("DR")=$EXTRACT(DIC("DR"),1,$LENGTH(DIC("DR"))-1)
- End DoDot:1
- +16 DO ^DIC
- +17 KILL DIC,DLAYGO,DIADD,DR
- +18 IF Y<1
- IF $Y>55
- DO HDR^AUMDO
- WRITE !,?30,AUMDO("MULT VAL")_" not added"
- QUIT
- +19 IF $Y>55
- DO HDR^AUMDO
- IF AUMDO("MULT")[9
- WRITE !,?30,AUMDO("MULT VAL")_" added"
- +20 IF AUMDO("MULT")["M"
- Begin DoDot:1
- +21 WRITE !,?30,"MDC "_AUMDO("MULT VAL")_" added"
- +22 ;AEF 2981030
- IF $GET(^AUMDOTMP(AUMDO("UPD DFN"),"MDC",AUMDO("MULT DFN"),"DRG"))=""
- QUIT
- +23 WRITE !,?30,"Adding related DRG entries for MDC code "_AUMDO("MULT DFN")
- +24 FOR AUMDO("DRG FLD")=1:1:6
- Begin DoDot:2
- +25 ;AEF 2981030
- IF $PIECE($GET(^AUMDOTMP(AUMDO("UPD DFN"),"MDC",AUMDO("MULT DFN"),"DRG")),U,AUMDO("DRG FLD"))=""
- QUIT
- +26 ;AEF 2981030
- WRITE !,?33,"DRG "_$PIECE($GET(^AUMDOTMP(AUMDO("UPD DFN"),"MDC",AUMDO("MULT DFN"),"DRG")),U,AUMDO("DRG FLD"))_" added"
- End DoDot:2
- End DoDot:1
- +27 QUIT
- MULTRMV ; REMOVE THE ICD SUBFILE ENTRIES FOR THIS ENTRY(DRG OR MDC)
- +1 IF $Y>55
- DO HDR^AUMDO
- WRITE !,?27,"Removing old "_AUMDO("MULT LIT")_" entries"
- +2 SET DA=0
- +3 FOR AUMDO("L")=0:0
- SET DA=$ORDER(@(AUMDO("ICD GL REF")_AUMDO("ICD DFN")_","_AUMDO("MULT")_","_DA_")"))
- IF '+DA
- QUIT
- SET DA(1)=AUMDO("ICD DFN")
- SET DIK=AUMDO("ICD GL REF")_AUMDO("ICD DFN")_","_AUMDO("MULT")_","
- DO ^DIK
- +4 QUIT
