source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUSRVT1.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1TIUSRVT1 ; SLC/JER - Server calls for Templates ; 7/16/2001
2 ;;1.0;TEXT INTEGRATION UTILITIES;**76,102,105,119**;Jun 20, 1997
3SETXT0(TIUDA,FLD) ; Set the root node of the "TEMP" WP-field
4 N TIUC,TIUI S (TIUC,TIUI)=0
5 I '+$G(FLD) S FLD=2
6 F S TIUI=$O(^TIU(8927,TIUDA,FLD,TIUI)) Q:+TIUI'>0 D
7 . S:$D(^TIU(8927,TIUDA,FLD,TIUI,0)) TIUC=TIUC+1
8 S ^TIU(8927,TIUDA,FLD,0)="^^"_TIUC_U_TIUC_U_DT_"^^"
9 Q
10FILE(SUCCESS,IENS,TIUX) ; Call FM Filer to commit updates to DB
11 N FDA,FDARR,FLAGS,TIUMSG
12 S FDARR="FDA(8927,"_IENS_")",FLAGS="K"
13 M @FDARR=TIUX
14 D FILE^DIE(FLAGS,"FDA","TIUMSG") ; File record
15 I $D(TIUMSG)>9 S SUCCESS=0_U_$G(TIUMSG("DIERR",1,"TEXT",1)) Q
16 Q
17UPDATE(SUCCESS,IENS,TIUX) ; Call FM Filer to commit updates to DB
18 N FDA,FDARR,FLAGS,TIUMSG,TIUIENS
19 S FDARR="FDA(8927.03,"_IENS_")",FLAGS=""
20 M @FDARR=TIUX
21 D UPDATE^DIE(FLAGS,"FDA","TIUIENS","TIUMSG") ; File record
22 I $D(TIUMSG)>9 S SUCCESS=0_U_$G(TIUMSG("DIERR",1,"TEXT",1)) Q
23 Q
24CLPAC() ; Get pointer to CLINICAL COORDINATOR User Class
25 N TIUY
26 S TIUY=$O(^USR(8930,"B","CLINICAL COORDINATOR",0))
27 Q TIUY
28 ;
29LONGLIST(Y,FROM,DIR) ; Long list of titles with boilerplate
30 ; .Y=returned list, FROM=text to $O from, DIR=$O direction,
31 N I,DA,CNT,TIUD0
32 S I=0,CNT=44,DIR=$G(DIR,1)
33 F Q:I'<CNT S FROM=$O(^TIU(8925.1,"B",FROM),DIR) Q:FROM="" D
34 . S DA=0
35 . F Q:I'<CNT S DA=$O(^TIU(8925.1,"B",FROM,DA)) Q:+DA'>0 D
36 . . S TIUD0=$G(^TIU(8925.1,DA,0))
37 . . I +$P(TIUD0,U,7)'=11 Q ; Only allow Active Entries
38 . . I $P(TIUD0,U,4)'="DOC" Q ; Only allow TITLES
39 . . ; Quit if no Boilerplate Text is present
40 . . I '+$O(^TIU(8925.1,DA,"DFLT",0)) Q
41 . . I $S(+$$CANENTR^TIULP(DA)'>0:1,+$$CANPICK^TIULP(DA)'>0:1,1:0) Q
42 . . S I=I+1,Y(I)=DA_"^"_FROM
43 Q
44TITLEBP(Y,IEN) ; Returns a Titles Boilerplate
45 Q:+$G(IEN)'>0
46 N I,IDX
47 S (I,IDX)=0
48 F S IDX=$O(^TIU(8925.1,IEN,"DFLT",IDX)) Q:+IDX=0 D
49 .S I=I+1
50 .S Y(I)=^TIU(8925.1,IEN,"DFLT",IDX,0)
51 Q
52GETDESC(TIUY,TIUDA) ;Returns Template Description
53 I (TIUDA>0),$D(^TIU(8927,TIUDA,5)) D
54 .N IDX,CNT S (IDX,CNT)=0
55 .F S IDX=$O(^TIU(8927,TIUDA,5,IDX)) Q:IDX'>0 D
56 ..S CNT=CNT+1,TIUY(CNT)=^TIU(8927,TIUDA,5,IDX,0)
57 Q
58CLSLIST(ORY,FROM,DIR) ; Long List of Active User Classes
59 N I,IEN,CNT S I=0,CNT=44
60 F Q:(I'<CNT) S FROM=$O(^USR(8930,"B",FROM),DIR) Q:(FROM="") D
61 . S IEN=$O(^USR(8930,"B",FROM,0)) I $P(^USR(8930,IEN,0),U,3)="0" Q
62 . S I=I+1,ORY(I)=IEN_"^"_FROM
63 Q
64USERINFO(ORY,USER) ; Returns List of User Divisions and ASU Classes
65 N TIUI,I,IDX,IEN,TIUERR,SRV
66 S I=0,IDX=1
67 F S I=$O(^VA(200,USER,2,I)) Q:'I D
68 . I USER=DUZ,I=DUZ(2) S ORY(1)="D^"_I
69 . E S IDX=IDX+1,ORY(IDX)="D^"_I
70 S TIUI=""
71 F S TIUI=$O(^USR(8930,"B",TIUI)) Q:(TIUI="") D
72 . S IEN=$O(^USR(8930,"B",TIUI,0))
73 . I $P(^USR(8930,IEN,0),U,3)="0" Q
74 . I '$$ISA^USRLM(USER,IEN,.TIUERR) Q
75 . S IDX=IDX+1,ORY(IDX)="C^"_IEN
76 S SRV=$P($G(^VA(200,USER,5)),U)
77 I +SRV S IDX=IDX+1,ORY(IDX)="S^"_SRV
78 Q
79GETLINK(ORY,LINK) ; Returns template linked to title or reason for request
80 N IDX
81 S ORY="",IDX=$O(^TIU(8927,"AL",LINK,0))
82 I +IDX,$P($G(^TIU(8927,IDX,0)),U,4)'="I" S ORY=$$NODEDATA^TIUSRVT(IDX)
83 Q
84TITLELST(Y,FROM,DIR) ; Long list of titles
85 ; .Y=returned list, FROM=text to $O from, DIR=$O direction,
86 N I,DA,CNT,TIUD0
87 S I=0,CNT=44,DIR=$G(DIR,1)
88 F Q:I'<CNT S FROM=$O(^TIU(8925.1,"B",FROM),DIR) Q:FROM="" D
89 . S DA=0
90 . F Q:I'<CNT S DA=$O(^TIU(8925.1,"B",FROM,DA)) Q:+DA'>0 D
91 . . S TIUD0=$G(^TIU(8925.1,DA,0))
92 . . I +$P(TIUD0,U,7)'=11 Q ; Only allow Active Entries
93 . . I $P(TIUD0,U,4)'="DOC" Q ; Only allow TITLES
94 . . S I=I+1,Y(I)=DA_"^"_FROM
95 Q
Note: See TracBrowser for help on using the repository browser.