AUTEMTP.m

AUTEMTP ;IHS/OIT/FBD - POPULATE EDUCATION MAJOR TOPIC PTR FIELD

 ;;98.1;IHS DICTIONARIES (POINTERS);**26**;APR 03,2013;Build 6

 ;

 Q  ;NO TOP-LEVEL ENTRY CALL

 ;

 ;IN A GIVEN 'EDUCATION TOPICS' FILE ENTRY (RECORD IEN SPECIFIED

 ;IN VARIABLE 'X'), THIS ROUTINE WILL POPULATE THE 'MAJOR TOPIC PTR'

 ;FIELD BASED ON THE CONTENTS OF THE 'MAJOR TOPIC' FIELD.

 ;

CHECK ;PRE-POPULATION DATA PORTABILITY CHECK

 S AUTETIEN=0  ;EDUCATION TOPIC RECORD IEN

 K AUTCRUPT,AUTMATCH,AUTNOMAT,AUTMNULL

 S (AUTCRUPT,AUTMATCH,AUTNOMAT,AUTMNULL)=0  ;MATCH/MISMATCH COUNTERS

 W:'$D(AUTQUIET) !!,"EDUCATION TOPICS CHECK SCAN OF MAJOR TOPICS STARTED...",!!

 F  S AUTETIEN=$O(^AUTTEDT(AUTETIEN)) Q:'+AUTETIEN  D  ;

 .I '$D(^AUTTEDT(AUTETIEN,0)) D  Q

 ..S AUTCRUPT=AUTCRUPT+1

 .S AUTMTEXT=$P(^AUTTEDT(AUTETIEN,0),U,6)

 .I AUTMTEXT="" D  Q

 ..S AUTMNULL=AUTMNULL+1

 ..S AUTMNULL(AUTETIEN)=""

 .I $D(^AUTTEDMT("B",AUTMTEXT)) D

 ..S AUTMATCH=AUTMATCH+1

 ..S AUTMATCH(AUTETIEN)=$O(^AUTTEDMT("B",AUTMTEXT,""))

 .E  D

 ..S AUTNOMAT=AUTNOMAT+1

 ..S AUTNOMAT(AUTETIEN)=AUTMTEXT

 D:'$D(AUTQUIET) CHECKOUT

 W:'$D(AUTQUIET) !,"CHECK SCAN COMPLETE.",!!

 Q

 ;

CHECKOUT ;OUTPUT FROM CHECK SCAN

 W !,"RESULTS OF MAJOR TOPICS SCAN:",!

 W ?5,"# OF MATCHED MAJOR TOPICS   = ",AUTMATCH,!

 W ?5,"# OF UNMATCHED MAJOR TOPICS = ",AUTNOMAT,!

 W ?5,"# OF NULL MAJOR TOPICS      = ",AUTMNULL,!

 W ?5,"# OF CORRUPTED ED TOPICS    = ",AUTCRUPT,!

 Q

 ;

CVT(TIEN) ;CONVERT 'MAJOR TOPIC' FIELD TEXT TO 'MAJOR TOPIC PTR' FIELD POINTER

 N AUTMTP

 N DA,DIE,DR

 S AUTMTP=$$FIND(TIEN) Q:'+AUTMTP

 S DIE="^AUTTEDT(",DA=TIEN,DR=".07///`"_AUTMTP

 D ^DIE

 Q

 ;

FIND(TIEN) ;FIND MATCH FOR 'MAJOR TOPIC' FIELD TEXT IN EDUCATION MAJOR TOPIC

 ;TIEN = IEN OF EDUCATION TOPIC RECORD

 ;RETURNED VALUE - SUCCESSFUL = IEN OF MATCHED EDUCATION MAJOR TOPIC RECORD IEN

 ;               - UNSUCCESSFUL = 0^REASON FOR FAILURE

 N AUTMT,AUTMTP

 S U="^"

 S AUTQUIET=1  ;OUTPUT SILENCER FLAG

 ;

 I '+TIEN Q "0^INVALID TOPIC IEN VALUE PASSED"

 I '$D(^AUTTEDT(+TIEN,0)) Q "0^TOPIC RECORD "_+TIEN_" NOT FOUND"

 S AUTMT=$P(^AUTTEDT(TIEN,0),U,6)  ;'MAJOR TOPIC' FIELD TEXT

 I AUTMT="" Q "0^NO MAJOR TOPIC SPECIFIED"

 S AUTMTP=$D(^AUTTEDMT("B",AUTMT))

 I '+AUTMTP Q "0^NO MAJOR TOPIC MATCH FOUND"

 S AUTMTP=$O(^AUTTEDMT("B",AUTMT,""))

 Q +AUTMTP

 ;

