AUMDO1BS.m

AUMDO1BS ; IHS/OIRM/DSD/JCM,AEF - UPDATE ICD GLOBAL (SUBROUTINE OF AUMDO1B) ;  [ 12/03/1998   2:35 PM ]

 ;;99.1;ICD UPDATE;;DEC 03, 1998

 W !,"ENTRY NOT PERMITTED HERE (AUMDO1BS)",! Q

PGRNOTE ; This module contains two subroutines called from AUMDO1B

 ; (COMMON and DSPSTAT) becuase AUMDO1B got too big after the

 ; dictionary change in 92.2 distribution.

 ; Added to new fields to the ICD file dictionaries:

 ;   - DATE LAST UPDATE

 ;   - UPDATE CYCLE #

 ; COMMON sub-rtn adds these to the DR string

 ;

COMMON ; ENTRY POINT from EN+5^AUMDO1B-update common fields to each ICD file

 ; process the INACTIVE FLAG and DATE fields

 D  ; SETSTAT subroutine from AUMDO1B

 . S AUMDO("STAT FLAG")=$P(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",0)"),U,9) ; save INACTIVE STATUS FLAG field

 . S AUMDO("STAT FLAG DATE")=$P(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",0)"),U,11) ; save DATE INACTIVATED field

 . I AUMDO("ADD!A/R") D  Q

 .. I AUMDO("STAT FLAG")="" D  Q

 ... S DR=DR_"100///@;102///@;" ;force nulls to the flag and date fields

 .. S DR=DR_"100////1;"

 .. S:AUMDO("STAT FLAG DATE")]"" DR=DR_"102////"_AUMDO("STAT FLAG DATE")_";"

 . I AUMDO("CHANGE") D

 .. Q:AUMDO("STAT FLAG")=""

 .. S DR=DR_"100////1;"

 .. S:AUMDO("STAT FLAG DATE")]"" DR=DR_"102////"_AUMDO("STAT FLAG DATE")_";"

 ;                                .01 Code Number

 S:$D(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",1)")) $P(@(AUMDO("ICD GL REF")_AUMDO("ICD DFN")_",1)"),U)=$P(^(1),U)

 ;                                2 Identifier

 S:$P(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",0)"),U,2)]"" DR=DR_"2////"_$P(^(0),U,2)_";"

 ;                                8 ICD expanded

 S:$P(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",0)"),U,8)]"" DR=DR_"8////"_$P(^(0),U,8)_";"

 ;                                9.5 Use only with sex

 S:$P(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",0)"),U,10)]"" DR=DR_"9.5////"_$P(^(0),U,10)_";"

 ;                                100 Inactive Flag & 102 Inactive Date

 I $P(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",0)"),U,9)]"" S DR=DR_"100////1;" S:$P(^(0),U,11)]"" DR=DR_"102////"_$P(^(0),U,11)_";"

 ;                                2100000 Date Last Update (new field)

 S:$P(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",2100000)"),U,1)]"" DR=DR_"2100000////"_$P(^(2100000),U,1)_";"

 ;                                2100002 Update Cycle # (new field)

 S:$P(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",2100000)"),U,3)]"" DR=DR_"2100002////"_$P(^(2100000),U,3)_";"

 I '$D(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",9999999)"))

 E  D

 . ;                              set common fields for 9999999 node

 . S:$P(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",9999999)"),U)]"" DR=DR_"9999999.01////"_$P(^(9999999),U)_";"

 . S:$P(^(9999999),U,2)]"" DR=DR_"9999999.02////"_$P(^(9999999),U,2)_";" S:$P(^(9999999),U,3)]"" DR=DR_"9999999.03////"_$P(^(9999999),U,3)_";"

 S DR=$E(DR,1,$L(DR)-1) ;         remove trailing semicolon

 Q

DSPSTAT ; ENTRY POINT from EN+7^AUMDO1B to display status of icd code

 D:$Y>55 HDR^AUMDO

 I AUMDO("ADD/REPLACE") W !,?27,"Old status was "_$S(AUMDO("OLD STATUS")="":"active",1:"inactive")

 W !,?27,"Status is "

 W $S(AUMDO("SUPERCEDED"):"inactive - (Superceded code)",AUMDO("VA EXPANDED"):"inactive - (VA Expanded code)",AUMDO("INACTIVE"):"inactive",AUMDO("ACTIVE"):"active",1:"unchanged")

 Q

AUMDO1BS  ; IHS/OIRM/DSD/JCM,AEF - UPDATE ICD GLOBAL (SUBROUTINE OF AUMDO1B) ;  [ 12/03/1998   2:35 PM ]

 +1       ;;99.1;ICD UPDATE;;DEC 03, 1998

 +2        WRITE !,"ENTRY NOT PERMITTED HERE (AUMDO1BS)",!

           QUIT 

