ATSERCHE.m

ATSERCHE ;TUCSON/DG;CALL FROM ATSERCH TO CHECK POINTER FIELDS  [ 10/25/91  1:22 PM ]

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

 ;

CHKPTRS ;MAKES SURE THE FILE POINTED TO ARE THE SAME FOR EACH FIELD

 ;I ATSEARCH(1,"SRCHRESLTREF")=ATSEARCH(2,"SRCHRESLTREF"),ATSEARCH(1,"FIELD")=.01 W !!,*7,"You can only choose a field other than the .01 field from this file.",!,"This field must point to a different file." Q

 ;PREVIOUS LINE REMOVED TO ALLOW THE DENTAL SYSTEM VERSION 5 TO COMPARE A TEMPLATE FROM ITS DENTAL PROCEDURE FILE TO ITSELF SINCE ITS .01 FIELD ENTRIES ARE NOT UNIQUE

 I ATSEARCH(1,"SRCHFILENUM")=ATSEARCH(2,"SRCHFILENUM"),ATSEARCH(2,"SRCHFILENUM")=ATSEARCH(1,"PTRFILENUM"),ATSEARCH(1,"SRCHFILENUM")=ATSEARCH(2,"PTRFILENUM") D CONT S ATSTOP="" Q

 ;LINE ABOVE DETERMINES THAT FILE WITH BOTH TEMPLATES HAS A .01 FIELD THAT IS NOT A POINTER, IT SETS ATSEARCH(1&2,"PTEDTOFILE")=0 SINCE BOTH TEMPLATES ARE LINKED TO A FILE WHOSE .01 FIELD DOESN'T

 ;POINT ANYWHERE (ACTS AS A POINTED TO FILE -  SEE GET3^ATSERCH4 WHICH IS CALLED FROM GET+2^ATSERCH4

 I ATSEARCH(2,"SRCHFILENUM")=ATSEARCH(1,"PTRFILENUM"),ATSEARCH(2,"FIELD")=".01" S ATSEARCH(2,"PTEDTOFILE")=0,ATSEARCH("PTRFILENUM")=ATSEARCH(2,"SRCHFILENUM"),ATSEARCH("PTRFILENAM")=$P(^DIC(ATSEARCH("PTRFILENUM"),0),U) S ATSTOP="" Q

 I ATSEARCH(1,"SRCHFILENUM")=ATSEARCH(2,"PTRFILENUM"),ATSEARCH(1,"FIELD")=".01" S ATSEARCH(1,"PTEDTOFILE")=0,ATSEARCH("PTRFILENUM")=ATSEARCH(1,"SRCHFILENUM"),ATSEARCH("PTRFILENAM")=$P(^DIC(ATSEARCH("PTRFILENUM"),0),U) S ATSTOP="" Q

 I ATSEARCH(1,"PTRFILENUM")'=ATSEARCH(2,"PTRFILENUM") D DINUM Q:$D(ATSTOP)

 I ATSEARCH(1,"PTRFILENUM")'=ATSEARCH(2,"PTRFILENUM") W !!,*7,"Fields do not point to the same file or one of the files is not the pointed",!,"to file!" Q

 E  S ATSTOP="",ATSEARCH("PTRFILENAM")=$P(^DIC(ATSEARCH(1,"PTRFILENUM"),0),U)

 Q

 ;

CONT ;CONTINUATION OF LINE CHKPTRS+2

 S (ATSEARCH(1,"PTEDTOFILE"),ATSEARCH(2,"PTEDTOFILE"))=0,ATSEARCH("PTRFILENUM")=ATSEARCH(1,"SRCHFILENUM")

 S ATSEARCH("PTRFILENAM")=$P(^DIC(ATSEARCH("PTRFILENUM"),0),U) S ATSTOP=""

 S ATSNPT=""

 Q

 ;

DINUM ;CHECKS IF ONE PTRFILE PTS TO THE OTHER, IF IT DOES IS IT DINUM TO THAT FILE

 S ATSPTR1=^DD(ATSEARCH(1,"PTRFILENUM"),.01,0),ATSPTR2=^DD(ATSEARCH(2,"PTRFILENUM"),.01,0)

 I $P(ATSPTR1,U,2)["P" S ATS1=$P(ATSPTR1,U,2) F ATSI=1:1:99 Q:$A($E(ATS1,ATSI))'>57&($A($E(ATS1,ATSI))'<48)!($E(ATS1,ATSI)="")

 I $D(ATS1) S ATS1=+$E(ATS1,ATSI,99)

 I $P(ATSPTR2,U,2)["P" S ATS2=$P(ATSPTR2,U,2) F ATSI=1:1:99 Q:$A($E(ATS2,ATSI))'>57&($A($E(ATS2,ATSI))'<48)!($E(ATS2,ATSI)="")

 I $D(ATS2) S ATS2=+$E(ATS2,ATSI,99)

 I $D(ATS1),ATS1=ATSEARCH(2,"PTRFILENUM"),$P(ATSPTR1,U,5)["DINUM" D DINUM1 S ATSEARCH(2,"PTRFILENUM")=ATSEARCH(1,"PTRFILENUM"),ATSEARCH("PTRFILENAM")=$P(^DIC(ATSEARCH(1,"PTRFILENUM"),0),U),ATSTOP="" G A

 I $D(ATS2),ATS2=ATSEARCH(1,"PTRFILENUM"),$P(ATSPTR2,U,5)["DINUM" D DINUM2 S ATSEARCH(1,"PTRFILENUM")=ATSEARCH(2,"PTRFILENUM"),ATSEARCH("PTRFILENAM")=$P(^DIC(ATSEARCH(1,"PTRFILENUM"),0),U),ATSTOP="" G A

 ;IF THE FILE POINTS TO THE OTHER AND IS DINUM SET THE PTRFILE TO THE FILE THAT IS DINUM TO THE OTHER

A K ATSPTR1,ATSPTR2,ATS1,ATS2

 Q

 ;

DINUM1 ;

 I ATSEARCH(2,"PTRFILENUM")=ATSEARCH(2,"SRCHFILENUM") S ATSEARCH(2,"PTEDTOFILE")=0

 Q

 ;

DINUM2 ;

 I ATSEARCH(1,"PTRFILENUM")=ATSEARCH(1,"SRCHFILENUM") S ATSEARCH(1,"PTEDTOFILE")=0

 Q

 ;

ATSERCHE  ;TUCSON/DG;CALL FROM ATSERCH TO CHECK POINTER FIELDS  [ 10/25/91  1:22 PM ]

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

 +2       ;

CHKPTRS   ;MAKES SURE THE FILE POINTED TO ARE THE SAME FOR EACH FIELD

 +1       ;I ATSEARCH(1,"SRCHRESLTREF")=ATSEARCH(2,"SRCHRESLTREF"),ATSEARCH(1,"FIELD")=.01 W !!,*7,"You can only choose a field other than the .01 field from this file.",!,"This field must point to a different file." Q

 +2       ;PREVIOUS LINE REMOVED TO ALLOW THE DENTAL SYSTEM VERSION 5 TO COMPARE A TEMPLATE FROM ITS DENTAL PROCEDURE FILE TO ITSELF SINCE ITS .01 FIELD ENTRIES ARE NOT UNIQUE

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

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

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

                       DO CONT

                       SET ATSTOP=""

                       QUIT 

 +4       ;LINE ABOVE DETERMINES THAT FILE WITH BOTH TEMPLATES HAS A .01 FIELD THAT IS NOT A POINTER, IT SETS ATSEARCH(1&2,"PTEDTOFILE")=0 SINCE BOTH TEMPLATES ARE LINKED TO A FILE WHOSE .01 FIELD DOESN'T

 +5       ;POINT ANYWHERE (ACTS AS A POINTED TO FILE -  SEE GET3^ATSERCH4 WHICH IS CALLED FROM GET+2^ATSERCH4

 +6        IF ATSEARCH(2,"SRCHFILENUM")=ATSEARCH(1,"PTRFILENUM")

               IF ATSEARCH(2,"FIELD")=".01"

                   SET ATSEARCH(2,"PTEDTOFILE")=0

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

                   SET ATSEARCH("PTRFILENAM")=$PIECE(^DIC(ATSEARCH("PTRFILENUM"),0),U)

                   SET ATSTOP=""

                   QUIT 

 +7        IF ATSEARCH(1,"SRCHFILENUM")=ATSEARCH(2,"PTRFILENUM")

               IF ATSEARCH(1,"FIELD")=".01"

                   SET ATSEARCH(1,"PTEDTOFILE")=0

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

                   SET ATSEARCH("PTRFILENAM")=$PIECE(^DIC(ATSEARCH("PTRFILENUM"),0),U)

                   SET ATSTOP=""

                   QUIT 

 +8        IF ATSEARCH(1,"PTRFILENUM")'=ATSEARCH(2,"PTRFILENUM")

               DO DINUM

               IF $DATA(ATSTOP)

                   QUIT 

 +9        IF ATSEARCH(1,"PTRFILENUM")'=ATSEARCH(2,"PTRFILENUM")

               WRITE !!,*7,"Fields do not point to the same file or one of the files is not the pointed",!,"to file!"

               QUIT 

 +10      IF '$TEST

               SET ATSTOP=""

               SET ATSEARCH("PTRFILENAM")=$PIECE(^DIC(ATSEARCH(1,"PTRFILENUM"),0),U)

 +11       QUIT 

 +12      ;

CONT      ;CONTINUATION OF LINE CHKPTRS+2

 +1        SET (ATSEARCH(1,"PTEDTOFILE"),ATSEARCH(2,"PTEDTOFILE"))=0

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

 +2        SET ATSEARCH("PTRFILENAM")=$PIECE(^DIC(ATSEARCH("PTRFILENUM"),0),U)

           SET ATSTOP=""

 +3        SET ATSNPT=""

 +4        QUIT 

 +5       ;

DINUM     ;CHECKS IF ONE PTRFILE PTS TO THE OTHER, IF IT DOES IS IT DINUM TO THAT FILE

 +1        SET ATSPTR1=^DD(ATSEARCH(1,"PTRFILENUM"),.01,0)

           SET ATSPTR2=^DD(ATSEARCH(2,"PTRFILENUM"),.01,0)

 +2        IF $PIECE(ATSPTR1,U,2)["P"

               SET ATS1=$PIECE(ATSPTR1,U,2)

               FOR ATSI=1:1:99

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

                       QUIT 

 +3        IF $DATA(ATS1)

               SET ATS1=+$EXTRACT(ATS1,ATSI,99)

 +4        IF $PIECE(ATSPTR2,U,2)["P"

               SET ATS2=$PIECE(ATSPTR2,U,2)

               FOR ATSI=1:1:99

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

                       QUIT 

 +5        IF $DATA(ATS2)

               SET ATS2=+$EXTRACT(ATS2,ATSI,99)

 +6        IF $DATA(ATS1)

               IF ATS1=ATSEARCH(2,"PTRFILENUM")

                   IF $PIECE(ATSPTR1,U,5)["DINUM"

                       DO DINUM1

                       SET ATSEARCH(2,"PTRFILENUM")=ATSEARCH(1,"PTRFILENUM")

                       SET ATSEARCH("PTRFILENAM")=$PIECE(^DIC(ATSEARCH(1,"PTRFILENUM"),0),U)

                       SET ATSTOP=""

                       GOTO A

 +7        IF $DATA(ATS2)

               IF ATS2=ATSEARCH(1,"PTRFILENUM")

                   IF $PIECE(ATSPTR2,U,5)["DINUM"

                       DO DINUM2

                       SET ATSEARCH(1,"PTRFILENUM")=ATSEARCH(2,"PTRFILENUM")

                       SET ATSEARCH("PTRFILENAM")=$PIECE(^DIC(ATSEARCH(1,"PTRFILENUM"),0),U)

                       SET ATSTOP=""

                       GOTO A

 +8       ;IF THE FILE POINTS TO THE OTHER AND IS DINUM SET THE PTRFILE TO THE FILE THAT IS DINUM TO THE OTHER

A          KILL ATSPTR1,ATSPTR2,ATS1,ATS2

 +1        QUIT 

 +2       ;

DINUM1    ;

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

               SET ATSEARCH(2,"PTEDTOFILE")=0

 +2        QUIT 

 +3       ;

DINUM2    ;

 +1        IF ATSEARCH(1,"PTRFILENUM")=ATSEARCH(1,"SRCHFILENUM")

               SET ATSEARCH(1,"PTEDTOFILE")=0

 +2        QUIT 

 +3       ;