TIUSRVD ; SLC/JER - RPC's for document definition ; 09/12/2003 [6/8/05 8:07am] ;;1.0;TEXT INTEGRATION UTILITIES;**1,7,22,47,103,100,115,164,112,186,201**;Jun 20, 1997 NOTES(TIUY) ; Get list of PN Titles D LIST(.TIUY,3) Q SUMMARY(TIUY) ; Get list of DS Titles D LIST(.TIUY,244) Q LIST(TIUY,CLASS,TYPE,TIUK) ; Get list of document titles N TIUDFLT ; TIUK is STATIC S TIUK=+$G(TIUK) I $G(TYPE)']"" S TYPE="DOC" ; If the user has a preferred list of titles for the CLASS, get it I +$O(^TIU(8925.98,"AC",DUZ,CLASS,0)) D PERSLIST(.TIUY,DUZ,CLASS,.TIUK,1) S TIUK=+$G(TIUK)+1 S TIUY(TIUK)="~LONG LIST" D TRAVERSE(.TIUY,CLASS,$G(TYPE),.TIUK) S TIUDFLT=$$PERSDOC^TIULE(DUZ,+CLASS) I +TIUDFLT S TIUK=+$G(TIUK)+1,TIUY(TIUK)="d"_$P(TIUDFLT,U,2) Q TRAVERSE(TIUY,CLASS,TYPE,TIUK) ; Get all selectable titles for the CLASS N I,J,X,CURTYP,Y,TIUI,TIUC,TYPMATCH S (TIUC,TIUI)=0 S TIUK=+$G(TIUK) I $S(+$$CANENTR^TIULP(CLASS)'>0:1,+$$CANPICK^TIULP(CLASS)'>0:1,1:0) Q S CURTYP=$P(^TIU(8925.1,+CLASS,0),U,4) S TYPMATCH=$$TYPMATCH^TIULA1(TYPE,CURTYP) I +TYPMATCH S TIUK=+$G(TIUK)+1 I S TIUY(TIUK)="i"_+CLASS_U_$$PNAME^TIULC1(+CLASS) S I=0 F S I=$O(^TIU(8925.1,+CLASS,10,I)) Q:+I'>0 D . N J . S J=+$G(^TIU(8925.1,+CLASS,10,+I,0)) Q:+J'>0 . D TRAVERSE(.TIUY,+J,TYPE,.TIUK) Q PERSLIST(TIUY,DUZ,CLASS,TIUC,TIUFLG) ; Get personal list for a user N TIUI,TIUDA,TIUDFLT,INLST S TIUDA=+$O(^TIU(8925.98,"AC",DUZ,CLASS,0)) Q:+TIUDA'>0 I +$G(TIUFLG) S TIUC=1,TIUY(TIUC)="~SHORT LIST" S TIUI=0,TIUC=+$G(TIUC) F S TIUI=$O(^TIU(8925.98,TIUDA,10,TIUI)) Q:+TIUI'>0 D . N TIUPL,TIUTNM,TIUDTYP,TIUSEQ . S TIUPL=$G(^TIU(8925.98,TIUDA,10,TIUI,0)) . S TIUDTYP=$P(TIUPL,U) . I $S(+$$CANENTR^TIULP(TIUDTYP)'>0:1,+$$CANPICK^TIULP(TIUDTYP)'>0:1,1:0) Q . S TIUTNM=$S($P(TIUPL,U,3)]"":$P(TIUPL,U,3),1:$$PNAME^TIULC1(+TIUDTYP)) . S TIUSEQ=+$P(TIUPL,U,2),TIUC=+$G(TIUC)+1 . S TIUSEQ=$S(+TIUSEQ:$S('$D(TIUY(TIUSEQ)):TIUSEQ,1:(TIUSEQ+1)),1:TIUC) . S TIUY(TIUSEQ)="i"_TIUDTYP_U_TIUTNM,TIUC=+TIUSEQ I +$G(TIUFLG) Q S TIUDFLT=$$PERSDOC^TIULE(DUZ,+CLASS) S (TIUI,TIUC)=0 F S TIUI=$O(TIUY(TIUI)) Q:+TIUI'>0 D . S TIUC=TIUI . I +TIUDFLT,($P($G(TIUY(TIUI)),U)=("i"_+TIUDFLT)) S $P(TIUDFLT,U,2)=$P(TIUY(TIUI),U,2),INLST=TIUI I +TIUDFLT D . ;if default isn't in list, append it as an item . I '$G(INLST) S TIUC=+$G(TIUC)+1,TIUY(TIUC)="i"_TIUDFLT . ;otherwise, just append as default . S TIUC=+$G(TIUC)+1,TIUY(TIUC)="d"_TIUDFLT Q BLRSHELL(TIUY,TITLE,DFN,VSTR) ; Shell for boilerplate RPC K ^TMP("TIUBOIL",$J) D BLRPLT(.TIUY,TITLE,DFN,$G(VSTR)) K ^TMP("TIUBOIL",$J,0) Q BLRPLT(TIUY,TITLE,DFN,VSTR,ROOT) ; Load/Execute the Boilerplate for TITLE ; or ROOT N TIU,TIUI,TIUJ,TIUK,TIUL,VADM,VAIN,VA,VAERR S TIUI=0 S:'$D(TIUY) TIUY=$NA(^TMP("TIUBOIL",$J)) S:'$D(ROOT) ROOT=$NA(^TIU(8925.1,+TITLE,"DFLT")) ; **47** I $L($G(VSTR)) D PATVADPT^TIULV(.TIU,DFN,"",$G(VSTR)) ; **47** S TIUJ=+$P($G(^TMP("TIUBOIL",$J,0)),U,3)+1 ; --- Set component header --- I ROOT["^TIU(8925.1," D . 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:"") I +TIUJ=1,($G(^TMP("TIUBOIL",$J,TIUJ,0))']"") K ^TMP("TIUBOIL",$J,TIUJ,0) S TIUJ=0 S ^TMP("TIUBOIL",$J,0)="^^"_TIUJ_U_TIUJ_U_DT_"^^" F S TIUI=$O(@ROOT@(TIUI)) Q:+TIUI'>0 D . S TIUJ=TIUJ+1,X=$G(@ROOT@(TIUI,0)) . I $L($T(DOLMLINE^TIUSRVF1)),'$D(XWBOS),(X["{FLD:") S X=$$DOLMLINE^TIUSRVF1(X) . I X["|" S X=$$BOIL(X,TIUJ) . I X["~@" D INSMULT(X,"^TMP(""TIUBOIL"",$J)",.TIUJ) I 1 . E S ^TMP("TIUBOIL",$J,TIUJ,0)=X . S ^TMP("TIUBOIL",$J,0)="^^"_TIUJ_U_TIUJ_U_DT_"^^" I ROOT["^TIU(8925.1,",+$O(^TIU(8925.1,+TITLE,10,0)) D . N TIUFITEM,TIUI D ITEMS^TIUFLT(+TITLE) . S TIUI=0 F S TIUI=$O(TIUFITEM(TIUI)) Q:+TIUI'>0 D . . S TIUL=+$G(TIUFITEM(+TIUI)) D BLRPLT(.TIUY,TIUL,DFN,$G(VSTR)) Q BOIL(LINE,COUNT) ; Execute Boilerplates N TIUNEWG,TIUNEWR,TIUOLDG,TIUOLDR N TIUI,DIC,X,Y,TIUFPRIV S TIUFPRIV=1 S DIC=8925.1,DIC(0)="FMXZ" S DIC("S")="I $P($G(^TIU(8925.1,+Y,0)),U,4)=""O""" F TIUI=2:2:$L(LINE,"|") S X=$P(LINE,"|",TIUI) D . D ^DIC . I +Y'>0 S X="The OBJECT "_X_" was NOT found...Contact IRM." . I +Y>0 D . . I $D(^TIU(8925.1,+Y,9)),+$$CANXEC(+Y) X ^(9) S:X["~@" X=$$APPEND(X) I 1 . . E S X="The OBJECT "_X_" is INACTIVE...Contact IRM." . . I X["~@" D . . . I X'["^" D . . . . S TIUOLDR=$P(X,"~@",2),TIUNEWR=TIUOLDR_TIUI . . . . M @TIUNEWR=@TIUOLDR K @TIUOLDR . . . . S $P(X,"~@",2)=TIUNEWR . . . I X["^" D . . . . S TIUOLDG=$P(X,"~@",2),TIUNEWG="^TMP("_"""TIU201"""_","_$J_","_TIUI_")" . . . . M @TIUNEWG=@TIUOLDG K @TIUOLDG . . . . S $P(X,"~@",2)=TIUNEWG . S LINE=$$REPLACE(LINE,X,TIUI) Q $TR(LINE,"|","") CANXEC(TIUODA) ; Evaluate Object Status N TIUOST,TIUY S TIUOST=+$P($G(^TIU(8925.1,+TIUODA,0)),U,7) S TIUY=$S(TIUOST=11:1,+$G(NOSAVE):1,1:0) Q +$G(TIUY) APPEND(X) ; N TIUXL S TIUXL=$L(X) I $E(X,TIUXL-1,TIUXL)'="~@" S X=X_"~@" Q X REPLACE(LINE,X,TIUI) ; Replace the TIUIth object in LINE w/X S $P(LINE,"|",TIUI)=X Q LINE INSMULT(LINE,TARGET,TIULCNT) ; Mult-valued results N TIUPC,TIULGTH ; TIU*1*164 ; S TIULGTH=73 ; 2 replacements of 73 below for TIULGTH S:$$BROKER^XWBLIB TIULGTH=80 F TIUPC=2:2:$L(LINE,"~@") D . N TIUI,TIULINE,TIUX,TIUSRC,TIUSCNT,TIUTAIL . S TIUSRC=$P(LINE,"~@",TIUPC) . S TIUTAIL=$P(LINE,"~@",TIUPC+1) . S TIULINE=$P(LINE,"~@",(TIUPC-1)),(TIUI,TIUSCNT)=0 . I $E(TIULINE)=" ",(TIUPC>2) S $E(TIULINE)="" . F S TIUI=$O(@TIUSRC@(TIUI)) Q:+TIUI'>0 D . . N TIUSLINE . . S TIUSCNT=TIUSCNT+1 . . S TIUSLINE=$G(@TIUSRC@(TIUI,0)) . . S:'+$O(@TIUSRC@(TIUI))&(TIUPC+2>$L(LINE,"~@")) TIUSLINE=TIUSLINE_TIUTAIL . . I TIUSCNT=1,($L(TIULINE_TIUSLINE)>TIULGTH) D Q . . . S:$D(@TARGET@(TIULCNT,0)) TIULCNT=TIULCNT+1 . . . S @TARGET@(TIULCNT,0)=TIULINE . . . S TIULCNT=TIULCNT+1 . . . S @TARGET@(TIULCNT,0)=TIUSLINE . . I TIUSCNT=1,($L(TIULINE_TIUSLINE)'>TIULGTH) D Q . . . S:$D(@TARGET@(TIULCNT,0)) TIULCNT=TIULCNT+1 . . . S @TARGET@(TIULCNT,0)=TIULINE_TIUSLINE . . S:$D(@TARGET@(TIULCNT,0)) TIULCNT=TIULCNT+1 . . S @TARGET@(TIULCNT,0)=$G(TIUSLINE) . K @TIUSRC Q LNGCNSLT(Y,FROM,DIR) ; Handle long list of titles for CONSULTS N CLASS S CLASS=+$$CLASS^TIUCNSLT Q:+CLASS'>0 D LONGLIST(.Y,CLASS,$G(FROM),$G(DIR,1)) Q LNGSURG(Y,FROM,DIR,CLNAME) ; long list SURGICAL REPORT titles ; CLNAME = "SURGICAL REPORTS" or "PROCEDURE REPORTS (NON-O.R.)" ; depending on context N CLASS S CLNAME=$S($G(CLNAME)]"":CLNAME,1:"OPERATION REPORTS") S CLASS=$$CLASS^TIUSROI(CLNAME) Q:+CLASS'>0 D LONGLIST(.Y,CLASS,$G(FROM),$G(DIR,1)) Q LONGLIST(Y,CLASS,FROM,DIR,IDNOTE) ; long list of titles for a class ; .Y=returned list, CLASS=ptr to class in 8925.1, FROM=text to $O from, ; DIR=$O direction, IDNOTE=flag to indicate selection for ID Entry N I,DA,CNT S I=0,CNT=44,DIR=$G(DIR,1) F Q:I'0 D . . I $S(+$$CANENTR^TIULP(DA)'>0:1,+$$CANPICK^TIULP(DA)'>0:1,1:0) Q . . I +$L($T(CANLINK^TIULP)),+$G(IDNOTE),(+$$CANLINK^TIULP(DA)'>0) Q . . S I=I+1,Y(I)=DA_"^"_FROM Q CNSLCLAS(Y) ; RPC to identify class CONSULTS S Y=$$CLASS^TIUCNSLT Q SURGCLAS(Y,CLNAME) ; RPC to identify class ; CLNAME = "SURGICAL REPORTS" or "PROCEDURE REPORTS (NON-O.R.)" S CLNAME=$G(CLNAME,"SURGICAL REPORTS") S Y=$$CLASS^TIUSROI(CLNAME) Q CANLINK(Y,TIUTTL) ; Wrap call to $$CANLINK^TIULP S Y=$$CANLINK^TIULP(TIUTTL) Q