AUMPRE33.m

AUMPRE33 ;IHS/OIT/CLS - AUM 9.1 patch 3 pre-init ;

 ;;9.1;AUM SCB UPDATE;**3**;NOV 11, 2008

 ;

 ; This is the pre-init for AUM*9.1*3. It strips the semicolons

 ; out of the ^AUTTEDT global prior to the install of the patch.

 ;

 ; Based on routine 2008 04 18-20 created by Rick Marshall

 ;

 QUIT  ; This routine should not be called at the top or anywhere

 ; else. It is only to be called at START by AUMPRE31 as the pre-init

 ; for AUM*9.1*3.

 ;

START ; AUM*9.1*3 PRE-INIT ; Resets .01 nodes of entries with semicolons

 ;

 D CHECK,CLEANUP

 Q

 ;

CHECK ; troubleshooting entry point

 ;

 N AUMCNTC S AUMCNTC=0 ; how many nodes had semicolons

 N AUMDA ; DA equivalent

 ;

 S AUMDA=0

 F  S AUMDA=$O(^AUTTEDT(AUMDA)) Q:'AUMDA  I $P(^AUTTEDT(AUMDA,0),"^")[";" D

 . ;

 . S AUMCNTC=AUMCNTC+1 ; add to our count of instances

 . W "=",AUMDA,"=" ; note presence of semicolon

 . W !,$P(^AUTTEDT(AUMDA,0),"^"),! ; write node

 ;

 W !!,"Number of nodes with semicolons: ",AUMCNTC

 QUIT  ; end of CHECK

 ;

CLEANUP ; replace entries with "CODE-PCC DATA ENTRY EDUC TOPIC"

 ;

 N AUMCNTC S AUMCNTC=0 ; how many nodes with semicolons are processed

 N AUMDA ; DA equivalent

 N AUM2P ; mnemonic from second piece of zero node

 N AUMCD ; ICD or CPT code from second piece

 N AUMMN ; PCC DATA ENTRY EDUC TOPIC mnemonic

 N AUMNN ; IEN, .01, finally new name for EDUCATION TOPIC file entry

 ;

 S AUMDA=0

 F  S AUMDA=$O(^AUTTEDT(AUMDA)) Q:'AUMDA  I $P(^AUTTEDT(AUMDA,0),"^")[";" D

 . ;

 . S AUMCNTC=AUMCNTC+1 ; add to our count of instances

 . S AUM2P=$P(^AUTTEDT(AUMDA,0),"^",2) ; get mnemonic from primary file #9999999.09

 . S AUMCD=$P(AUM2P,"-") ; get ICD/CPT code

 . S AUMMN=$P(AUM2P,"-",2) ; get mnemonic from secondary file #9001002.5

 . S AUMNN=$O(^APCDEDCV("C",AUMMN,0)) ; get ien of entry in secondary file

 . S AUMNN=$P(^APCDEDCV(AUMNN,0),"^") ; get .01 of entry in secondary file

 . S AUMNN=AUMCD_"-"_AUMNN ; create new .01 for primary file

 . S $P(^AUTTEDT(AUMDA,0),"^",1)=AUMNN ; set replacement for .01 in primary file

 . W "=",AUMDA,"=" ; note presence of semicolon - corrected

 . W !,$P(^AUTTEDT(AUMDA,0),"^"),! ; write new node

 ;

 W !!,"Number of nodes with semicolons that were cleaned up: ",AUMCNTC

 QUIT  ; end of CHECK

 ;

 ; end of routine AUMPRE33

AUMPRE33  ;IHS/OIT/CLS - AUM 9.1 patch 3 pre-init ;

 +1       ;;9.1;AUM SCB UPDATE;**3**;NOV 11, 2008

 +2       ;

 +3       ; This is the pre-init for AUM*9.1*3. It strips the semicolons

 +4       ; out of the ^AUTTEDT global prior to the install of the patch.

 +5       ;

 +6       ; Based on routine 2008 04 18-20 created by Rick Marshall

 +7       ;

 +8       ; This routine should not be called at the top or anywhere

           QUIT 

 +9       ; else. It is only to be called at START by AUMPRE31 as the pre-init

 +10      ; for AUM*9.1*3.

 +11      ;

