source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUCP.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.8 KB
Line 
1TIUCP ;SLC/RMO - Clinical Procedures API(s) and RPC(s) ;5/12/04
2 ;;1.0;TEXT INTEGRATION UTILITIES;**109,182**;Jun 20, 1997
3 ;
4CLASS() ;Get the CLINICAL PROCEDURES Class TIU Document Definition
5 ;file (#8925.1) IEN
6 ; Input -- None
7 ; Output -- TIU Document Definition file (#8925.1) IEN
8 N Y,TIUI,TYPE
9 S (Y,TIUI)=0
10 ; -- Make sure type is CLASS (P182):
11 F S TIUI=+$O(^TIU(8925.1,"B","CLINICAL PROCEDURES",TIUI)) Q:'TIUI D Q:Y
12 . S TYPE=$P($G(^TIU(8925.1,TIUI,0)),U,4)
13 . I TYPE="CL" S Y=TIUI
14 Q Y
15 ;
16HISTDC() ;Get Historical Procedures Document Class IEN (under Class CLINICAL PROCEDURES) in TIU DDEF file (#8925.1)
17 ; -- P182
18 ; Input -- None
19 ; Output -- TIU Document Definition file (#8925.1) IEN
20 N Y,TIUI,TYPE,TIUISCP
21 S (Y,TIUI)=0
22 F S TIUI=+$O(^TIU(8925.1,"B","HISTORICAL PROCEDURES",TIUI)) Q:'TIUI D Q:Y
23 . S TYPE=$P($G(^TIU(8925.1,TIUI,0)),U,4)
24 . I TYPE="DC" D ISCP(.TIUISCP,TIUI) S:TIUISCP Y=TIUI
25 Q Y
26 ;
27ISHISTCP(TITLE) ; Function evaluates whether a Title is under the
28 ;Historical Procedures Document Class under Class CP
29 ; -- P182
30 ; Input -- TITLE TIU Document Definition file (#8925.1) IEN
31 ; Output -- 1=True and 0=False
32 N TIUDCLAS,Y
33 ; -- Exit if Title is not defined:
34 I $G(TITLE)'>0 S Y=0 G ISHISTX
35 ; -- Get HISTORICAL PROCEDURES Document Class IEN in 8925.1:
36 S TIUDCLAS=$$HISTDC
37 ; -- Exit if Document Class is not found:
38 I TIUDCLAS'>0 S Y=0 G ISHISTX
39 ; -- Check if Title is under HISTORICAL PROCEDURES Document Class:
40 S Y=+$$ISA^TIULX(TITLE,TIUDCLAS)
41ISHISTX Q Y
42 ;
43HPCAN(TIUACT) ; Is action allowed (not prohibited outright) for HP docmts
44 ; Returns 1 if action allowed (not prohibited outright)
45 ; 0^WHYNOT if action not allowed (prohibited outright)
46 ; Requires TIUACT=IEN in USR ACTION file
47 N ALLOWED S ALLOWED=1
48 I TIUACT=19 S ALLOWED="0^ Historical Procedures may not be addended."
49 I TIUACT=20 S ALLOWED="0^ Historical Procedures may not have signers identified."
50 I TIUACT=21 S ALLOWED="0^ Historical Procedures may not be reassigned."
51 I TIUACT=22 S ALLOWED="0^ Historical Procedures may not have their titles changed."
52 I TIUACT=23 S ALLOWED="0^ Historical Procedures may not be linked with requests."
53 Q ALLOWED
54 ;
55ISCP(TIUY,TITLE) ;RPC that evaluates whether or not a Title is under
56 ;the CLINICAL PROCEDURES Class
57 ; Input -- TITLE TIU Document Definition file (#8925.1) IEN
58 ; (May be Document Class instead of Title.)
59 ; Output -- TIUY 1=True and 0=False
60 N TIUCLASS
61 ;
62 ;Exit if a Title is not defined
63 I +$G(TITLE)'>0 S TIUY=0 G ISCPQ
64 ;
65 ;Get CLINICAL PROCEDURES TIU Document Definition file (#8925.1) IEN
66 S TIUCLASS=+$$CLASS
67 ;
68 ;Exit if the CLINICAL PROCEDURES Class is not found
69 I +TIUCLASS'>0 S TIUY=0 G ISCPQ
70 ;
71 ;Check if the Title is under the CLINICAL PROCEDURES Class
72 S TIUY=+$$ISA^TIULX(TITLE,TIUCLASS)
73ISCPQ Q
74 ;
75CPCLASS(Y) ;RPC that gets the CLINICAL PROCEDURES TIU Document
76 ;Definition file (#8925.1) IEN
77 ; Input -- None
78 ; Output -- Y TIU Document Definition file (#8925.1) IEN
79 S Y=$$CLASS
80 Q
81 ;
82LNGCP(Y,FROM,DIR) ;RPC that serves data to a longlist of selectable Titles
83 ; Input -- FROM Reference Title from which the longlist is
84 ; scrolling
85 ; DIR Direction from which the longlist is scrolling
86 ; from the reference Title (Optional- default 1)
87 ; Output -- Y An array of the 44 nearest Titles to that indicated
88 ; by the user in the direction passed by the longlist
89 ; component
90 N TIUCLASS
91 ;
92 ;Exit if a reference Title is not defined
93 I '$D(FROM) G LNGCPQ
94 ;
95 ;Get CLINICAL PROCEDURES TIU Document Definition file (#8925.1) IEN
96 S TIUCLASS=+$$CLASS
97 ;
98 ;Exit if the CLINICAL PROCEDURES Class is not found
99 I +TIUCLASS'>0 G LNGCPQ
100 ;
101 ;Get the longlist of Titles for the CLINICAL PROCEDURES Class
102 D LONGLIST^TIUSRVD(.Y,TIUCLASS,FROM,$G(DIR,1))
103LNGCPQ Q
Note: See TracBrowser for help on using the repository browser.