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