source: cprs/branches/tmg-cprs/Server_KIDS/TMG-CPRS-TEXTOBJ-PARAM-1.0-1.KIDS@ 1709

KIDS Distribution saved on Mar 31, 2010@15:54:29
TMG-CPRS-TEXTOBJ-PARAM*1.0*1
**KIDS**:TMG-CPRS-TEXTOBJ-PARAM*1.0*1^

**INSTALL NAME**
TMG-CPRS-TEXTOBJ-PARAM*1.0*1
"BLD",7629,0)
TMG-CPRS-TEXTOBJ-PARAM*1.0*1^^0^3100331^n
"BLD",7629,4,0)
^9.64PA^^
"BLD",7629,6.3)
1
"BLD",7629,"KRN",0)
^9.67PA^8989.52^19
"BLD",7629,"KRN",.4,0)
.4
"BLD",7629,"KRN",.401,0)
.401
"BLD",7629,"KRN",.402,0)
.402
"BLD",7629,"KRN",.403,0)
.403
"BLD",7629,"KRN",.5,0)
.5
"BLD",7629,"KRN",.84,0)
.84
"BLD",7629,"KRN",3.6,0)
3.6
"BLD",7629,"KRN",3.8,0)
3.8
"BLD",7629,"KRN",9.2,0)
9.2
"BLD",7629,"KRN",9.8,0)
9.8
"BLD",7629,"KRN",9.8,"NM",0)
^9.68A^1^1
"BLD",7629,"KRN",9.8,"NM",1,0)
TIUSRVD^^0^B93130374
"BLD",7629,"KRN",9.8,"NM","B","TIUSRVD",1)

"BLD",7629,"KRN",19,0)
19
"BLD",7629,"KRN",19.1,0)
19.1
"BLD",7629,"KRN",101,0)
101
"BLD",7629,"KRN",409.61,0)
409.61
"BLD",7629,"KRN",771,0)
771
"BLD",7629,"KRN",870,0)
870
"BLD",7629,"KRN",8989.51,0)
8989.51
"BLD",7629,"KRN",8989.52,0)
8989.52
"BLD",7629,"KRN",8994,0)
8994
"BLD",7629,"KRN","B",.4,.4)

"BLD",7629,"KRN","B",.401,.401)

"BLD",7629,"KRN","B",.402,.402)

"BLD",7629,"KRN","B",.403,.403)

"BLD",7629,"KRN","B",.5,.5)

"BLD",7629,"KRN","B",.84,.84)

"BLD",7629,"KRN","B",3.6,3.6)

"BLD",7629,"KRN","B",3.8,3.8)

"BLD",7629,"KRN","B",9.2,9.2)

"BLD",7629,"KRN","B",9.8,9.8)

"BLD",7629,"KRN","B",19,19)

"BLD",7629,"KRN","B",19.1,19.1)

"BLD",7629,"KRN","B",101,101)

"BLD",7629,"KRN","B",409.61,409.61)

"BLD",7629,"KRN","B",771,771)

"BLD",7629,"KRN","B",870,870)

"BLD",7629,"KRN","B",8989.51,8989.51)

"BLD",7629,"KRN","B",8989.52,8989.52)

"BLD",7629,"KRN","B",8994,8994)

"MBREQ")
0
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
1
"RTN","TIUSRVD")
0^1^B93130374
"RTN","TIUSRVD",1,0)
TIUSRVD ; SLC/JER - RPC's for document definition ; 09/12/2003 [6/8/05 8:07am]
"RTN","TIUSRVD",2,0)
 ;;1.0;TEXT INTEGRATION UTILITIES;**1,7,22,47,103,100,115,164,112,186,201**;Jun 20, 1997;Build 1
"RTN","TIUSRVD",3,0)
NOTES(TIUY) ; Get list of PN Titles
"RTN","TIUSRVD",4,0)
 D LIST(.TIUY,3)
"RTN","TIUSRVD",5,0)
 Q
"RTN","TIUSRVD",6,0)
SUMMARY(TIUY) ; Get list of DS Titles
"RTN","TIUSRVD",7,0)
 D LIST(.TIUY,244)
"RTN","TIUSRVD",8,0)
 Q
"RTN","TIUSRVD",9,0)
LIST(TIUY,CLASS,TYPE,TIUK) ; Get list of document titles
"RTN","TIUSRVD",10,0)
 N TIUDFLT
