Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUSRVT1

TIUSRVT1.m

Go to the documentation of this file.
  1. TIUSRVT1 ; SLC/JER - Server calls for Templates ; 7/16/2001
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**76,102,105,119**;Jun 20, 1997
  1. SETXT0(TIUDA,FLD) ; Set the root node of the "TEMP" WP-field
  1. N TIUC,TIUI S (TIUC,TIUI)=0
  1. I '+$G(FLD) S FLD=2
  1. F S TIUI=$O(^TIU(8927,TIUDA,FLD,TIUI)) Q:+TIUI'>0 D
  1. . S:$D(^TIU(8927,TIUDA,FLD,TIUI,0)) TIUC=TIUC+1
  1. S ^TIU(8927,TIUDA,FLD,0)="^^"_TIUC_U_TIUC_U_DT_"^^"
  1. Q
  1. FILE(SUCCESS,IENS,TIUX) ; Call FM Filer to commit updates to DB
  1. N FDA,FDARR,FLAGS,TIUMSG
  1. S FDARR="FDA(8927,"_IENS_")",FLAGS="K"
  1. M @FDARR=TIUX
  1. D FILE^DIE(FLAGS,"FDA","TIUMSG") ; File record
  1. I $D(TIUMSG)>9 S SUCCESS=0_U_$G(TIUMSG("DIERR",1,"TEXT",1)) Q
  1. Q
  1. UPDATE(SUCCESS,IENS,TIUX) ; Call FM Filer to commit updates to DB
  1. N FDA,FDARR,FLAGS,TIUMSG,TIUIENS
  1. S FDARR="FDA(8927.03,"_IENS_")",FLAGS=""
  1. M @FDARR=TIUX
  1. D UPDATE^DIE(FLAGS,"FDA","TIUIENS","TIUMSG") ; File record
  1. I $D(TIUMSG)>9 S SUCCESS=0_U_$G(TIUMSG("DIERR",1,"TEXT",1)) Q
  1. Q
  1. CLPAC() ; Get pointer to CLINICAL COORDINATOR User Class
  1. N TIUY
  1. S TIUY=$O(^USR(8930,"B","CLINICAL COORDINATOR",0))
  1. Q TIUY
  1. ;
  1. LONGLIST(Y,FROM,DIR) ; Long list of titles with boilerplate
  1. ; .Y=returned list, FROM=text to $O from, DIR=$O direction,
  1. N I,DA,CNT,TIUD0
  1. S I=0,CNT=44,DIR=$G(DIR,1)
  1. F Q:I'<CNT S FROM=$O(^TIU(8925.1,"B",FROM),DIR) Q:FROM="" D
  1. . S DA=0
  1. . F Q:I'<CNT S DA=$O(^TIU(8925.1,"B",FROM,DA)) Q:+DA'>0 D
  1. . . S TIUD0=$G(^TIU(8925.1,DA,0))
  1. . . I +$P(TIUD0,U,7)'=11 Q ; Only allow Active Entries
  1. . . I $P(TIUD0,U,4)'="DOC" Q ; Only allow TITLES
  1. . . ; Quit if no Boilerplate Text is present
  1. . . I '+$O(^TIU(8925.1,DA,"DFLT",0)) Q
  1. . . I $S(+$$CANENTR^TIULP(DA)'>0:1,+$$CANPICK^TIULP(DA)'>0:1,1:0) Q
  1. . . S I=I+1,Y(I)=DA_"^"_FROM
  1. Q
  1. TITLEBP(Y,IEN) ; Returns a Titles Boilerplate
  1. Q:+$G(IEN)'>0
  1. N I,IDX
  1. S (I,IDX)=0
  1. F S IDX=$O(^TIU(8925.1,IEN,"DFLT",IDX)) Q:+IDX=0 D
  1. .S I=I+1
  1. .S Y(I)=^TIU(8925.1,IEN,"DFLT",IDX,0)
  1. Q
  1. GETDESC(TIUY,TIUDA) ;Returns Template Description
  1. I (TIUDA>0),$D(^TIU(8927,TIUDA,5)) D
  1. .N IDX,CNT S (IDX,CNT)=0
  1. .F S IDX=$O(^TIU(8927,TIUDA,5,IDX)) Q:IDX'>0 D
  1. ..S CNT=CNT+1,TIUY(CNT)=^TIU(8927,TIUDA,5,IDX,0)
  1. Q
  1. CLSLIST(ORY,FROM,DIR) ; Long List of Active User Classes
  1. N I,IEN,CNT S I=0,CNT=44
  1. F Q:(I'<CNT) S FROM=$O(^USR(8930,"B",FROM),DIR) Q:(FROM="") D
  1. . S IEN=$O(^USR(8930,"B",FROM,0)) I $P(^USR(8930,IEN,0),U,3)="0" Q
  1. . S I=I+1,ORY(I)=IEN_"^"_FROM
  1. Q
  1. USERINFO(ORY,USER) ; Returns List of User Divisions and ASU Classes
  1. N TIUI,I,IDX,IEN,TIUERR,SRV
  1. S I=0,IDX=1
  1. F S I=$O(^VA(200,USER,2,I)) Q:'I D
  1. . I USER=DUZ,I=DUZ(2) S ORY(1)="D^"_I
  1. . E S IDX=IDX+1,ORY(IDX)="D^"_I
  1. S TIUI=""
  1. F S TIUI=$O(^USR(8930,"B",TIUI)) Q:(TIUI="") D
  1. . S IEN=$O(^USR(8930,"B",TIUI,0))
  1. . I $P(^USR(8930,IEN,0),U,3)="0" Q
  1. . I '$$ISA^USRLM(USER,IEN,.TIUERR) Q
  1. . S IDX=IDX+1,ORY(IDX)="C^"_IEN
  1. S SRV=$P($G(^VA(200,USER,5)),U)
  1. I +SRV S IDX=IDX+1,ORY(IDX)="S^"_SRV
  1. Q
  1. N IDX
  1. S ORY="",IDX=$O(^TIU(8927,"AL",LINK,0))
  1. I +IDX,$P($G(^TIU(8927,IDX,0)),U,4)'="I" S ORY=$$NODEDATA^TIUSRVT(IDX)
  1. Q
  1. TITLELST(Y,FROM,DIR) ; Long list of titles
  1. ; .Y=returned list, FROM=text to $O from, DIR=$O direction,
  1. N I,DA,CNT,TIUD0
  1. S I=0,CNT=44,DIR=$G(DIR,1)
  1. F Q:I'<CNT S FROM=$O(^TIU(8925.1,"B",FROM),DIR) Q:FROM="" D
  1. . S DA=0
  1. . F Q:I'<CNT S DA=$O(^TIU(8925.1,"B",FROM,DA)) Q:+DA'>0 D
  1. . . S TIUD0=$G(^TIU(8925.1,DA,0))
  1. . . I +$P(TIUD0,U,7)'=11 Q ; Only allow Active Entries
  1. . . I $P(TIUD0,U,4)'="DOC" Q ; Only allow TITLES
  1. . . S I=I+1,Y(I)=DA_"^"_FROM
  1. Q