PGRNOTE   ; This module contains two subroutines called from AUMDO1B

 +1       ; (COMMON and DSPSTAT) becuase AUMDO1B got too big after the

 +2       ; dictionary change in 92.2 distribution.

 +3       ; Added to new fields to the ICD file dictionaries:

 +4       ;   - DATE LAST UPDATE

 +5       ;   - UPDATE CYCLE #

 +6       ; COMMON sub-rtn adds these to the DR string

 +7       ;

COMMON    ; ENTRY POINT from EN+5^AUMDO1B-update common fields to each ICD file

 +1       ; process the INACTIVE FLAG and DATE fields

 +2       ; SETSTAT subroutine from AUMDO1B

           Begin DoDot:1

 +3       ; save INACTIVE STATUS FLAG field

               SET AUMDO("STAT FLAG")=$PIECE(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",0)"),U,9)

 +4       ; save DATE INACTIVATED field

               SET AUMDO("STAT FLAG DATE")=$PIECE(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",0)"),U,11)

 +5            IF AUMDO("ADD!A/R")

                   Begin DoDot:2

 +6                    IF AUMDO("STAT FLAG")=""

                           Begin DoDot:3

 +7       ;force nulls to the flag and date fields

                               SET DR=DR_"100///@;102///@;"

                           End DoDot:3

                           QUIT 

 +8                    SET DR=DR_"100////1;"

 +9                    IF AUMDO("STAT FLAG DATE")]""

                           SET DR=DR_"102////"_AUMDO("STAT FLAG DATE")_";"

                   End DoDot:2

                   QUIT 

 +10           IF AUMDO("CHANGE")

                   Begin DoDot:2

 +11                   IF AUMDO("STAT FLAG")=""

                           QUIT 

 +12                   SET DR=DR_"100////1;"

 +13                   IF AUMDO("STAT FLAG DATE")]""

                           SET DR=DR_"102////"_AUMDO("STAT FLAG DATE")_";"

                   End DoDot:2

           End DoDot:1

 +14      ;                                .01 Code Number

 +15       IF $DATA(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",1)"))

               SET $PIECE(@(AUMDO("ICD GL REF")_AUMDO("ICD DFN")_",1)"),U)=$PIECE(^(1),U)

 +16      ;                                2 Identifier

 +17       IF $PIECE(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",0)"),U,2)]""

               SET DR=DR_"2////"_$PIECE(^(0),U,2)_";"

 +18      ;                                8 ICD expanded

 +19       IF $PIECE(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",0)"),U,8)]""

               SET DR=DR_"8////"_$PIECE(^(0),U,8)_";"

 +20      ;                                9.5 Use only with sex

 +21       IF $PIECE(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",0)"),U,10)]""

               SET DR=DR_"9.5////"_$PIECE(^(0),U,10)_";"

 +22      ;                                100 Inactive Flag & 102 Inactive Date

 +23       IF $PIECE(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",0)"),U,9)]""

               SET DR=DR_"100////1;"

               IF $PIECE(^(0),U,11)]""

                   SET DR=DR_"102////"_$PIECE(^(0),U,11)_";"

 +24      ;                                2100000 Date Last Update (new field)

 +25       IF $PIECE(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",2100000)"),U,1)]""

               SET DR=DR_"2100000////"_$PIECE(^(2100000),U,1)_";"

 +26      ;                                2100002 Update Cycle # (new field)

 +27       IF $PIECE(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",2100000)"),U,3)]""

               SET DR=DR_"2100002////"_$PIECE(^(2100000),U,3)_";"

 +28       IF '$DATA(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",9999999)"))

 +29      IF '$TEST

               Begin DoDot:1

 +30      ;                              set common fields for 9999999 node

 +31               IF $PIECE(@(AUMDO("UPD GL REF")_AUMDO("UPD DFN")_",9999999)"),U)]""

                       SET DR=DR_"9999999.01////"_$PIECE(^(9999999),U)_";"

 +32               IF $PIECE(^(9999999),U,2)]""

                       SET DR=DR_"9999999.02////"_$PIECE(^(9999999),U,2)_";"

                   IF $PIECE(^(9999999),U,3)]""

                       SET DR=DR_"9999999.03////"_$PIECE(^(9999999),U,3)_";"

               End DoDot:1

 +33      ;         remove trailing semicolon

           SET DR=$EXTRACT(DR,1,$LENGTH(DR)-1)

 +34       QUIT 

DSPSTAT   ; ENTRY POINT from EN+7^AUMDO1B to display status of icd code

 +1        IF $Y>55

               DO HDR^AUMDO

 +2        IF AUMDO("ADD/REPLACE")

               WRITE !,?27,"Old status was "_$SELECT(AUMDO("OLD STATUS")="":"active",1:"inactive")

 +3        WRITE !,?27,"Status is "

 +4        WRITE $SELECT(AUMDO("SUPERCEDED"):"inactive - (Superceded code)",AUMDO("VA EXPANDED"):"inactive - (VA Expanded code)",AUMDO("INACTIVE"):"inactive",AUMDO("ACTIVE"):"active",1:"unchanged")

 +5        QUIT