- 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