"RTN","TIUSRVD",11,0)
 ; TIUK is STATIC
"RTN","TIUSRVD",12,0)
 S TIUK=+$G(TIUK)
"RTN","TIUSRVD",13,0)
 I $G(TYPE)']"" S TYPE="DOC"
"RTN","TIUSRVD",14,0)
 ; If the user has a preferred list of titles for the CLASS, get it
"RTN","TIUSRVD",15,0)
 I +$O(^TIU(8925.98,"AC",DUZ,CLASS,0)) D PERSLIST(.TIUY,DUZ,CLASS,.TIUK,1)
"RTN","TIUSRVD",16,0)
 S TIUK=+$G(TIUK)+1 S TIUY(TIUK)="~LONG LIST"
"RTN","TIUSRVD",17,0)
 D TRAVERSE(.TIUY,CLASS,$G(TYPE),.TIUK)
"RTN","TIUSRVD",18,0)
 S TIUDFLT=$$PERSDOC^TIULE(DUZ,+CLASS)
"RTN","TIUSRVD",19,0)
 I +TIUDFLT S TIUK=+$G(TIUK)+1,TIUY(TIUK)="d"_$P(TIUDFLT,U,2)
"RTN","TIUSRVD",20,0)
 Q
"RTN","TIUSRVD",21,0)
TRAVERSE(TIUY,CLASS,TYPE,TIUK) ; Get all selectable titles for the CLASS
"RTN","TIUSRVD",22,0)
 N I,J,X,CURTYP,Y,TIUI,TIUC,TYPMATCH S (TIUC,TIUI)=0
"RTN","TIUSRVD",23,0)
 S TIUK=+$G(TIUK)
"RTN","TIUSRVD",24,0)
 I $S(+$$CANENTR^TIULP(CLASS)'>0:1,+$$CANPICK^TIULP(CLASS)'>0:1,1:0) Q
"RTN","TIUSRVD",25,0)
 S CURTYP=$P(^TIU(8925.1,+CLASS,0),U,4)
"RTN","TIUSRVD",26,0)
 S TYPMATCH=$$TYPMATCH^TIULA1(TYPE,CURTYP)
"RTN","TIUSRVD",27,0)
 I +TYPMATCH S TIUK=+$G(TIUK)+1
"RTN","TIUSRVD",28,0)
 I  S TIUY(TIUK)="i"_+CLASS_U_$$PNAME^TIULC1(+CLASS)
"RTN","TIUSRVD",29,0)
 S I=0 F  S I=$O(^TIU(8925.1,+CLASS,10,I)) Q:+I'>0  D
"RTN","TIUSRVD",30,0)
 . N J
"RTN","TIUSRVD",31,0)
 . S J=+$G(^TIU(8925.1,+CLASS,10,+I,0)) Q:+J'>0
"RTN","TIUSRVD",32,0)
 . D TRAVERSE(.TIUY,+J,TYPE,.TIUK)
"RTN","TIUSRVD",33,0)
 Q
"RTN","TIUSRVD",34,0)
PERSLIST(TIUY,DUZ,CLASS,TIUC,TIUFLG) ; Get personal list for a user
"RTN","TIUSRVD",35,0)
 N TIUI,TIUDA,TIUDFLT,INLST
"RTN","TIUSRVD",36,0)
 S TIUDA=+$O(^TIU(8925.98,"AC",DUZ,CLASS,0))
"RTN","TIUSRVD",37,0)
 Q:+TIUDA'>0
"RTN","TIUSRVD",38,0)
 I +$G(TIUFLG) S TIUC=1,TIUY(TIUC)="~SHORT LIST"
"RTN","TIUSRVD",39,0)
 S TIUI=0,TIUC=+$G(TIUC)
"RTN","TIUSRVD",40,0)
 F  S TIUI=$O(^TIU(8925.98,TIUDA,10,TIUI)) Q:+TIUI'>0  D
"RTN","TIUSRVD",41,0)
 . N TIUPL,TIUTNM,TIUDTYP,TIUSEQ
"RTN","TIUSRVD",42,0)
 . S TIUPL=$G(^TIU(8925.98,TIUDA,10,TIUI,0))
"RTN","TIUSRVD",43,0)
 . S TIUDTYP=$P(TIUPL,U)
"RTN","TIUSRVD",44,0)
 . I $S(+$$CANENTR^TIULP(TIUDTYP)'>0:1,+$$CANPICK^TIULP(TIUDTYP)'>0:1,1:0) Q
