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