ATSERCHF ;TUCSON/DG;JOINS TWO TEMPLATES LINKED TO SAME FILE [ 10/25/91 1:22 PM ]
;;2.5;SEARCH TEMPLATE COMPARISON;;OCT 25, 1991
;
S Y="" F ATSL=0:0 Q:Y]"" D SORTEMP
I '$D(ATSTP) D ZIS D @$S($D(ATSTSK):"TSKMN",1:"STORE")
D EOJ
Q
;
SORTEMP ;CREATES SORT TEMPLATE
S ATSEARCH("FILELINK")=ATSEARCH(1,"SRCHFILENUM")
W ! S DIC="^DIBT(",DIC("DR")="[ATSEARCH]",DIC(0)="AEMQL",DLAYGO=.401,DIC("A")="Store results in SEARCH TEMPLATE: ",DIC("S")="I $P(^(0),U,5)=DUZ&($P(^(0),U,4)=ATSEARCH(1,""SRCHFILENUM""))" D ^DIC K DIC I Y<0 S ATSTP="" Q
S ATSTMP=+Y ;SAVE DFN OF TEMPLATE CHOSEN OR CREATED BY USER
I ATSTMP=$P(ATSEARCH("SRCHTEMPDFN",1),U)!(ATSTMP=$P(ATSEARCH("SRCHTEMPDFN",2),U)) W !,*7,"Choose a template other than one of the templates you are using in the joining." S Y="" Q
I $D(^DIBT(ATSTMP,2)) W !!,*7,"You cannot store results in a template used only for sort purposes." S Y="" Q
I '$D(^DIBT(ATSTMP,1))&('$D(^DIBT(ATSTMP,"DIS"))) Q ;NO RESULTS, NO FM SEARCH CODE
I $D(^DIBT(ATSTMP,1)) W !,*7,"Results already stored in this template. Do you want to have",!,"the stored data deleted" S %=1 D YN^DICN
I '$D(^DIBT(ATSTMP,1)) S %=1 ;IF A SEARCH TEMPLATE WITH NO RESULTS STORED
I %=2 S Y="" Q
I %=1 S DIE="^DIBT(",DA=ATSTMP,DR="[ATSDEL]" D ^DIE K DIE D TEST Q
S Y=""
Q
;
TEST ;SEE IF USER HATTED OUT OF [ATSDEL]
I $D(ATSY) S Y="" K ATSY Q
E K ^DIBT(ATSTMP,1),^("DIS"),^("O") S Y=1
Q
;
ZIS ;SEE IF USER QUEUES ;
W !!,"Do you want to queue the merge to another device" S %=2 D YN^DICN
I %=2 G A
I %=0 W !,"Enter ""Y"" if you want to queue the joining of the templates to another device." G ZIS
I %=-1 G A
K IO("Q")
S %IS="PQ",IOP="Q" D ^%ZIS
I $D(IO("Q")),'POP S ATSTSK=""
A Q
;
TSKMN ;
K ZTSAVE F %="ATSTMP","ATSEARCH(1,""SRCHRESLTREF"")","ATSEARCH(2,""SRCHRESLTREF"")" S ZTSAVE(%)="" S:$D(ATSTSK) ZTSAVE("ATSTSK")=""
S ZTRTN="ZTM^ATSERCHF",ZTDESC="MERGE TWO SEARCH TEMPLATES",ZTIO=IO,ZTDTH="" D ^%ZTLOAD
X ^%ZIS("C")
Q
;
ZTM ;
D STORE
D EOJ
I $D(ZTQUEUED) S ZTREQ="@"
K ATSEARCH(1,"SRCHRESLTREF"),ATSEARCH(2,"SRCHRESLTREF")
Q
;
STORE ;STORES DFNS IN SEARCH TEMPLATE
I '$D(ATSTSK) W !,"Please wait "
F ATSI=1:1:2 S ATSDFN=0 F ATSL=0:0 S ATSDFN=$O(@(ATSEARCH(ATSI,"SRCHRESLTREF")_ATSDFN_")")) Q:ATSDFN'=+ATSDFN S ^DIBT(ATSTMP,1,ATSDFN)="" W:'$D(ATSTSK) "."
S (ATSDFN,ATSCNT)=0 F L=0:0 S ATSDFN=$O(^DIBT(ATSTMP,1,ATSDFN)) Q:'ATSDFN S ATSCNT=ATSCNT+1
S ^DIBT(ATSTMP,1,0)=ATSCNT ; added line 2-7-91 dg/ohprd
W !,"There are ",ATSCNT," entries in the ",$P(^DIBT(ATSTMP,0),U)," template.",!
I '$D(ATSTSK) W !,"Done!"
Q
;
EOJ ;
K ATSDFN,ATSI,ATSL,ATSETMP,ATSY,ATSTP,ATSCNT,ATSTSK,IO("Q")
Q
;
ATSERCHF ;TUCSON/DG;JOINS TWO TEMPLATES LINKED TO SAME FILE [ 10/25/91 1:22 PM ]
+1 ;;2.5;SEARCH TEMPLATE COMPARISON;;OCT 25, 1991
+2 ;
+3 SET Y=""
FOR ATSL=0:0
IF Y]""
QUIT
DO SORTEMP
+4 IF '$DATA(ATSTP)
DO ZIS
DO @$SELECT($DATA(ATSTSK):"TSKMN",1:"STORE")
+5 DO EOJ
+6 QUIT
+7 ;
SORTEMP ;CREATES SORT TEMPLATE
+1 SET ATSEARCH("FILELINK")=ATSEARCH(1,"SRCHFILENUM")
+2 WRITE !
SET DIC="^DIBT("
SET DIC("DR")="[ATSEARCH]"
SET DIC(0)="AEMQL"
SET DLAYGO=.401
SET DIC("A")="Store results in SEARCH TEMPLATE: "
SET DIC("S")="I $P(^(0),U,5)=DUZ&($P(^(0),U,4)=ATSEARCH(1,""SRCHFILENUM""))"
DO ^DIC
KILL DIC
IF Y<0
SET ATSTP=""
QUIT
+3 ;SAVE DFN OF TEMPLATE CHOSEN OR CREATED BY USER
SET ATSTMP=+Y
+4 IF ATSTMP=$PIECE(ATSEARCH("SRCHTEMPDFN",1),U)!(ATSTMP=$PIECE(ATSEARCH("SRCHTEMPDFN",2),U))
WRITE !,*7,"Choose a template other than one of the templates you are using in the joining."
SET Y=""
QUIT
+5 IF $DATA(^DIBT(ATSTMP,2))
WRITE !!,*7,"You cannot store results in a template used only for sort purposes."
SET Y=""
QUIT
+6 ;NO RESULTS, NO FM SEARCH CODE
IF '$DATA(^DIBT(ATSTMP,1))&('$DATA(^DIBT(ATSTMP,"DIS")))
QUIT
+7 IF $DATA(^DIBT(ATSTMP,1))
WRITE !,*7,"Results already stored in this template. Do you want to have",!,"the stored data deleted"
SET %=1
DO YN^DICN
+8 ;IF A SEARCH TEMPLATE WITH NO RESULTS STORED
IF '$DATA(^DIBT(ATSTMP,1))
SET %=1
+9 IF %=2
SET Y=""
QUIT
+10 IF %=1
SET DIE="^DIBT("
SET DA=ATSTMP
SET DR="[ATSDEL]"
DO ^DIE
KILL DIE
DO TEST
QUIT
+11 SET Y=""
+12 QUIT
+13 ;
TEST ;SEE IF USER HATTED OUT OF [ATSDEL]
+1 IF $DATA(ATSY)
SET Y=""
KILL ATSY
QUIT
+2 IF '$TEST
KILL ^DIBT(ATSTMP,1),^("DIS"),^("O")
SET Y=1
+3 QUIT
+4 ;
ZIS ;SEE IF USER QUEUES ;
+1 WRITE !!,"Do you want to queue the merge to another device"
SET %=2
DO YN^DICN
+2 IF %=2
GOTO A
+3 IF %=0
WRITE !,"Enter ""Y"" if you want to queue the joining of the templates to another device."
GOTO ZIS
+4 IF %=-1
GOTO A
+5 KILL IO("Q")
+6 SET %IS="PQ"
SET IOP="Q"
DO ^%ZIS
+7 IF $DATA(IO("Q"))
IF 'POP
SET ATSTSK=""
A QUIT
+1 ;
TSKMN ;
+1 KILL ZTSAVE
FOR %="ATSTMP","ATSEARCH(1,""SRCHRESLTREF"")","ATSEARCH(2,""SRCHRESLTREF"")"
SET ZTSAVE(%)=""
IF $DATA(ATSTSK)
SET ZTSAVE("ATSTSK")=""
+2 SET ZTRTN="ZTM^ATSERCHF"
SET ZTDESC="MERGE TWO SEARCH TEMPLATES"
SET ZTIO=IO
SET ZTDTH=""
DO ^%ZTLOAD
+3 XECUTE ^%ZIS("C")
+4 QUIT
+5 ;
ZTM ;
+1 DO STORE
+2 DO EOJ
+3 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 KILL ATSEARCH(1,"SRCHRESLTREF"),ATSEARCH(2,"SRCHRESLTREF")
+5 QUIT
+6 ;
STORE ;STORES DFNS IN SEARCH TEMPLATE
+1 IF '$DATA(ATSTSK)
WRITE !,"Please wait "
+2 FOR ATSI=1:1:2
SET ATSDFN=0
FOR ATSL=0:0
SET ATSDFN=$ORDER(@(ATSEARCH(ATSI,"SRCHRESLTREF")_ATSDFN_")"))
IF ATSDFN'=+ATSDFN
QUIT
SET ^DIBT(ATSTMP,1,ATSDFN)=""
IF '$DATA(ATSTSK)
WRITE "."
+3 SET (ATSDFN,ATSCNT)=0
FOR L=0:0
SET ATSDFN=$ORDER(^DIBT(ATSTMP,1,ATSDFN))
IF 'ATSDFN
QUIT
SET ATSCNT=ATSCNT+1
+4 ; added line 2-7-91 dg/ohprd
SET ^DIBT(ATSTMP,1,0)=ATSCNT
+5 WRITE !,"There are ",ATSCNT," entries in the ",$PIECE(^DIBT(ATSTMP,0),U)," template.",!
+6 IF '$DATA(ATSTSK)
WRITE !,"Done!"
+7 QUIT
+8 ;
EOJ ;
+1 KILL ATSDFN,ATSI,ATSL,ATSETMP,ATSY,ATSTP,ATSCNT,ATSTSK,IO("Q")
+2 QUIT
+3 ;
