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