- 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 ;