"RTN","TIUSRVD",45,0)
 . S TIUTNM=$S($P(TIUPL,U,3)]"":$P(TIUPL,U,3),1:$$PNAME^TIULC1(+TIUDTYP))
"RTN","TIUSRVD",46,0)
 . S TIUSEQ=+$P(TIUPL,U,2),TIUC=+$G(TIUC)+1
"RTN","TIUSRVD",47,0)
 . S TIUSEQ=$S(+TIUSEQ:$S('$D(TIUY(TIUSEQ)):TIUSEQ,1:(TIUSEQ+1)),1:TIUC)
"RTN","TIUSRVD",48,0)
 . S TIUY(TIUSEQ)="i"_TIUDTYP_U_TIUTNM,TIUC=+TIUSEQ
"RTN","TIUSRVD",49,0)
 I +$G(TIUFLG) Q
"RTN","TIUSRVD",50,0)
 S TIUDFLT=$$PERSDOC^TIULE(DUZ,+CLASS)
"RTN","TIUSRVD",51,0)
 S (TIUI,TIUC)=0
"RTN","TIUSRVD",52,0)
 F  S TIUI=$O(TIUY(TIUI)) Q:+TIUI'>0  D
"RTN","TIUSRVD",53,0)
 . S TIUC=TIUI
"RTN","TIUSRVD",54,0)
 . I +TIUDFLT,($P($G(TIUY(TIUI)),U)=("i"_+TIUDFLT)) S $P(TIUDFLT,U,2)=$P(TIUY(TIUI),U,2),INLST=TIUI
"RTN","TIUSRVD",55,0)
 I +TIUDFLT D
"RTN","TIUSRVD",56,0)
 . ;if default isn't in list, append it as an item
"RTN","TIUSRVD",57,0)
 . I '$G(INLST) S TIUC=+$G(TIUC)+1,TIUY(TIUC)="i"_TIUDFLT
"RTN","TIUSRVD",58,0)
 . ;otherwise, just append as default
"RTN","TIUSRVD",59,0)
 . S TIUC=+$G(TIUC)+1,TIUY(TIUC)="d"_TIUDFLT
"RTN","TIUSRVD",60,0)
 Q
"RTN","TIUSRVD",61,0)
BLRSHELL(TIUY,TITLE,DFN,VSTR) ; Shell for boilerplate RPC
"RTN","TIUSRVD",62,0)
 K ^TMP("TIUBOIL",$J)
"RTN","TIUSRVD",63,0)
 D BLRPLT(.TIUY,TITLE,DFN,$G(VSTR))
"RTN","TIUSRVD",64,0)
 K ^TMP("TIUBOIL",$J,0)
"RTN","TIUSRVD",65,0)
 Q
"RTN","TIUSRVD",66,0)
BLRPLT(TIUY,TITLE,DFN,VSTR,ROOT) ; Load/Execute the Boilerplate for TITLE
"RTN","TIUSRVD",67,0)
 ;                                 or ROOT
"RTN","TIUSRVD",68,0)
 N TIU,TIUI,TIUJ,TIUK,TIUL,VADM,VAIN,VA,VAERR S TIUI=0
"RTN","TIUSRVD",69,0)
 S:'$D(TIUY) TIUY=$NA(^TMP("TIUBOIL",$J))
"RTN","TIUSRVD",70,0)
 S:'$D(ROOT) ROOT=$NA(^TIU(8925.1,+TITLE,"DFLT")) ; **47**
"RTN","TIUSRVD",71,0)
 I $L($G(VSTR)) D PATVADPT^TIULV(.TIU,DFN,"",$G(VSTR)) ; **47**
"RTN","TIUSRVD",72,0)
 S TIUJ=+$P($G(^TMP("TIUBOIL",$J,0)),U,3)+1
"RTN","TIUSRVD",73,0)
 ; --- Set component header ---
"RTN","TIUSRVD",74,0)
 I ROOT["^TIU(8925.1," D
"RTN","TIUSRVD",75,0)
 . S ^TMP("TIUBOIL",$J,TIUJ,0)=$S($P($G(^TIU(8925.1,+TITLE,0)),U,4)="CO":$P(^TIU(8925.1,+TITLE,0),U)_":   ",1:"")
