- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUCP 4000 printed Jan 18, 2025@03:40:36 Page 2
- 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