CVTALL ;RUN 'MAJOR TOPIC' FIELD TEXT TO 'MAJOR TOPIC PTR' FIELD POINTER 

 ;     CONVERSION ON ALL EDUCATION TOPIC RECORDS

 N IEN

 S IEN=""

 S AUTQUIET=1 D CHECK

 F  S IEN=$O(AUTMATCH(IEN)) Q:IEN=""  D

 .D CVT(IEN)

 Q

 ;

KILL(TIEN) ;KILL 'MAJOR TOPIC PTR' FIELD VALUE IN EDUCATION TOPIC RECORD TIEN

 ;USED FOR KILL LOGIC OF MUMPS XREF ON EDUCATION TOPIC FILE'S 'MAJOR TOPIC' FIELD

 N DA,DIE,DR

 S DIE="^AUTTEDT("

 S DA=TIEN

 S DR=".07///@"

 D ^DIE

 Q

AUTEMTP   ;IHS/OIT/FBD - POPULATE EDUCATION MAJOR TOPIC PTR FIELD

 +1       ;;98.1;IHS DICTIONARIES (POINTERS);**26**;APR 03,2013;Build 6

 +2       ;

 +3       ;NO TOP-LEVEL ENTRY CALL

           QUIT 

 +4       ;

 +5       ;IN A GIVEN 'EDUCATION TOPICS' FILE ENTRY (RECORD IEN SPECIFIED

 +6       ;IN VARIABLE 'X'), THIS ROUTINE WILL POPULATE THE 'MAJOR TOPIC PTR'

 +7       ;FIELD BASED ON THE CONTENTS OF THE 'MAJOR TOPIC' FIELD.

 +8       ;

CHECK     ;PRE-POPULATION DATA PORTABILITY CHECK

 +1       ;EDUCATION TOPIC RECORD IEN

           SET AUTETIEN=0

 +2        KILL AUTCRUPT,AUTMATCH,AUTNOMAT,AUTMNULL

 +3       ;MATCH/MISMATCH COUNTERS

           SET (AUTCRUPT,AUTMATCH,AUTNOMAT,AUTMNULL)=0

 +4        IF '$DATA(AUTQUIET)

               WRITE !!,"EDUCATION TOPICS CHECK SCAN OF MAJOR TOPICS STARTED...",!!

 +5       ;

           FOR 

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

               IF '+AUTETIEN

                   QUIT 

               Begin DoDot:1

 +6                IF '$DATA(^AUTTEDT(AUTETIEN,0))

                       Begin DoDot:2

 +7                        SET AUTCRUPT=AUTCRUPT+1

                       End DoDot:2

                       QUIT 

 +8                SET AUTMTEXT=$PIECE(^AUTTEDT(AUTETIEN,0),U,6)

 +9                IF AUTMTEXT=""

                       Begin DoDot:2

 +10                       SET AUTMNULL=AUTMNULL+1

 +11                       SET AUTMNULL(AUTETIEN)=""

                       End DoDot:2

                       QUIT 

 +12               IF $DATA(^AUTTEDMT("B",AUTMTEXT))

                       Begin DoDot:2

 +13                       SET AUTMATCH=AUTMATCH+1

 +14                       SET AUTMATCH(AUTETIEN)=$ORDER(^AUTTEDMT("B",AUTMTEXT,""))

                       End DoDot:2

 +15              IF '$TEST

                       Begin DoDot:2

 +16                       SET AUTNOMAT=AUTNOMAT+1

 +17                       SET AUTNOMAT(AUTETIEN)=AUTMTEXT

                       End DoDot:2

               End DoDot:1

 +18       IF '$DATA(AUTQUIET)

               DO CHECKOUT

 +19       IF '$DATA(AUTQUIET)

               WRITE !,"CHECK SCAN COMPLETE.",!!

 +20       QUIT 

 +21      ;

