ATSERCH ;TUCSON/DG;COMPARE TWO SORT TEMPLATES WITH SEARCH RESULTS [ 10/25/91 1:39 PM ]
;;2.5;SEARCH TEMPLATE COMPARISON;;OCT 25, 1991
START ;
D INIT
F ATSL=0:0 S ATSLOOP=ATSLOOP+1 D LOOP Q:ATSFLAG W !
D EOJ
Q
;
INIT ;
K ^UTILITY("ATSEARCH",$J),^UTILITY("ATSPECS",$J),^UTILITY("DIQ1",$J)
S U="^",(ATSLOOP,ATSFLAG,ATSLIST,ATSTASK,ATSEINRL)=0
I '$D(DTIME) S DTIME=300
I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y
Q
;
LOOP ;
I ATSLOOP>1 S ^UTILITY("ATSEARCH",$J,"FILELINK")=ATSEARCH("FILELINK")
I '$D(^UTILITY("ATSEARCH",$J,"MERGED")) S ATSUB=1,ATSWORD="" D TEMP W !
I ATSFLAG Q
I 'ATSEINRL S ATSUB=2,ATSWORD="nother" D TEMP
I ATSFLAG=1 Q
I ATSFLAG=2 S ATSTORE=1 D CALLSORT^ATSERCH5 Q
D ^ATSERCH7
I ATSFLAG=1 Q
I ATSFLAG=2 S ATSTORE=1 D CALLSORT^ATSERCH5 Q
F L=0:0 D CALL I $D(ATSTOP)!(ATSFLAG) K ATSTOP Q
;
;PREVIOUS LINE CALLS FLDCHK AND CHKPTRS UNTIL EITHER USER HATS OUT
;OR RETURNS OUT (SETS ATSFLAG) OR GETS VALID FIELDS (BOTH POINT
;TO THE SAME FILE OR ONE OF THEM IS THE .01 FIELD OF THE FILE
;POINTED TO AND THE OTHER FIELD POINTS TO IT - SETS ATSTOP
;K ATSTOP SO THAT IF COMPARE ANOTHER TEMPLATE, ATSTOP NOT
;SET WHEN ENTER ATSERCH2 (WILL STOP THE LOOP EVEN FIELD DOESN'T POINT)
;
I ATSFLAG Q
S ATSENLAG=0 F L=0:0 Q:ATSENLAG D NULL^ATSERCH7
D @$S(ATSENLAG=2:"^ATSERCHB",1:"^ATSERCH9")
I ATSFLAG=1 Q
I ATSFLAG=2 S ATSTORE=1 D CALLSORT^ATSERCH5 Q
D ^ATSERCH6 Q:ATSFLAG=1
I ATSFLAG=2 S ATSTORE=1 D CALLSORT^ATSERCH5 Q
D ^ATSERCH5
Q
;
TEMP ;ASK FOR TEMPLATE
K ATSENT
S DIC("A")="Select a"_ATSWORD_" TEMPLATE: ",DIC="^DIBT(",DIC(0)="QAEZ" D ^DIC K DIC S:((Y>0)&('$D(^DIBT(+Y,1)))) ATSENT="" W:$D(ATSENT) !,"No entries in this template!",*7 G:$D(ATSENT) TEMP D I ATSFLAG Q
. I Y<0 S ATSFLAG=$S($D(^UTILITY("ATSEARCH",$J,"MERGED")):2,1:1) Q
I $D(^DIBT(+Y,"%D")) S ATSPC=0 F L=0:0 S ATSPC=$O(^DIBT(+Y,"%D",ATSPC)) Q:ATSPC'=+ATSPC W !,^DIBT(+Y,"%D",ATSPC,0)
E I $D(^DIBT(+Y,"O")) S ATSPC=0 F L=0:0 S ATSPC=$O(^DIBT(+Y,"O",ATSPC)) Q:ATSPC'=+ATSPC W !,^DIBT(+Y,"O",ATSPC,0)
I ($D(^DIBT(+Y,"O"))!($D(^DIBT(+Y,"%D")))),'$D(ATSPEC(+Y)),ATSLOOP=1 S ATSEARCH("SEARCHSPECS",ATSLOOP,ATSUB)=$S($D(^DIBT(+Y,"%D")):"^DIBT("_+Y_",""%D"",",1:"^DIBT("_+Y_",""O"","),ATSPEC(+Y)=""
E I ($D(^DIBT(+Y,"O"))!($D(^DIBT(+Y,"%D")))),ATSLOOP'=1 S ATSEARCH("SEARCHSPECS",ATSLOOP,ATSUB)=$S($D(^DIBT(+Y,"%D")):"^DIBT("_+Y_",""%D"",",1:"^DIBT("_+Y_",""O"",")
S ATSEARCH("SRCHTEMPDFN",ATSUB)=Y
S ATSEARCH(ATSUB,"SRCHNAM")=$P(Y,U,2)
S ATSEARCH(ATSUB,"SRCHFILENUM")=$P(^DIBT(+Y,0),U,4)
S ATSEARCH(ATSUB,"SRCHRESLTREF")="^DIBT("_+Y_",1,"
S ATSEARCH(ATSUB,"SRCHFILENAM")=$P(^DIC(ATSEARCH(ATSUB,"SRCHFILENUM"),0),U)
Q
;
CALL ;CALL TO FLDCHK AND CHKPTRS (NOW CHKPTRS IS IN ATSERCHE)
K ATSAME,ATSYVAL ;IN CASE PREVIOUS TEMPLATES LINKED TO SAME FILE
;ZT 1
S ATSUB=1 W ! D ^ATSERCH2
I ATSFLAG=1 Q
I ATSFLAG=2 S ATSTORE=1 D CALLSORT^ATSERCH5 Q
S ATSUB=2 D ^ATSERCH2
I $D(ATSEFRST) K ATSEFRST Q
I ATSFLAG=1 Q
I ATSFLAG=2 S ATSTORE=1 D CALLSORT^ATSERCH5 Q
I '$D(ATSEXIT) D ^ATSERCHE
I ATSFLAG=1 Q
I ATSFLAG=2 S ATSTORE=1 D CALLSORT^ATSERCH5 Q
Q
;
EOJ ; - EP -
K ^UTILITY("ATSEARCH",$J),^UTILITY("ATSPECS",$J)
K ATSFLAG,ATSX,ATSEARCH,ATSI,ATSWORD,ATSASK,ATSL,ATSUB,ATSVAR,ATSPEC,ATSDFN,ATSUM,ATSTORE,ATSMSG,ATSCREEN,ATSMAT,ATSMAT1,ATSLOOP,ATSLIST,ATSRCSTR,ATSETMP
K ATSAME,ATSPC,ATSYVAL,ATSXVAR,ATSEINRL,ATSMTCH,ATSNOT,ATSENLAG,ATSTASK,ATSTMPNM
Q
;
ATSERCH ;TUCSON/DG;COMPARE TWO SORT TEMPLATES WITH SEARCH RESULTS [ 10/25/91 1:39 PM ]
+1 ;;2.5;SEARCH TEMPLATE COMPARISON;;OCT 25, 1991
START ;
+1 DO INIT
+2 FOR ATSL=0:0
SET ATSLOOP=ATSLOOP+1
DO LOOP
IF ATSFLAG
QUIT
WRITE !
+3 DO EOJ
+4 QUIT
+5 ;
INIT ;
+1 KILL ^UTILITY("ATSEARCH",$JOB),^UTILITY("ATSPECS",$JOB),^UTILITY("DIQ1",$JOB)
+2 SET U="^"
SET (ATSLOOP,ATSFLAG,ATSLIST,ATSTASK,ATSEINRL)=0
+3 IF '$DATA(DTIME)
SET DTIME=300
+4 IF '$DATA(DT)
SET %DT=""
SET X="T"
DO ^%DT
SET DT=Y
+5 QUIT
+6 ;
LOOP ;
+1 IF ATSLOOP>1
SET ^UTILITY("ATSEARCH",$JOB,"FILELINK")=ATSEARCH("FILELINK")
+2 IF '$DATA(^UTILITY("ATSEARCH",$JOB,"MERGED"))
SET ATSUB=1
SET ATSWORD=""
DO TEMP
WRITE !
+3 IF ATSFLAG
QUIT
+4 IF 'ATSEINRL
SET ATSUB=2
SET ATSWORD="nother"
DO TEMP
+5 IF ATSFLAG=1
QUIT
+6 IF ATSFLAG=2
SET ATSTORE=1
DO CALLSORT^ATSERCH5
QUIT
+7 DO ^ATSERCH7
+8 IF ATSFLAG=1
QUIT
+9 IF ATSFLAG=2
SET ATSTORE=1
DO CALLSORT^ATSERCH5
QUIT
+10 FOR L=0:0
DO CALL
IF $DATA(ATSTOP)!(ATSFLAG)
KILL ATSTOP
QUIT
+11 ;
+12 ;PREVIOUS LINE CALLS FLDCHK AND CHKPTRS UNTIL EITHER USER HATS OUT
+13 ;OR RETURNS OUT (SETS ATSFLAG) OR GETS VALID FIELDS (BOTH POINT
+14 ;TO THE SAME FILE OR ONE OF THEM IS THE .01 FIELD OF THE FILE
+15 ;POINTED TO AND THE OTHER FIELD POINTS TO IT - SETS ATSTOP
+16 ;K ATSTOP SO THAT IF COMPARE ANOTHER TEMPLATE, ATSTOP NOT
+17 ;SET WHEN ENTER ATSERCH2 (WILL STOP THE LOOP EVEN FIELD DOESN'T POINT)
+18 ;
+19 IF ATSFLAG
QUIT
+20 SET ATSENLAG=0
FOR L=0:0
IF ATSENLAG
QUIT
DO NULL^ATSERCH7
+21 DO @$SELECT(ATSENLAG=2:"^ATSERCHB",1:"^ATSERCH9")
+22 IF ATSFLAG=1
QUIT
+23 IF ATSFLAG=2
SET ATSTORE=1
DO CALLSORT^ATSERCH5
QUIT
+24 DO ^ATSERCH6
IF ATSFLAG=1
QUIT
+25 IF ATSFLAG=2
SET ATSTORE=1
DO CALLSORT^ATSERCH5
QUIT
+26 DO ^ATSERCH5
+27 QUIT
+28 ;
TEMP ;ASK FOR TEMPLATE
+1 KILL ATSENT
+2 SET DIC("A")="Select a"_ATSWORD_" TEMPLATE: "
SET DIC="^DIBT("
SET DIC(0)="QAEZ"
DO ^DIC
KILL DIC
IF ((Y>0)&('$DATA(^DIBT(+Y,1))))
SET ATSENT=""
IF $DATA(ATSENT)
WRITE !,"No entries in this template!",*7
IF $DATA(ATSENT)
GOTO TEMP
Begin DoDot:1
+3 IF Y<0
SET ATSFLAG=$SELECT($DATA(^UTILITY("ATSEARCH",$JOB,"MERGED")):2,1:1)
QUIT
End DoDot:1
IF ATSFLAG
QUIT
+4 IF $DATA(^DIBT(+Y,"%D"))
SET ATSPC=0
FOR L=0:0
SET ATSPC=$ORDER(^DIBT(+Y,"%D",ATSPC))
IF ATSPC'=+ATSPC
QUIT
WRITE !,^DIBT(+Y,"%D",ATSPC,0)
+5 IF '$TEST
IF $DATA(^DIBT(+Y,"O"))
SET ATSPC=0
FOR L=0:0
SET ATSPC=$ORDER(^DIBT(+Y,"O",ATSPC))
IF ATSPC'=+ATSPC
QUIT
WRITE !,^DIBT(+Y,"O",ATSPC,0)
+6 IF ($DATA(^DIBT(+Y,"O"))!($DATA(^DIBT(+Y,"%D"))))
IF '$DATA(ATSPEC(+Y))
IF ATSLOOP=1
SET ATSEARCH("SEARCHSPECS",ATSLOOP,ATSUB)=$SELECT($DATA(^DIBT(+Y,"%D")):"^DIBT("_+Y_",""%D"",",1:"^DIBT("_+Y_",""O"",")
SET ATSPEC(+Y)=""
+7 IF '$TEST
IF ($DATA(^DIBT(+Y,"O"))!($DATA(^DIBT(+Y,"%D"))))
IF ATSLOOP'=1
SET ATSEARCH("SEARCHSPECS",ATSLOOP,ATSUB)=$SELECT($DATA(^DIBT(+Y,"%D")):"^DIBT("_+Y_",""%D"",",1:"^DIBT("_+Y_",""O"",")
+8 SET ATSEARCH("SRCHTEMPDFN",ATSUB)=Y
+9 SET ATSEARCH(ATSUB,"SRCHNAM")=$PIECE(Y,U,2)
+10 SET ATSEARCH(ATSUB,"SRCHFILENUM")=$PIECE(^DIBT(+Y,0),U,4)
+11 SET ATSEARCH(ATSUB,"SRCHRESLTREF")="^DIBT("_+Y_",1,"
+12 SET ATSEARCH(ATSUB,"SRCHFILENAM")=$PIECE(^DIC(ATSEARCH(ATSUB,"SRCHFILENUM"),0),U)
+13 QUIT
+14 ;
CALL ;CALL TO FLDCHK AND CHKPTRS (NOW CHKPTRS IS IN ATSERCHE)
+1 ;IN CASE PREVIOUS TEMPLATES LINKED TO SAME FILE
KILL ATSAME,ATSYVAL
+2 ;ZT 1
+3 SET ATSUB=1
WRITE !
DO ^ATSERCH2
+4 IF ATSFLAG=1
QUIT
+5 IF ATSFLAG=2
SET ATSTORE=1
DO CALLSORT^ATSERCH5
QUIT
+6 SET ATSUB=2
DO ^ATSERCH2
+7 IF $DATA(ATSEFRST)
KILL ATSEFRST
QUIT
+8 IF ATSFLAG=1
QUIT
+9 IF ATSFLAG=2
SET ATSTORE=1
DO CALLSORT^ATSERCH5
QUIT
+10 IF '$DATA(ATSEXIT)
DO ^ATSERCHE
+11 IF ATSFLAG=1
QUIT
+12 IF ATSFLAG=2
SET ATSTORE=1
DO CALLSORT^ATSERCH5
QUIT
+13 QUIT
+14 ;
EOJ ; - EP -
+1 KILL ^UTILITY("ATSEARCH",$JOB),^UTILITY("ATSPECS",$JOB)
+2 KILL ATSFLAG,ATSX,ATSEARCH,ATSI,ATSWORD,ATSASK,ATSL,ATSUB,ATSVAR,ATSPEC,ATSDFN,ATSUM,ATSTORE,ATSMSG,ATSCREEN,ATSMAT,ATSMAT1,ATSLOOP,ATSLIST,ATSRCSTR,ATSETMP
+3 KILL ATSAME,ATSPC,ATSYVAL,ATSXVAR,ATSEINRL,ATSMTCH,ATSNOT,ATSENLAG,ATSTASK,ATSTMPNM
+4 QUIT
+5 ;