START     ; AUM*9.1*3 PRE-INIT ; Resets .01 nodes of entries with semicolons

 +1       ;

 +2        DO CHECK

           DO CLEANUP

 +3        QUIT 

 +4       ;

CHECK     ; troubleshooting entry point

 +1       ;

 +2       ; how many nodes had semicolons

           NEW AUMCNTC

           SET AUMCNTC=0

 +3       ; DA equivalent

           NEW AUMDA

 +4       ;

 +5        SET AUMDA=0

 +6        FOR 

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

               IF 'AUMDA

                   QUIT 

               IF $PIECE(^AUTTEDT(AUMDA,0),"^")[";"

                   Begin DoDot:1

 +7       ;

 +8       ; add to our count of instances

                       SET AUMCNTC=AUMCNTC+1

 +9       ; note presence of semicolon

                       WRITE "=",AUMDA,"="

 +10      ; write node

                       WRITE !,$PIECE(^AUTTEDT(AUMDA,0),"^"),!

                   End DoDot:1

 +11      ;

 +12       WRITE !!,"Number of nodes with semicolons: ",AUMCNTC

 +13      ; end of CHECK

           QUIT 

 +14      ;

CLEANUP   ; replace entries with "CODE-PCC DATA ENTRY EDUC TOPIC"

 +1       ;

 +2       ; how many nodes with semicolons are processed

           NEW AUMCNTC

           SET AUMCNTC=0

 +3       ; DA equivalent

           NEW AUMDA

 +4       ; mnemonic from second piece of zero node

           NEW AUM2P

 +5       ; ICD or CPT code from second piece

           NEW AUMCD

 +6       ; PCC DATA ENTRY EDUC TOPIC mnemonic

           NEW AUMMN

 +7       ; IEN, .01, finally new name for EDUCATION TOPIC file entry

           NEW AUMNN

 +8       ;

 +9        SET AUMDA=0

 +10       FOR 

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

               IF 'AUMDA

                   QUIT 

               IF $PIECE(^AUTTEDT(AUMDA,0),"^")[";"

                   Begin DoDot:1

 +11      ;

 +12      ; add to our count of instances

                       SET AUMCNTC=AUMCNTC+1

 +13      ; get mnemonic from primary file #9999999.09

                       SET AUM2P=$PIECE(^AUTTEDT(AUMDA,0),"^",2)

 +14      ; get ICD/CPT code

                       SET AUMCD=$PIECE(AUM2P,"-")

 +15      ; get mnemonic from secondary file #9001002.5

                       SET AUMMN=$PIECE(AUM2P,"-",2)

 +16      ; get ien of entry in secondary file

                       SET AUMNN=$ORDER(^APCDEDCV("C",AUMMN,0))

 +17      ; get .01 of entry in secondary file

                       SET AUMNN=$PIECE(^APCDEDCV(AUMNN,0),"^")

 +18      ; create new .01 for primary file

                       SET AUMNN=AUMCD_"-"_AUMNN

 +19      ; set replacement for .01 in primary file

                       SET $PIECE(^AUTTEDT(AUMDA,0),"^",1)=AUMNN

 +20      ; note presence of semicolon - corrected

                       WRITE "=",AUMDA,"="

 +21      ; write new node

                       WRITE !,$PIECE(^AUTTEDT(AUMDA,0),"^"),!

                   End DoDot:1

 +22      ;

 +23       WRITE !!,"Number of nodes with semicolons that were cleaned up: ",AUMCNTC

 +24      ; end of CHECK

           QUIT 

 +25      ;

 +26      ; end of routine AUMPRE33