CHECKOUT  ;OUTPUT FROM CHECK SCAN

 +1        WRITE !,"RESULTS OF MAJOR TOPICS SCAN:",!

 +2        WRITE ?5,"# OF MATCHED MAJOR TOPICS   = ",AUTMATCH,!

 +3        WRITE ?5,"# OF UNMATCHED MAJOR TOPICS = ",AUTNOMAT,!

 +4        WRITE ?5,"# OF NULL MAJOR TOPICS      = ",AUTMNULL,!

 +5        WRITE ?5,"# OF CORRUPTED ED TOPICS    = ",AUTCRUPT,!

 +6        QUIT 

 +7       ;

CVT(TIEN) ;CONVERT 'MAJOR TOPIC' FIELD TEXT TO 'MAJOR TOPIC PTR' FIELD POINTER

 +1        NEW AUTMTP

 +2        NEW DA,DIE,DR

 +3        SET AUTMTP=$$FIND(TIEN)

           IF '+AUTMTP

               QUIT 

 +4        SET DIE="^AUTTEDT("

           SET DA=TIEN

           SET DR=".07///`"_AUTMTP

 +5        DO ^DIE

 +6        QUIT 

 +7       ;

FIND(TIEN) ;FIND MATCH FOR 'MAJOR TOPIC' FIELD TEXT IN EDUCATION MAJOR TOPIC

 +1       ;TIEN = IEN OF EDUCATION TOPIC RECORD

 +2       ;RETURNED VALUE - SUCCESSFUL = IEN OF MATCHED EDUCATION MAJOR TOPIC RECORD IEN

 +3       ;               - UNSUCCESSFUL = 0^REASON FOR FAILURE

 +4        NEW AUTMT,AUTMTP

 +5        SET U="^"

 +6       ;OUTPUT SILENCER FLAG

           SET AUTQUIET=1

 +7       ;

 +8        IF '+TIEN

               QUIT "0^INVALID TOPIC IEN VALUE PASSED"

 +9        IF '$DATA(^AUTTEDT(+TIEN,0))

               QUIT "0^TOPIC RECORD "_+TIEN_" NOT FOUND"

 +10      ;'MAJOR TOPIC' FIELD TEXT

           SET AUTMT=$PIECE(^AUTTEDT(TIEN,0),U,6)

 +11       IF AUTMT=""

               QUIT "0^NO MAJOR TOPIC SPECIFIED"

 +12       SET AUTMTP=$DATA(^AUTTEDMT("B",AUTMT))

 +13       IF '+AUTMTP

               QUIT "0^NO MAJOR TOPIC MATCH FOUND"

 +14       SET AUTMTP=$ORDER(^AUTTEDMT("B",AUTMT,""))

 +15       QUIT +AUTMTP

 +16      ;

CVTALL    ;RUN 'MAJOR TOPIC' FIELD TEXT TO 'MAJOR TOPIC PTR' FIELD POINTER 

 +1       ;     CONVERSION ON ALL EDUCATION TOPIC RECORDS

 +2        NEW IEN

 +3        SET IEN=""

 +4        SET AUTQUIET=1

           DO CHECK

 +5        FOR 

               SET IEN=$ORDER(AUTMATCH(IEN))

               IF IEN=""

                   QUIT 

               Begin DoDot:1

 +6                DO CVT(IEN)

               End DoDot:1

 +7        QUIT 

 +8       ;

KILL(TIEN) ;KILL 'MAJOR TOPIC PTR' FIELD VALUE IN EDUCATION TOPIC RECORD TIEN

 +1       ;USED FOR KILL LOGIC OF MUMPS XREF ON EDUCATION TOPIC FILE'S 'MAJOR TOPIC' FIELD

 +2        NEW DA,DIE,DR

 +3        SET DIE="^AUTTEDT("

 +4        SET DA=TIEN

 +5        SET DR=".07///@"

 +6        DO ^DIE

 +7        QUIT