| 1 | TMGDIS2 ;TMG/kst/Custom version of DIS2 ;03/25/06 ; 5/15/10 11:15pm
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;01/01/06
|
|---|
| 3 | ;"---- Prior header below ----------
|
|---|
| 4 | ;SFISC/GFT-SEARCH, TEMPLATES & COMPUTED FIELDS;4JUN2005
|
|---|
| 5 | ;;22.0;VA FileMan;**6,144**;Mar 30, 1999;Build 5
|
|---|
| 6 | ;
|
|---|
| 7 | DIS2 ;
|
|---|
| 8 | ;"Purpose:
|
|---|
| 9 | ;"Input: ...
|
|---|
| 10 | ;"Output: TMGRESULT is set
|
|---|
| 11 | ;"Results: none
|
|---|
| 12 | KILL DISV
|
|---|
| 13 | ;"GOTO G:'DUZ
|
|---|
| 14 | 0 ;"D
|
|---|
| 15 | ;". N DIS,DIS0,DA,DC,DE,DJ,DL
|
|---|
| 16 | ;". D S3^DIBT1 Q
|
|---|
| 17 | ;"KILL DIRUT,DIROUT
|
|---|
| 18 | ;"I $D(DTOUT)!($D(DUOUT)) GOTO Q
|
|---|
| 19 | ;"Get SORT TEMPLATE to store search into.
|
|---|
| 20 | SET Y=$$PREPTMPL()
|
|---|
| 21 | IF +TMGRESULT=-1 GOTO TMGDONE ;"Quit from there
|
|---|
| 22 | SET TMGSORTT=Y
|
|---|
| 23 | IF X="",'$D(DIAR) GOTO G
|
|---|
| 24 | IF Y<0 GOTO Q:X=U,0
|
|---|
| 25 | IF $D(DIARU),DIARU-Y=0 DO GOTO 0
|
|---|
| 26 | . WRITE $C(7),!,"Archivers must not store results in the default template"
|
|---|
| 27 | SET (DIARI,DISV)=+Y
|
|---|
| 28 | SET A=$D(^DIBT(DISV,"DL"))
|
|---|
| 29 | IF $D(DIS0)#2 SET ^("DL")=DIS0
|
|---|
| 30 | IF $D(DA)#2 SET ^("DA")=DA
|
|---|
| 31 | IF $D(DJ)#2 SET ^("DJ")=DJ
|
|---|
| 32 | IF $D(DIAR),'$D(DIARU) SET $P(^DIAR(1.11,DIARC,0),U,3)=DISV
|
|---|
| 33 | SET Z=-1
|
|---|
| 34 | SET DIS0="^DIBT(+Y,"
|
|---|
| 35 | FOR P="DIS","DA","DC","DE","DJ","DL" DO
|
|---|
| 36 | . SET %Y=DIS0_""""_P_""","
|
|---|
| 37 | . SET %X=P_"("
|
|---|
| 38 | . DO %XY^%RCR
|
|---|
| 39 | SET %X="^UTILITY($J,",%Y="^DIBT(DISV,""O"","
|
|---|
| 40 | SET @(%X_"0)=U")
|
|---|
| 41 | DO %XY^%RCR
|
|---|
| 42 | G NEW DISTXT
|
|---|
| 43 | SET %X="^UTILITY($J,"
|
|---|
| 44 | SET %Y="DISTXT("
|
|---|
| 45 | DO %XY^%RCR
|
|---|
| 46 | ;"WRITE !
|
|---|
| 47 | SET Y=DI
|
|---|
| 48 | DO Q
|
|---|
| 49 | SET DIC=Y
|
|---|
| 50 | IF $D(SF)!$D(L)&'$D(DIAR) GOTO EN1^DIP
|
|---|
| 51 | GOTO EN^DIP
|
|---|
| 52 | ;
|
|---|
| 53 | ;"==========================================
|
|---|
| 54 | TEM GOTO TEMP^TMGDIS ;"-- MOVED TO TMGDIS
|
|---|
| 55 | COMP GOTO COMP^TMGDIS ;"-- MOVED TO TMGDIS
|
|---|
| 56 | XA GOTO XA^TMGDIS ;"-- MOVED TO TMGDIS
|
|---|
| 57 | COLON GOTO COLON^TMGDIS ;"-- MOVED TO TMGDIS
|
|---|
| 58 | Q GOTO Q^TMGIDS ;"-- MOVED TO TMGDIS
|
|---|
| 59 | ;"==========================================
|
|---|
| 60 | ;
|
|---|
| 61 | ;"X KILL O(DC)
|
|---|
| 62 | ;" GOTO X^TMGDIS
|
|---|
| 63 | ;
|
|---|
| 64 | DIS ;PUT SET LOGIC INTO DIS FOR SUBFILE
|
|---|
| 65 | SET %X=""
|
|---|
| 66 | FOR %Y=1:1 SET %X=$O(DIS(%X)) Q:'%X DO
|
|---|
| 67 | . SET %=$S($D(DIAR(DIARF,%X)):DIAR(DIARF,%X),1:DIS(%X))
|
|---|
| 68 | . IF %["X DIS(" SET %=$P(%,"X DIS(")_"X DIFG("_DIARF_","_$P(%,"X DIS(",2)
|
|---|
| 69 | . SET ^DIAR(1.11,DIARC,"S",%Y,0)=%X
|
|---|
| 70 | . SET ^(1)=%
|
|---|
| 71 | IF %Y>1 DO
|
|---|
| 72 | . SET %Y=%Y-1
|
|---|
| 73 | . SET ^DIAR(1.11,DIARC,"S",0)="^1.1132^"_%Y_U_%Y
|
|---|
| 74 | GOTO DIS2 ;"quit will occur there.
|
|---|
| 75 | ;
|
|---|
| 76 | PREPTMPL() ;
|
|---|
| 77 | ;"//kt added
|
|---|
| 78 | ;"Purpose: Return IEN of a SORT TEMPLATE ready for use.
|
|---|
| 79 | ;"Get SORT TEMPLATE to store search into.
|
|---|
| 80 | NEW TMGTMPL SET TMGTMPL=-1
|
|---|
| 81 | NEW Y SET Y=+$GET(INFO("SORT IEN"))
|
|---|
| 82 | IF (Y'>0)!($DATA(^DIBT(Y))=0) DO ;"Get a new record
|
|---|
| 83 | . NEW DIC,X
|
|---|
| 84 | . SET DIC=.401,DIC(0)="L"
|
|---|
| 85 | . SET X="TMG SRCH "_$J
|
|---|
| 86 | . DO ^DIC ;"Create now, or get pre-existing
|
|---|
| 87 | . IF +Y'>0 DO QUIT
|
|---|
| 88 | . . SET TMGRESULT="-1^Error getting SORT TEMPLATE for use."
|
|---|
| 89 | IF +Y>0,$DATA(^DIBT(+Y)) DO ;"Edit existing record
|
|---|
| 90 | . NEW TMGFDA,TMGMSG,TMGIEN,TMGIENS,DA,DIE
|
|---|
| 91 | . SET TMGTMPL=+Y
|
|---|
| 92 | . NEW I SET I=0
|
|---|
| 93 | . ;"Kill all but zero node of record
|
|---|
| 94 | . FOR SET I=$ORDER(^DIBT(Y,I)) QUIT:I="" KILL ^DIBT(Y,I)
|
|---|
| 95 | . NEW % DO NOW^%DTC
|
|---|
| 96 | . SET DIE=.401
|
|---|
| 97 | . SET DA=+Y
|
|---|
| 98 | . SET DR="2///"_%_";3///"_DUZ(0)_";4///"_TMGFILE_";5///"_DUZ_";6///"_DUZ(0)
|
|---|
| 99 | . DO ^DIE
|
|---|
| 100 | . ;"SET IENS=+Y_","
|
|---|
| 101 | . ;"SET TMGFDA(.401,IENS,2)=%
|
|---|
| 102 | . ;"SET TMGFDA(.401,IENS,3)=DUZ(0)
|
|---|
| 103 | . ;"SET TMGFDA(.401,IENS,4)=TMGFILE
|
|---|
| 104 | . ;"SET TMGFDA(.401,IENS,5)=DUZ
|
|---|
| 105 | . ;"SET TMGFDA(.401,IENS,6)=DUZ(0)
|
|---|
| 106 | . ;"Set back new field data
|
|---|
| 107 | . ;"DO FILE^DIE("K","TMGFDA","TMGMSG")
|
|---|
| 108 | . ;"IF $DATA(TMGMSG("DIERROR")) DO QUIT
|
|---|
| 109 | . ;". SET TMGRESULT="-1^Error editing SORT TEMPLATE: '"_$GET(TMGMSG("DIERR",1,"TEXT",1))_"'"
|
|---|
| 110 | . ;". SET Y=-1
|
|---|
| 111 | QUIT TMGTMPL
|
|---|
| 112 | ;
|
|---|
| 113 | TMGDONE QUIT
|
|---|