"RTN","TIUSRVD",76,0)
 I +TIUJ=1,($G(^TMP("TIUBOIL",$J,TIUJ,0))']"") K ^TMP("TIUBOIL",$J,TIUJ,0) S TIUJ=0
"RTN","TIUSRVD",77,0)
 S ^TMP("TIUBOIL",$J,0)="^^"_TIUJ_U_TIUJ_U_DT_"^^"
"RTN","TIUSRVD",78,0)
 F  S TIUI=$O(@ROOT@(TIUI)) Q:+TIUI'>0  D
"RTN","TIUSRVD",79,0)
 . S TIUJ=TIUJ+1,X=$G(@ROOT@(TIUI,0))
"RTN","TIUSRVD",80,0)
 . I $L($T(DOLMLINE^TIUSRVF1)),'$D(XWBOS),(X["{FLD:") S X=$$DOLMLINE^TIUSRVF1(X)
"RTN","TIUSRVD",81,0)
 . I X["|" S X=$$BOIL(X,TIUJ)
"RTN","TIUSRVD",82,0)
 . I X["~@" D INSMULT(X,"^TMP(""TIUBOIL"",$J)",.TIUJ) I 1
"RTN","TIUSRVD",83,0)
 . E  S ^TMP("TIUBOIL",$J,TIUJ,0)=X
"RTN","TIUSRVD",84,0)
 . S ^TMP("TIUBOIL",$J,0)="^^"_TIUJ_U_TIUJ_U_DT_"^^"
"RTN","TIUSRVD",85,0)
 I ROOT["^TIU(8925.1,",+$O(^TIU(8925.1,+TITLE,10,0)) D
"RTN","TIUSRVD",86,0)
 . N TIUFITEM,TIUI D ITEMS^TIUFLT(+TITLE)
"RTN","TIUSRVD",87,0)
 . S TIUI=0 F  S TIUI=$O(TIUFITEM(TIUI)) Q:+TIUI'>0  D
"RTN","TIUSRVD",88,0)
 . . S TIUL=+$G(TIUFITEM(+TIUI)) D BLRPLT(.TIUY,TIUL,DFN,$G(VSTR))
"RTN","TIUSRVD",89,0)
 Q
"RTN","TIUSRVD",90,0)
BOIL0(LINE,COUNT) ; Execute Boilerplates  ;"//kt original function name was BOIL (mod is below)
"RTN","TIUSRVD",91,0)
 N TIUNEWG,TIUNEWR,TIUOLDG,TIUOLDR
"RTN","TIUSRVD",92,0)
 N TIUI,DIC,X,Y,TIUFPRIV S TIUFPRIV=1
"RTN","TIUSRVD",93,0)
 S DIC=8925.1,DIC(0)="FMXZ"
"RTN","TIUSRVD",94,0)
 S DIC("S")="I $P($G(^TIU(8925.1,+Y,0)),U,4)=""O"""
"RTN","TIUSRVD",95,0)
 F TIUI=2:2:$L(LINE,"|") S X=$P(LINE,"|",TIUI) D
"RTN","TIUSRVD",96,0)
 . D ^DIC
"RTN","TIUSRVD",97,0)
 . I +Y'>0 S X="The OBJECT "_X_" was NOT found...Contact IRM."
"RTN","TIUSRVD",98,0)
 . I +Y>0 D
"RTN","TIUSRVD",99,0)
 . . I $D(^TIU(8925.1,+Y,9)),+$$CANXEC(+Y) X ^(9) S:X["~@" X=$$APPEND(X) I 1
"RTN","TIUSRVD",100,0)
 . . E  S X="The OBJECT "_X_" is INACTIVE...Contact IRM."
"RTN","TIUSRVD",101,0)
 . . I X["~@" D
"RTN","TIUSRVD",102,0)
 . . . I X'["^" D
"RTN","TIUSRVD",103,0)
 . . . . S TIUOLDR=$P(X,"~@",2),TIUNEWR=TIUOLDR_TIUI
"RTN","TIUSRVD",104,0)
 . . . . M @TIUNEWR=@TIUOLDR K @TIUOLDR
"RTN","TIUSRVD",105,0)
 . . . . S $P(X,"~@",2)=TIUNEWR
"RTN","TIUSRVD",106,0)
 . . . I X["^" D
"RTN","TIUSRVD",107,0)
 . . . . S TIUOLDG=$P(X,"~@",2),TIUNEWG="^TMP("_"""TIU201"""_","_$J_","_TIUI_")"
"RTN","TIUSRVD",108,0)
 . . . . M @TIUNEWG=@TIUOLDG K @TIUOLDG
