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