ATSERCH2.m

ATSERCH2 ;TUCSON/DG;FLDCHK AND CHKPTRS MODULES FOR MERGE SEARCH UTILITY  [ 10/25/91  1:21 PM ]

 ;;2.5;SEARCH TEMPLATE COMPARISON;;OCT 25, 1991

 ;

 F L=0:0 D QUESTION Q:$D(ATSEXIT)!($D(ATSTOP))!($D(ATSEFRST))

 D:'$D(ATSEXIT)&('$D(ATSEFRST)) SET

 D EOJ

 Q

 ;

QUESTION ;PROMPTS USER FOR FIELD, CHECKS ^DD FOR FIELD AND DATA LOCATION

 K Y ;IN CASE TEMPLATES ARE THE SAME, Y WILL BE SET TO ATSYVAL

 I '$D(ATSAME) D CONTDIC,^DIC K DIC H 1 S:Y<0&(ATSUB=2) ATSEFRST="" Q:Y<0&(ATSUB=2)  I Y<0 S ATSFLAG=$S($D(^UTILITY("ATSEARCH",$J,"MERGED")):2,1:1) S ATSEXIT="" Q

 I ATSUB=1,ATSEARCH(1,"SRCHFILENUM")=ATSEARCH(2,"SRCHFILENUM") S ATSAME="",ATSYVAL=Y

 I '$D(Y) S Y=ATSYVAL

 S ATSEARCH(ATSUB,"FIELD")=+Y

 S ATSEARCH(ATSUB,"FIELDNAME")=$P(Y,U,2)

 S ATSEARCH(ATSUB,"SECONDPCE")=$P(^DD(ATSEARCH(ATSUB,"SRCHFILENUM"),ATSEARCH(ATSUB,"FIELD"),0),U,2)

 I ATSEARCH(ATSUB,"SECONDPCE")["V" W !,*7,"Variable pointers not allowed!" H 2 K ATSAME Q

 I ATSEARCH(ATSUB,"SECONDPCE")'["P",ATSEARCH(ATSUB,"FIELD")'=".01" W *7,!,"This field does not point to a file!" H 2 K ATSAME Q

 S ATSTOP=""

 Q

 ;

CONTDIC ;CONTINUES DIC CALL FOR ASKING USER FOR FIELD

 S DIC("A")="Select a common field from the "_ATSEARCH(ATSUB,"SRCHFILENAM")_" file for comparison: "

 S DIC="^DD("_ATSEARCH(ATSUB,"SRCHFILENUM")_",",DIC(0)="AEMQ"

 S DIC("S")="I +$P(^(0),U,2)'>0,(($P(^(0),U,2)[""P"")!($P(Y,U)=.01))"

 ;

 ;FIRST PART OF SCREEN IF NOT A MULTIPLE FIELD, SECOND PART IF

 ;A FIELD POINTS TO A FILE OR IS THE .01 FIELD

 ;

 Q

 ;

SET I ATSEARCH(ATSUB,"SECONDPCE")["P" F ATSI=1:1:99 Q:$A($E(ATSEARCH(ATSUB,"SECONDPCE"),ATSI))'>57&($A($E(ATSEARCH(ATSUB,"SECONDPCE"),ATSI))'<48)!($E(ATSEARCH(ATSUB,"SECONDPCE"),ATSI)="")

 I ATSEARCH(ATSUB,"SECONDPCE")["P",$E(ATSEARCH(ATSUB,"SECONDPCE"),ATSI)="" W *7,!!,"Dictionary of this file is flawed.  Check status of file!" H 2 S ATSFLAG=$S($D(^UTILITY("ATSEARCH",$J,"MERGED")):2,1:1) Q

 I ATSEARCH(ATSUB,"SECONDPCE")["P" S (ATSEARCH(ATSUB,"PTRFILENUM"),ATSEARCH("PTRFILENUM"))=+($E(ATSEARCH(ATSUB,"SECONDPCE"),ATSI,99))

 E  S ATSEARCH(ATSUB,"PTRFILENUM")=ATSEARCH(ATSUB,"SRCHFILENUM")

 S ATSEARCH(ATSUB,"PIECENUM")=$P($P(^DD(ATSEARCH(ATSUB,"SRCHFILENUM"),ATSEARCH(ATSUB,"FIELD"),0),U,4),";",2),ATSEARCH(ATSUB,"NODE")=$P($P(^DD(ATSEARCH(ATSUB,"SRCHFILENUM"),ATSEARCH(ATSUB,"FIELD"),0),U,4),";")

 S ATSEARCH(ATSUB,"DATAGLBLREF")=^DIC(ATSEARCH(ATSUB,"SRCHFILENUM"),0,"GL") ;SEARCH FILE DATA GLOBAL REFERENCE

 Q

 ;

EOJ ;

 K ATSTOP,ATSEXIT

 Q

 ;

ATSERCH2  ;TUCSON/DG;FLDCHK AND CHKPTRS MODULES FOR MERGE SEARCH UTILITY  [ 10/25/91  1:21 PM ]

 +1       ;;2.5;SEARCH TEMPLATE COMPARISON;;OCT 25, 1991

 +2       ;

 +3        FOR L=0:0

               DO QUESTION

               IF $DATA(ATSEXIT)!($DATA(ATSTOP))!($DATA(ATSEFRST))

                   QUIT 

 +4        IF '$DATA(ATSEXIT)&('$DATA(ATSEFRST))

               DO SET

 +5        DO EOJ

 +6        QUIT 

 +7       ;

QUESTION  ;PROMPTS USER FOR FIELD, CHECKS ^DD FOR FIELD AND DATA LOCATION

 +1       ;IN CASE TEMPLATES ARE THE SAME, Y WILL BE SET TO ATSYVAL

           KILL Y

 +2        IF '$DATA(ATSAME)

               DO CONTDIC

               DO ^DIC

               KILL DIC

               HANG 1

               IF Y<0&(ATSUB=2)

                   SET ATSEFRST=""

               IF Y<0&(ATSUB=2)

                   QUIT 

               IF Y<0

                   SET ATSFLAG=$SELECT($DATA(^UTILITY("ATSEARCH",$JOB,"MERGED")):2,1:1)

                   SET ATSEXIT=""

                   QUIT 

 +3        IF ATSUB=1

               IF ATSEARCH(1,"SRCHFILENUM")=ATSEARCH(2,"SRCHFILENUM")

                   SET ATSAME=""

                   SET ATSYVAL=Y

 +4        IF '$DATA(Y)

               SET Y=ATSYVAL

 +5        SET ATSEARCH(ATSUB,"FIELD")=+Y

 +6        SET ATSEARCH(ATSUB,"FIELDNAME")=$PIECE(Y,U,2)

 +7        SET ATSEARCH(ATSUB,"SECONDPCE")=$PIECE(^DD(ATSEARCH(ATSUB,"SRCHFILENUM"),ATSEARCH(ATSUB,"FIELD"),0),U,2)

 +8        IF ATSEARCH(ATSUB,"SECONDPCE")["V"

               WRITE !,*7,"Variable pointers not allowed!"

               HANG 2

               KILL ATSAME

               QUIT 

 +9        IF ATSEARCH(ATSUB,"SECONDPCE")'["P"

               IF ATSEARCH(ATSUB,"FIELD")'=".01"

                   WRITE *7,!,"This field does not point to a file!"

                   HANG 2

                   KILL ATSAME

                   QUIT 

 +10       SET ATSTOP=""

 +11       QUIT 

 +12      ;

CONTDIC   ;CONTINUES DIC CALL FOR ASKING USER FOR FIELD

 +1        SET DIC("A")="Select a common field from the "_ATSEARCH(ATSUB,"SRCHFILENAM")_" file for comparison: "

 +2        SET DIC="^DD("_ATSEARCH(ATSUB,"SRCHFILENUM")_","

           SET DIC(0)="AEMQ"

 +3        SET DIC("S")="I +$P(^(0),U,2)'>0,(($P(^(0),U,2)[""P"")!($P(Y,U)=.01))"

 +4       ;

 +5       ;FIRST PART OF SCREEN IF NOT A MULTIPLE FIELD, SECOND PART IF

 +6       ;A FIELD POINTS TO A FILE OR IS THE .01 FIELD

 +7       ;

 +8        QUIT 

 +9       ;

SET        IF ATSEARCH(ATSUB,"SECONDPCE")["P"

               FOR ATSI=1:1:99

                   IF $ASCII($EXTRACT(ATSEARCH(ATSUB,"SECONDPCE"),ATSI))'>57&($ASCII($EXTRACT(ATSEARCH(ATSUB,"SECONDPCE"),ATSI))'<48)!($EXTRACT(ATSEARCH(ATSUB,"SECONDPCE"),ATSI)="")

                       QUIT 

 +1        IF ATSEARCH(ATSUB,"SECONDPCE")["P"

               IF $EXTRACT(ATSEARCH(ATSUB,"SECONDPCE"),ATSI)=""

                   WRITE *7,!!,"Dictionary of this file is flawed.  Check status of file!"

                   HANG 2

                   SET ATSFLAG=$SELECT($DATA(^UTILITY("ATSEARCH",$JOB,"MERGED")):2,1:1)

                   QUIT 

 +2        IF ATSEARCH(ATSUB,"SECONDPCE")["P"

               SET (ATSEARCH(ATSUB,"PTRFILENUM"),ATSEARCH("PTRFILENUM"))=+($EXTRACT(ATSEARCH(ATSUB,"SECONDPCE"),ATSI,99))

 +3       IF '$TEST

               SET ATSEARCH(ATSUB,"PTRFILENUM")=ATSEARCH(ATSUB,"SRCHFILENUM")

 +4        SET ATSEARCH(ATSUB,"PIECENUM")=$PIECE($PIECE(^DD(ATSEARCH(ATSUB,"SRCHFILENUM"),ATSEARCH(ATSUB,"FIELD"),0),U,4),";",2)

           SET ATSEARCH(ATSUB,"NODE")=$PIECE($PIECE(^DD(ATSEARCH(ATSUB,"SRCHFILENUM"),ATSEARCH(ATSUB,"FIELD"),0),U,4),";")

 +5       ;SEARCH FILE DATA GLOBAL REFERENCE

           SET ATSEARCH(ATSUB,"DATAGLBLREF")=^DIC(ATSEARCH(ATSUB,"SRCHFILENUM"),0,"GL")

 +6        QUIT 

 +7       ;

EOJ       ;

 +1        KILL ATSTOP,ATSEXIT

 +2        QUIT 

 +3       ;