AUMP1012.m

AUMP1012 ;IHS/HQ/ABK - AUM PRE INSTALL [ 10/11/2010 12:25 PM ]

 ;;11.0;TABLE MAINTENANCE;**5**;Oct 15,2010

 ;

 ; This is the pre-init for AUM 10.1. It sets all existing education

 ; topics to inactive as long as they are not diagnosis codes with

 ; valid ICD9 cross references.

 ;

 ;

START ;inactivate all codes that are not local codes

 N AUMX,AUMCODE,AUMICD,AUMB

 D ^XBFMK

 S DIE="^AUTTEDT("

 S DR=".03///1"

 S DA=0

 F   S DA=$O(^AUTTEDT(DA)) Q:'DA  S AUMX=$G(^AUTTEDT(DA,0)) D

  .Q:$P(AUMX,U,3)=1

  .S AUMCODE=$P(AUMX,U,6),AUMICD=$P(AUMX,U,4)

  .; 1st quit if EIN to ^ICD9 is valid (piece 4)

  .I AUMICD'="",AUMICD?1N.N Q:$D(^ICD9(AUMICD))

  .; 2nd quit if ICD code to ^ICD9("AB" is valid (piece 6)

  .I AUMCODE'="" Q:$D(^ICD9("AB",AUMCODE))

  .; 3rd quit if "ICD" (Quoted) code to ^ICD9("AB" is valid (piece 6)

  .S AUMB="^ICD9("_""""_"AB"_""""_","_""""_AUMCODE_""""_")"

  .Q:$D(@AUMB)

  .S AUMCODE=$P(AUMX,U,2),AUMCODE=$P(AUMCODE,"-",1)

  .; 4th quit if ICD code to ^ICD9("AB" is valid (piece 1 (-) of piece 2)

  .I AUMCODE'="" Q:$D(^ICD9("AB",AUMCODE))

  .S AUMB="^ICD9("_""""_"AB"_""""_","_""""_AUMCODE_""""_")"

  .; 5th quit if "ICD" (Quoted) code to ^ICD9("AB" is valid (piece 1 (-) of piece 2)

  .Q:$D(@AUMB)

  .; Must be something other than an ICD code - inactivate it

  .D ^DIE

  .I '(DA#100) W "."

  .Q

 ;

 Q

INACT ; Inactivate only one code

 N AUMX,AUMCODE,AUMICD,AUMB

 D ^XBFMK

 S DIE="^AUTTEDT("

 S DR=".03///1"

 S DA=0

 ;F S DA=$O(^AUTTEDT(DA)) Q:'DA S AUMX=$G(^AUTTEDT(DA,0)) D

 S AUMCNAM=$P(AUMXS,U,2),AUMMNE=$P(AUMXS,U,3)

 S DA=$O(^AUTTEDT("B",AUMCNAM,"")),DA2=$O(^AUTTEDT("C",AUMMNE,""))

 S AUMX=$G(^AUTTEDT(DA,0))

 Q:$P(AUMX,U,3)=1

 S AUMCODE=$P(AUMX,U,6),AUMICD=$P(AUMX,U,4)

 ; 1st quit if EIN to ^ICD9 is valid (piece 4)

 I AUMICD'="",AUMICD?1N.N Q:$D(^ICD9(AUMICD))

 ; 2nd quit if ICD code to ^ICD9("AB" is valid (piece 6)

 I AUMCODE'="" Q:$D(^ICD9("AB",AUMCODE))

 ; 3rd quit if "ICD" (Quoted) code to ^ICD9("AB" is valid (piece 6)

 S AUMB="^ICD9("_""""_"AB"_""""_","_""""_AUMCODE_""""_")"

 Q:$D(@AUMB)

 S AUMCODE=$P(AUMX,U,2),AUMCODE=$P(AUMCODE,"-",1)

 ; 4th quit if ICD code to ^ICD9("AB" is valid (piece 1 (-) of piece 2)

 I AUMCODE'="" Q:$D(^ICD9("AB",AUMCODE))

 S AUMB="^ICD9("_""""_"AB"_""""_","_""""_AUMCODE_""""_")"

 ; 5th quit if "ICD" (Quoted) code to ^ICD9("AB" is valid (piece 1 (-) of piece 2)

 Q:$D(@AUMB)

 ; Must be something other than an ICD code - inactivate it

 D ^DIE

 S TOTINACT=TOTINACT+1

 I '(DA#100) W "."

 Q

AUMP1012  ;IHS/HQ/ABK - AUM PRE INSTALL [ 10/11/2010 12:25 PM ]

 +1       ;;11.0;TABLE MAINTENANCE;**5**;Oct 15,2010

 +2       ;

 +3       ; This is the pre-init for AUM 10.1. It sets all existing education

 +4       ; topics to inactive as long as they are not diagnosis codes with

 +5       ; valid ICD9 cross references.

 +6       ;

 +7       ;

START     ;inactivate all codes that are not local codes

 +1        NEW AUMX,AUMCODE,AUMICD,AUMB

 +2        DO ^XBFMK

 +3        SET DIE="^AUTTEDT("

 +4        SET DR=".03///1"

 +5        SET DA=0

 +6        FOR 

               SET DA=$ORDER(^AUTTEDT(DA))

               IF 'DA

                   QUIT 

               SET AUMX=$GET(^AUTTEDT(DA,0))

               Begin DoDot:1

 +7                IF $PIECE(AUMX,U,3)=1

                       QUIT 

 +8                SET AUMCODE=$PIECE(AUMX,U,6)

                   SET AUMICD=$PIECE(AUMX,U,4)

 +9       ; 1st quit if EIN to ^ICD9 is valid (piece 4)

 +10               IF AUMICD'=""

                       IF AUMICD?1N.N

                           IF $DATA(^ICD9(AUMICD))

                               QUIT 

 +11      ; 2nd quit if ICD code to ^ICD9("AB" is valid (piece 6)

 +12               IF AUMCODE'=""

                       IF $DATA(^ICD9("AB",AUMCODE))

                           QUIT 

 +13      ; 3rd quit if "ICD" (Quoted) code to ^ICD9("AB" is valid (piece 6)

 +14               SET AUMB="^ICD9("_""""_"AB"_""""_","_""""_AUMCODE_""""_")"

 +15               IF $DATA(@AUMB)

                       QUIT 

 +16               SET AUMCODE=$PIECE(AUMX,U,2)

                   SET AUMCODE=$PIECE(AUMCODE,"-",1)

 +17      ; 4th quit if ICD code to ^ICD9("AB" is valid (piece 1 (-) of piece 2)

 +18               IF AUMCODE'=""

                       IF $DATA(^ICD9("AB",AUMCODE))

                           QUIT 

 +19               SET AUMB="^ICD9("_""""_"AB"_""""_","_""""_AUMCODE_""""_")"

 +20      ; 5th quit if "ICD" (Quoted) code to ^ICD9("AB" is valid (piece 1 (-) of piece 2)

 +21               IF $DATA(@AUMB)

                       QUIT 

 +22      ; Must be something other than an ICD code - inactivate it

 +23               DO ^DIE

 +24               IF '(DA#100)

                       WRITE "."

 +25               QUIT 

               End DoDot:1

 +26      ;

 +27       QUIT 

INACT     ; Inactivate only one code

 +1        NEW AUMX,AUMCODE,AUMICD,AUMB

 +2        DO ^XBFMK

 +3        SET DIE="^AUTTEDT("

 +4        SET DR=".03///1"

 +5        SET DA=0

 +6       ;F S DA=$O(^AUTTEDT(DA)) Q:'DA S AUMX=$G(^AUTTEDT(DA,0)) D

 +7        SET AUMCNAM=$PIECE(AUMXS,U,2)

           SET AUMMNE=$PIECE(AUMXS,U,3)

 +8        SET DA=$ORDER(^AUTTEDT("B",AUMCNAM,""))

           SET DA2=$ORDER(^AUTTEDT("C",AUMMNE,""))

 +9        SET AUMX=$GET(^AUTTEDT(DA,0))

 +10       IF $PIECE(AUMX,U,3)=1

               QUIT 

 +11       SET AUMCODE=$PIECE(AUMX,U,6)

           SET AUMICD=$PIECE(AUMX,U,4)

 +12      ; 1st quit if EIN to ^ICD9 is valid (piece 4)

 +13       IF AUMICD'=""

               IF AUMICD?1N.N

                   IF $DATA(^ICD9(AUMICD))

                       QUIT 

 +14      ; 2nd quit if ICD code to ^ICD9("AB" is valid (piece 6)

 +15       IF AUMCODE'=""

               IF $DATA(^ICD9("AB",AUMCODE))

                   QUIT 

 +16      ; 3rd quit if "ICD" (Quoted) code to ^ICD9("AB" is valid (piece 6)

 +17       SET AUMB="^ICD9("_""""_"AB"_""""_","_""""_AUMCODE_""""_")"

 +18       IF $DATA(@AUMB)

               QUIT 

 +19       SET AUMCODE=$PIECE(AUMX,U,2)

           SET AUMCODE=$PIECE(AUMCODE,"-",1)

 +20      ; 4th quit if ICD code to ^ICD9("AB" is valid (piece 1 (-) of piece 2)

 +21       IF AUMCODE'=""

               IF $DATA(^ICD9("AB",AUMCODE))

                   QUIT 

 +22       SET AUMB="^ICD9("_""""_"AB"_""""_","_""""_AUMCODE_""""_")"

 +23      ; 5th quit if "ICD" (Quoted) code to ^ICD9("AB" is valid (piece 1 (-) of piece 2)

 +24       IF $DATA(@AUMB)

               QUIT 

 +25      ; Must be something other than an ICD code - inactivate it

 +26       DO ^DIE

 +27       SET TOTINACT=TOTINACT+1

 +28       IF '(DA#100)

               WRITE "."

 +29       QUIT