"RTN","TIUSRVD",109,0)
 . . . . S $P(X,"~@",2)=TIUNEWG
"RTN","TIUSRVD",110,0)
 . S LINE=$$REPLACE(LINE,X,TIUI)
"RTN","TIUSRVD",111,0)
 Q $TR(LINE,"|","")
"RTN","TIUSRVD",112,0)
 ;
"RTN","TIUSRVD",113,0)
BOIL(LINE,COUNT) ; Execute Boilerplates  ;"//kt modification
"RTN","TIUSRVD",114,0)
        ;"Purpose: Resolve Text Objects.  Function is modified to allow |TEXT OBJECT{Parameters}|
"RTN","TIUSRVD",115,0)
        ;"Input: LINE -- One line of text that has one or more text objects
"RTN","TIUSRVD",116,0)
        ;"       COUNT -- (not used)
"RTN","TIUSRVD",117,0)
        ;"Results: Returns line of text with text objects resolved.
"RTN","TIUSRVD",118,0)
        ;"NOTE: [Parameter] may itself be a nested text object (arbitrary depth allowed)
"RTN","TIUSRVD",119,0)
        ;"Usage -- in text object definition, code may be like this:
"RTN","TIUSRVD",120,0)
        ;"        S X=$$MYFN^MYMOD(X)
"RTN","TIUSRVD",121,0)
        ;"       The value for X being passed into the object's code will hold the
"RTN","TIUSRVD",122,0)
        ;"       parameter found between { }
"RTN","TIUSRVD",123,0)
        ;"       This is backwards compatible.  If no parameter is specified, then X=""
"RTN","TIUSRVD",124,0)
        N TIUNEWG,TIUNEWR,TIUOLDG,TIUOLDR,TMGX
"RTN","TIUSRVD",125,0)
        N TIUI,DIC,X,Y,TIUFPRIV S TIUFPRIV=1
"RTN","TIUSRVD",126,0)
        S DIC=8925.1,DIC(0)="FMXZ"
"RTN","TIUSRVD",127,0)
        S DIC("S")="I $P($G(^TIU(8925.1,+Y,0)),U,4)=""O"""
"RTN","TIUSRVD",128,0)
        F TIUI=2:2:$L(LINE,"|") D
"RTN","TIUSRVD",129,0)
        . NEW SA,SB
"RTN","TIUSRVD",130,0)
        . SET X=$$MXTRACT(LINE,"|",.SA,.SB)
"RTN","TIUSRVD",131,0)
        . IF X["{" DO
"RTN","TIUSRVD",132,0)
        . . NEW X1,X2
"RTN","TIUSRVD",133,0)
        . . SET TMGX=$$MXTRACT(X,"{",.X1,.X2)
"RTN","TIUSRVD",134,0)
        . . IF TMGX["|" SET TMGX=$$BOIL(TMGX)
"RTN","TIUSRVD",135,0)
        . . SET X=X1_X2
"RTN","TIUSRVD",136,0)
        . ELSE  SET TMGX=""
"RTN","TIUSRVD",137,0)
        . D ^DIC
"RTN","TIUSRVD",138,0)
        . I +Y>0 DO
"RTN","TIUSRVD",139,0)
        . . I $D(^TIU(8925.1,+Y,9)),+$$CANXEC(+Y) DO
"RTN","TIUSRVD",140,0)
        . . . SET X=TMGX  ;"Load passed parameter (or "" if none) into X
"RTN","TIUSRVD",141,0)
        . . . X ^(9)
"RTN","TIUSRVD",142,0)
        . . . S:X["~@" X=$$APPEND(X)
"RTN","TIUSRVD",143,0)
        . . E  S X="The OBJECT "_X_" is INACTIVE...Contact IRM."
"RTN","TIUSRVD",144,0)
        . . I X["~@" D
"RTN","TIUSRVD",145,0)
        . . . I X'["^" D
"RTN","TIUSRVD",146,0)
        . . . . S TIUOLDR=$P(X,"~@",2),TIUNEWR=TIUOLDR_TIUI
"RTN","TIUSRVD",147,0)
        . . . . M @TIUNEWR=@TIUOLDR K @TIUOLDR
"RTN","TIUSRVD",148,0)
        . . . . S $P(X,"~@",2)=TIUNEWR
