TIUCP ;SLC/RMO - Clinical Procedures API(s) and RPC(s) ;5/12/04
;;1.0;TEXT INTEGRATION UTILITIES;**109,182**;Jun 20, 1997
;
CLASS() ;Get the CLINICAL PROCEDURES Class TIU Document Definition
;file (#8925.1) IEN
; Input -- None
; Output -- TIU Document Definition file (#8925.1) IEN
N Y,TIUI,TYPE
S (Y,TIUI)=0
; -- Make sure type is CLASS (P182):
F S TIUI=+$O(^TIU(8925.1,"B","CLINICAL PROCEDURES",TIUI)) Q:'TIUI D Q:Y
. S TYPE=$P($G(^TIU(8925.1,TIUI,0)),U,4)
. I TYPE="CL" S Y=TIUI
Q Y
;
HISTDC() ;Get Historical Procedures Document Class IEN (under Class CLINICAL PROCEDURES) in TIU DDEF file (#8925.1)
; -- P182
; Input -- None
; Output -- TIU Document Definition file (#8925.1) IEN
N Y,TIUI,TYPE,TIUISCP
S (Y,TIUI)=0
F S TIUI=+$O(^TIU(8925.1,"B","HISTORICAL PROCEDURES",TIUI)) Q:'TIUI D Q:Y
. S TYPE=$P($G(^TIU(8925.1,TIUI,0)),U,4)
. I TYPE="DC" D ISCP(.TIUISCP,TIUI) S:TIUISCP Y=TIUI
Q Y
;
ISHISTCP(TITLE) ; Function evaluates whether a Title is under the
;Historical Procedures Document Class under Class CP
; -- P182
; Input -- TITLE TIU Document Definition file (#8925.1) IEN
; Output -- 1=True and 0=False
N TIUDCLAS,Y
; -- Exit if Title is not defined:
I $G(TITLE)'>0 S Y=0 G ISHISTX
; -- Get HISTORICAL PROCEDURES Document Class IEN in 8925.1:
S TIUDCLAS=$$HISTDC
; -- Exit if Document Class is not found:
I TIUDCLAS'>0 S Y=0 G ISHISTX
; -- Check if Title is under HISTORICAL PROCEDURES Document Class:
S Y=+$$ISA^TIULX(TITLE,TIUDCLAS)
ISHISTX Q Y
;
HPCAN(TIUACT) ; Is action allowed (not prohibited outright) for HP docmts
; Returns 1 if action allowed (not prohibited outright)
; 0^WHYNOT if action not allowed (prohibited outright)
; Requires TIUACT=IEN in USR ACTION file
N ALLOWED S ALLOWED=1
I TIUACT=19 S ALLOWED="0^ Historical Procedures may not be addended."
I TIUACT=20 S ALLOWED="0^ Historical Procedures may not have signers identified."
I TIUACT=21 S ALLOWED="0^ Historical Procedures may not be reassigned."
I TIUACT=22 S ALLOWED="0^ Historical Procedures may not have their titles changed."
I TIUACT=23 S ALLOWED="0^ Historical Procedures may not be linked with requests."
Q ALLOWED
;
ISCP(TIUY,TITLE) ;RPC that evaluates whether or not a Title is under
;the CLINICAL PROCEDURES Class
; Input -- TITLE TIU Document Definition file (#8925.1) IEN
; (May be Document Class instead of Title.)
; Output -- TIUY 1=True and 0=False
N TIUCLASS
;
;Exit if a Title is not defined
I +$G(TITLE)'>0 S TIUY=0 G ISCPQ
;
;Get CLINICAL PROCEDURES TIU Document Definition file (#8925.1) IEN
S TIUCLASS=+$$CLASS
;
;Exit if the CLINICAL PROCEDURES Class is not found
I +TIUCLASS'>0 S TIUY=0 G ISCPQ
;
;Check if the Title is under the CLINICAL PROCEDURES Class
S TIUY=+$$ISA^TIULX(TITLE,TIUCLASS)
ISCPQ Q
;
CPCLASS(Y) ;RPC that gets the CLINICAL PROCEDURES TIU Document
;Definition file (#8925.1) IEN
; Input -- None
; Output -- Y TIU Document Definition file (#8925.1) IEN
S Y=$$CLASS
Q
;
LNGCP(Y,FROM,DIR) ;RPC that serves data to a longlist of selectable Titles
; Input -- FROM Reference Title from which the longlist is
; scrolling
; DIR Direction from which the longlist is scrolling
; from the reference Title (Optional- default 1)
; Output -- Y An array of the 44 nearest Titles to that indicated
; by the user in the direction passed by the longlist
; component
N TIUCLASS
;
;Exit if a reference Title is not defined
I '$D(FROM) G LNGCPQ
;
;Get CLINICAL PROCEDURES TIU Document Definition file (#8925.1) IEN
S TIUCLASS=+$$CLASS
;
;Exit if the CLINICAL PROCEDURES Class is not found
I +TIUCLASS'>0 G LNGCPQ
;
;Get the longlist of Titles for the CLINICAL PROCEDURES Class
D LONGLIST^TIUSRVD(.Y,TIUCLASS,FROM,$G(DIR,1))
LNGCPQ Q
TIUCP ;SLC/RMO - Clinical Procedures API(s) and RPC(s) ;5/12/04
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**109,182**;Jun 20, 1997
+2 ;
CLASS() ;Get the CLINICAL PROCEDURES Class TIU Document Definition
+1 ;file (#8925.1) IEN
+2 ; Input -- None
+3 ; Output -- TIU Document Definition file (#8925.1) IEN
+4 NEW Y,TIUI,TYPE
+5 SET (Y,TIUI)=0
+6 ; -- Make sure type is CLASS (P182):
+7 FOR
SET TIUI=+$ORDER(^TIU(8925.1,"B","CLINICAL PROCEDURES",TIUI))
IF 'TIUI
QUIT
Begin DoDot:1
+8 SET TYPE=$PIECE($GET(^TIU(8925.1,TIUI,0)),U,4)
+9 IF TYPE="CL"
SET Y=TIUI
End DoDot:1
IF Y
QUIT
+10 QUIT Y
+11 ;
HISTDC() ;Get Historical Procedures Document Class IEN (under Class CLINICAL PROCEDURES) in TIU DDEF file (#8925.1)
+1 ; -- P182
+2 ; Input -- None
+3 ; Output -- TIU Document Definition file (#8925.1) IEN
+4 NEW Y,TIUI,TYPE,TIUISCP
+5 SET (Y,TIUI)=0
+6 FOR
SET TIUI=+$ORDER(^TIU(8925.1,"B","HISTORICAL PROCEDURES",TIUI))
IF 'TIUI
QUIT
Begin DoDot:1
+7 SET TYPE=$PIECE($GET(^TIU(8925.1,TIUI,0)),U,4)
+8 IF TYPE="DC"
DO ISCP(.TIUISCP,TIUI)
IF TIUISCP
SET Y=TIUI
End DoDot:1
IF Y
QUIT
+9 QUIT Y
+10 ;
ISHISTCP(TITLE) ; Function evaluates whether a Title is under the
+1 ;Historical Procedures Document Class under Class CP
+2 ; -- P182
+3 ; Input -- TITLE TIU Document Definition file (#8925.1) IEN
+4 ; Output -- 1=True and 0=False
+5 NEW TIUDCLAS,Y
+6 ; -- Exit if Title is not defined:
+7 IF $GET(TITLE)'>0
SET Y=0
GOTO ISHISTX
+8 ; -- Get HISTORICAL PROCEDURES Document Class IEN in 8925.1:
+9 SET TIUDCLAS=$$HISTDC
+10 ; -- Exit if Document Class is not found:
+11 IF TIUDCLAS'>0
SET Y=0
GOTO ISHISTX
+12 ; -- Check if Title is under HISTORICAL PROCEDURES Document Class:
+13 SET Y=+$$ISA^TIULX(TITLE,TIUDCLAS)
ISHISTX QUIT Y
+1 ;
HPCAN(TIUACT) ; Is action allowed (not prohibited outright) for HP docmts
+1 ; Returns 1 if action allowed (not prohibited outright)
+2 ; 0^WHYNOT if action not allowed (prohibited outright)
+3 ; Requires TIUACT=IEN in USR ACTION file
+4 NEW ALLOWED
SET ALLOWED=1
+5 IF TIUACT=19
SET ALLOWED="0^ Historical Procedures may not be addended."
+6 IF TIUACT=20
SET ALLOWED="0^ Historical Procedures may not have signers identified."
+7 IF TIUACT=21
SET ALLOWED="0^ Historical Procedures may not be reassigned."
+8 IF TIUACT=22
SET ALLOWED="0^ Historical Procedures may not have their titles changed."
+9 IF TIUACT=23
SET ALLOWED="0^ Historical Procedures may not be linked with requests."
+10 QUIT ALLOWED
+11 ;
ISCP(TIUY,TITLE) ;RPC that evaluates whether or not a Title is under
+1 ;the CLINICAL PROCEDURES Class
+2 ; Input -- TITLE TIU Document Definition file (#8925.1) IEN
+3 ; (May be Document Class instead of Title.)
+4 ; Output -- TIUY 1=True and 0=False
+5 NEW TIUCLASS
+6 ;
+7 ;Exit if a Title is not defined
+8 IF +$GET(TITLE)'>0
SET TIUY=0
GOTO ISCPQ
+9 ;
+10 ;Get CLINICAL PROCEDURES TIU Document Definition file (#8925.1) IEN
+11 SET TIUCLASS=+$$CLASS
+12 ;
+13 ;Exit if the CLINICAL PROCEDURES Class is not found
+14 IF +TIUCLASS'>0
SET TIUY=0
GOTO ISCPQ
+15 ;
+16 ;Check if the Title is under the CLINICAL PROCEDURES Class
+17 SET TIUY=+$$ISA^TIULX(TITLE,TIUCLASS)
ISCPQ QUIT
+1 ;
CPCLASS(Y) ;RPC that gets the CLINICAL PROCEDURES TIU Document
+1 ;Definition file (#8925.1) IEN
+2 ; Input -- None
+3 ; Output -- Y TIU Document Definition file (#8925.1) IEN
+4 SET Y=$$CLASS
+5 QUIT
+6 ;
LNGCP(Y,FROM,DIR) ;RPC that serves data to a longlist of selectable Titles
+1 ; Input -- FROM Reference Title from which the longlist is
+2 ; scrolling
+3 ; DIR Direction from which the longlist is scrolling
+4 ; from the reference Title (Optional- default 1)
+5 ; Output -- Y An array of the 44 nearest Titles to that indicated
+6 ; by the user in the direction passed by the longlist
+7 ; component
+8 NEW TIUCLASS
+9 ;
+10 ;Exit if a reference Title is not defined
+11 IF '$DATA(FROM)
GOTO LNGCPQ
+12 ;
+13 ;Get CLINICAL PROCEDURES TIU Document Definition file (#8925.1) IEN
+14 SET TIUCLASS=+$$CLASS
+15 ;
+16 ;Exit if the CLINICAL PROCEDURES Class is not found
+17 IF +TIUCLASS'>0
GOTO LNGCPQ
+18 ;
+19 ;Get the longlist of Titles for the CLINICAL PROCEDURES Class
+20 DO LONGLIST^TIUSRVD(.Y,TIUCLASS,FROM,$GET(DIR,1))
LNGCPQ QUIT
