AUMDO1C.m

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