"RTN","TIUSRVD",149,0)
        . . . I X["^" D
"RTN","TIUSRVD",150,0)
        . . . . S TIUOLDG=$P(X,"~@",2),TIUNEWG="^TMP("_"""TIU201"""_","_$J_","_TIUI_")"
"RTN","TIUSRVD",151,0)
        . . . . M @TIUNEWG=@TIUOLDG K @TIUOLDG
"RTN","TIUSRVD",152,0)
        . . . . S $P(X,"~@",2)=TIUNEWG
"RTN","TIUSRVD",153,0)
        . ELSE  S X="The OBJECT "_X_" was NOT found...Contact IRM."
"RTN","TIUSRVD",154,0)
        . SET LINE=SA_X_SB
"RTN","TIUSRVD",155,0)
        Q LINE
"RTN","TIUSRVD",156,0)
 ;
"RTN","TIUSRVD",157,0)
MXTRACT(S,DIVCH,SA,SB,MAP)  ;"//kst added this function
"RTN","TIUSRVD",158,0)
        ;" Extract matched encapsulators
"RTN","TIUSRVD",159,0)
        ;" NOTE: see TMGSTUTL for a more robust version of function.
"RTN","TIUSRVD",160,0)
        IF '$DATA(MAP) DO MAPMATCH(S,.MAP)
"RTN","TIUSRVD",161,0)
        NEW RESULT SET RESULT=""
"RTN","TIUSRVD",162,0)
        NEW I SET I=0
"RTN","TIUSRVD",163,0)
        FOR  S I=$O(MAP(1,I)) QUIT:(I="")!(RESULT'="")  DO
"RTN","TIUSRVD",164,0)
        . IF DIVCH'=$G(MAP(1,I)) QUIT
"RTN","TIUSRVD",165,0)
        . NEW P,J
"RTN","TIUSRVD",166,0)
        . FOR J=1,2 SET P(J)=+$G(MAP(1,I,"P",J))
"RTN","TIUSRVD",167,0)
        . SET RESULT=$EXTRACT(S,P(1)+1,P(2)-1)
"RTN","TIUSRVD",168,0)
        . SET SA=$EXTRACT(S,1,P(1)-1),SB=$EXTRACT(S,P(2)+1,9999)
"RTN","TIUSRVD",169,0)
        IF RESULT="" SET SA=S,SB=""
"RTN","TIUSRVD",170,0)
        QUIT RESULT
"RTN","TIUSRVD",171,0)
 ;
"RTN","TIUSRVD",172,0)
MAPMATCH(S,MAP) ;"//kst added this function
"RTN","TIUSRVD",173,0)
        ;" Map out a string for matched encapsulators
"RTN","TIUSRVD",174,0)
        ;" NOTE: see TMGSTUTL.m for a more robust version of function.
"RTN","TIUSRVD",175,0)
        N MATCH,DEPTH,I,GRP,CH
"RTN","TIUSRVD",176,0)
        S MATCH("{")="}",MATCH("|")="|"
"RTN","TIUSRVD",177,0)
        K MAP
"RTN","TIUSRVD",178,0)
        S DEPTH=0,GRP=1
"RTN","TIUSRVD",179,0)
        F I=1:1:$L(S) D  Q:(GRP>1)  ;"Only deal with 1st entry
"RTN","TIUSRVD",180,0)
        . S CH=$EXTRACT(S,I)
"RTN","TIUSRVD",181,0)
        . I CH=$G(MAP(GRP,DEPTH,"End")) D  QUIT
"RTN","TIUSRVD",182,0)
        . . S MAP(GRP,DEPTH,"P",2)=I
"RTN","TIUSRVD",183,0)
        . . K MAP(GRP,DEPTH,"End")
"RTN","TIUSRVD",184,0)
        . . S DEPTH=DEPTH-1
"RTN","TIUSRVD",185,0)
        . . I DEPTH=0 S GRP=GRP+1
"RTN","TIUSRVD",186,0)
        . I $D(MATCH(CH))=0 QUIT
"RTN","TIUSRVD",187,0)
        . S DEPTH=DEPTH+1
"RTN","TIUSRVD",188,0)
        . S MAP(GRP,DEPTH)=CH
"RTN","TIUSRVD",189,0)
        . S MAP(GRP,DEPTH,"End")=MATCH(CH)
"RTN","TIUSRVD",190,0)
        . S MAP(GRP,DEPTH,"P",1)=I
"RTN","TIUSRVD",191,0)
        QUIT
"RTN","TIUSRVD",192,0)
 ;
"RTN","TIUSRVD",193,0)
CANXEC(TIUODA) ; Evaluate Object Status
"RTN","TIUSRVD",194,0)
 N TIUOST,TIUY S TIUOST=+$P($G(^TIU(8925.1,+TIUODA,0)),U,7)
"RTN","TIUSRVD",195,0)
 S TIUY=$S(TIUOST=11:1,+$G(NOSAVE):1,1:0)
"RTN","TIUSRVD",196,0)
 Q +$G(TIUY)
"RTN","TIUSRVD",197,0)
APPEND(X) ;
"RTN","TIUSRVD",198,0)
 N TIUXL S TIUXL=$L(X)
"RTN","TIUSRVD",199,0)
 I $E(X,TIUXL-1,TIUXL)'="~@" S X=X_"~@"
"RTN","TIUSRVD",200,0)
 Q X
"RTN","TIUSRVD",201,0)
REPLACE(LINE,X,TIUI) ; Replace the TIUIth object in LINE w/X
"RTN","TIUSRVD",202,0)
 S $P(LINE,"|",TIUI)=X
"RTN","TIUSRVD",203,0)
 Q LINE
"RTN","TIUSRVD",204,0)
INSMULT(LINE,TARGET,TIULCNT) ; Mult-valued results
"RTN","TIUSRVD",205,0)
 N TIUPC,TIULGTH
"RTN","TIUSRVD",206,0)
 ; TIU*1*164 ;
"RTN","TIUSRVD",207,0)
 S TIULGTH=73 ; 2 replacements of 73 below for TIULGTH
"RTN","TIUSRVD",208,0)
 S:$$BROKER^XWBLIB TIULGTH=80
"RTN","TIUSRVD",209,0)
 F TIUPC=2:2:$L(LINE,"~@") D
"RTN","TIUSRVD",210,0)
 . N TIUI,TIULINE,TIUX,TIUSRC,TIUSCNT,TIUTAIL
"RTN","TIUSRVD",211,0)
 . S TIUSRC=$P(LINE,"~@",TIUPC)
"RTN","TIUSRVD",212,0)
 . S TIUTAIL=$P(LINE,"~@",TIUPC+1)
"RTN","TIUSRVD",213,0)
 . S TIULINE=$P(LINE,"~@",(TIUPC-1)),(TIUI,TIUSCNT)=0
"RTN","TIUSRVD",214,0)
 . I $E(TIULINE)=" ",(TIUPC>2) S $E(TIULINE)=""
"RTN","TIUSRVD",215,0)
 . F  S TIUI=$O(@TIUSRC@(TIUI)) Q:+TIUI'>0  D
"RTN","TIUSRVD",216,0)
 . . N TIUSLINE
"RTN","TIUSRVD",217,0)
 . . S TIUSCNT=TIUSCNT+1
"RTN","TIUSRVD",218,0)
 . . S TIUSLINE=$G(@TIUSRC@(TIUI,0))
"RTN","TIUSRVD",219,0)
 . . S:'+$O(@TIUSRC@(TIUI))&(TIUPC+2>$L(LINE,"~@")) TIUSLINE=TIUSLINE_TIUTAIL
"RTN","TIUSRVD",220,0)
 . . I TIUSCNT=1,($L(TIULINE_TIUSLINE)>TIULGTH) D  Q
"RTN","TIUSRVD",221,0)
 . . . S:$D(@TARGET@(TIULCNT,0)) TIULCNT=TIULCNT+1
"RTN","TIUSRVD",222,0)
 . . . S @TARGET@(TIULCNT,0)=TIULINE
"RTN","TIUSRVD",223,0)
 . . . S TIULCNT=TIULCNT+1
"RTN","TIUSRVD",224,0)
 . . . S @TARGET@(TIULCNT,0)=TIUSLINE
"RTN","TIUSRVD",225,0)
 . . I TIUSCNT=1,($L(TIULINE_TIUSLINE)'>TIULGTH) D  Q
"RTN","TIUSRVD",226,0)
 . . . S:$D(@TARGET@(TIULCNT,0)) TIULCNT=TIULCNT+1
"RTN","TIUSRVD",227,0)
 . . . S @TARGET@(TIULCNT,0)=TIULINE_TIUSLINE
"RTN","TIUSRVD",228,0)
 . . S:$D(@TARGET@(TIULCNT,0)) TIULCNT=TIULCNT+1
"RTN","TIUSRVD",229,0)
 . . S @TARGET@(TIULCNT,0)=$G(TIUSLINE)
"RTN","TIUSRVD",230,0)
 . K @TIUSRC
"RTN","TIUSRVD",231,0)
 Q
"RTN","TIUSRVD",232,0)
LNGCNSLT(Y,FROM,DIR) ; Handle long list of titles for CONSULTS
"RTN","TIUSRVD",233,0)
 N CLASS S CLASS=+$$CLASS^TIUCNSLT Q:+CLASS'>0
"RTN","TIUSRVD",234,0)
 D LONGLIST(.Y,CLASS,$G(FROM),$G(DIR,1))
"RTN","TIUSRVD",235,0)
 Q
"RTN","TIUSRVD",236,0)
LNGSURG(Y,FROM,DIR,CLNAME)      ; long list SURGICAL REPORT titles
"RTN","TIUSRVD",237,0)
 ; CLNAME = "SURGICAL REPORTS" or "PROCEDURE REPORTS (NON-O.R.)"
"RTN","TIUSRVD",238,0)
 ;           depending on context
"RTN","TIUSRVD",239,0)
 N CLASS S CLNAME=$S($G(CLNAME)]"":CLNAME,1:"OPERATION REPORTS")
"RTN","TIUSRVD",240,0)
 S CLASS=$$CLASS^TIUSROI(CLNAME) Q:+CLASS'>0
"RTN","TIUSRVD",241,0)
 D LONGLIST(.Y,CLASS,$G(FROM),$G(DIR,1))
"RTN","TIUSRVD",242,0)
 Q
"RTN","TIUSRVD",243,0)
LONGLIST(Y,CLASS,FROM,DIR,IDNOTE) ; long list of titles for a class
"RTN","TIUSRVD",244,0)
 ; .Y=returned list, CLASS=ptr to class in 8925.1, FROM=text to $O from,
"RTN","TIUSRVD",245,0)
 ; DIR=$O direction, IDNOTE=flag to indicate selection for ID Entry
"RTN","TIUSRVD",246,0)
 N I,DA,CNT S I=0,CNT=44,DIR=$G(DIR,1)
"RTN","TIUSRVD",247,0)
 F  Q:I'<CNT  S FROM=$O(^TIU(8925.1,"ACL",CLASS,FROM),DIR) Q:FROM=""  D
"RTN","TIUSRVD",248,0)
 . S DA=0
"RTN","TIUSRVD",249,0)
 . F  Q:I'<CNT  S DA=$O(^TIU(8925.1,"ACL",CLASS,FROM,DA)) Q:+DA'>0  D
"RTN","TIUSRVD",250,0)
 . . I $S(+$$CANENTR^TIULP(DA)'>0:1,+$$CANPICK^TIULP(DA)'>0:1,1:0) Q
"RTN","TIUSRVD",251,0)
 . . I +$L($T(CANLINK^TIULP)),+$G(IDNOTE),(+$$CANLINK^TIULP(DA)'>0) Q
"RTN","TIUSRVD",252,0)
 . . S I=I+1,Y(I)=DA_"^"_FROM
"RTN","TIUSRVD",253,0)
 Q
"RTN","TIUSRVD",254,0)
CNSLCLAS(Y) ; RPC to identify class CONSULTS
"RTN","TIUSRVD",255,0)
 S Y=$$CLASS^TIUCNSLT
"RTN","TIUSRVD",256,0)
 Q
"RTN","TIUSRVD",257,0)
SURGCLAS(Y,CLNAME) ; RPC to identify class
"RTN","TIUSRVD",258,0)
 ; CLNAME = "SURGICAL REPORTS" or "PROCEDURE REPORTS (NON-O.R.)"
"RTN","TIUSRVD",259,0)
 S CLNAME=$G(CLNAME,"SURGICAL REPORTS")
"RTN","TIUSRVD",260,0)
 S Y=$$CLASS^TIUSROI(CLNAME)
"RTN","TIUSRVD",261,0)
 Q
"RTN","TIUSRVD",262,0)
CANLINK(Y,TIUTTL)       ; Wrap call to $$CANLINK^TIULP
"RTN","TIUSRVD",263,0)
 S Y=$$CANLINK^TIULP(TIUTTL)
"RTN","TIUSRVD",264,0)
 Q
"VER")
8.0^22.0
**END**
**END**