TIUPS109 ;SLC/RMO - Post-Install for TIU*1*109 ;11/7/00@10:04:20
;;1.0;Text Integration Utilities;**109**;Jun 20, 1997
;
;Register TIU RPCs that support Clinical Procedures
D ENREG
;
;Create or Update Clinical Procedures Class
D ENCP
Q
;
ENREG ;Entry point to Register TIU RPCs that support Clinical Procedures
N MENU,RPC
S MENU="OR CPRS GUI CHART"
F RPC="TIU IS THIS A CLINPROC?","TIU IDENTIFY CLINPROC CLASS","TIU LONG LIST CLINPROC TITLES" D INSERT(MENU,RPC)
Q
;
INSERT(OPTION,RPC) ; Call FM Updater with each RPC
; Input -- OPTION Option file (#19) Name field (#.01)
; RPC RPC sub-file (#19.05) RPC field (#.01)
; Output -- None
N FDA,FDAIEN,ERR,DIERR
S FDA(19,"?1,",.01)=OPTION
S FDA(19.05,"?+2,?1,",.01)=RPC
D UPDATE^DIE("E","FDA","FDAIEN","ERR")
Q
;
ENCP ;Entry point to Create Clinical Procedures Class
; Input -- None
; Output -- None
N TIUDA,TIUFPRIV,TIUNEW
S TIUFPRIV=1,TIUNEW=0,TIUDA=$$CHKCP
I +TIUDA>0,$P(TIUDA,U,2)="CL" D
. D BMES^XPDUTL("You already have a CLASS called CLINICAL PROCEDURES...")
. D BMES^XPDUTL("The new methods and properties to support the TIU/CP interface")
. D BMES^XPDUTL("will be MERGED with the existing data. UPLOAD HEADERS")
. D BMES^XPDUTL("which you have defined will NOT be overwritten.")
. S TIUDA=+TIUDA
ELSE D G ENCPQ:+TIUDA'>0
. D BMES^XPDUTL("I'm going to create a new Document Definition for CLINICAL PROCEDURES now.")
. S TIUDA=$$CREATE(TIUFPRIV) S:+TIUDA TIUNEW=1
. I +TIUDA'>0 D BMES^XPDUTL("Couldn't create Document Definition entry for CLINICAL PROCEDURES...")
D SET(TIUDA,TIUFPRIV)
D INDEX(TIUDA,TIUFPRIV)
I +TIUNEW D ATTACH(TIUDA,TIUFPRIV)
D DONE
ENCPQ Q
;
CHKCP() ;Check for CLINICAL PROCEDURES entry in Document Definition file
; Input -- None
; Output -- Document Definition Data from the TIU Document Definition file (#8925.1)
; 1st Piece=IEN
; 2nd Piece=Type field (#.04)
N TIUY
S TIUY=+$O(^TIU(8925.1,"B","CLINICAL PROCEDURES",0))
I +TIUY S $P(TIUY,U,2)=$P($G(^TIU(8925.1,+TIUY,0)),U,4)
Q TIUY
;
CREATE(TIUFPRIV) ;Create a record for the CLINICAL PROCEDURES Document Definition
; Input -- TIUFPRIV DD Privilege Flag
; Output -- TIU Document Defintion file (#8925.1) IEN
N DIC,DLAYGO,X,Y
S (DIC,DLAYGO)="^TIU(8925.1,",DIC(0)="MXL",X="CLINICAL PROCEDURES"
D ^DIC
Q +$G(Y)
;
SET(TIUDA,TIUFPRIV) ;Set the data in the new Document Definition record
; Input -- TIUDA TIU Document Definition file (#8925.1) IEN
; TIUFPRIV DD Privilege Flag
; Output -- None
N TIUCLP
S TIUCLP=$$CLPAC
S ^TIU(8925.1,TIUDA,0)="CLINICAL PROCEDURES^CP^Clinical Procedures^CL^^"_TIUCLP_"^11^^^^^^1"
S ^TIU(8925.1,TIUDA,1)="8925^1^2;TEXT"
S ^TIU(8925.1,TIUDA,3)="^1^0"
S ^TIU(8925.1,TIUDA,4)="D LOOKUP^TIUPUTCP" ;Upload
S ^TIU(8925.1,TIUDA,4.1)="D POST^TIUCPCL(DA,""INCOMPLETE"")"
S ^TIU(8925.1,TIUDA,4.4)="D ROLLBACK^TIUCPCL(TIUDA)"
S ^TIU(8925.1,TIUDA,4.45)="D CHANGE^TIUCPCL(TIUDA)"
S ^TIU(8925.1,TIUDA,4.5)="D FOLLOWUP^TIUPUTCP(TIUREC(""#""))" ;Upload
S ^TIU(8925.1,TIUDA,4.8)="D GETCP^TIUPUTCP" ;Upload
S ^TIU(8925.1,TIUDA,4.9)="D POST^TIUCPCL(DA,""COMPLETED"")"
S ^TIU(8925.1,TIUDA,5)="[TIU ENTER/EDIT CLINPROC RESULT]" ;Upload/Edit
S ^TIU(8925.1,TIUDA,6)="D ENTRY^TIUPRCN"
S ^TIU(8925.1,TIUDA,6.1)="Progress Notes^Vice SF 509^^0"
S ^TIU(8925.1,TIUDA,7)="D ENPN^TIUVSIT(.TIU,.DFN,1)"
S ^TIU(8925.1,TIUDA,8)="S TIUASK=$$CHEKPN^TIULD(.TIU,.TIUBY)"
; -- Don't modify upload header, if already defined --
I '$D(^TIU(8925.1,TIUDA,"HEAD")) D ;Upload
. S ^TIU(8925.1,TIUDA,"HEAD",0)="^8925.12A^11^11"
. S ^TIU(8925.1,TIUDA,"HEAD",1,0)="TITLE^TITLE OF CLINICAL PROCEDURE^.01^TIUTITLE^GENERAL PROCEDURE^1^1"
. S ^TIU(8925.1,TIUDA,"HEAD",2,0)="SSN^PATIENT SSN^.02^TIUSSN^555-12-1234^1^1"
. S ^TIU(8925.1,TIUDA,"HEAD",2,1)="S X=$TR(X,""-/"","""")"
. S ^TIU(8925.1,TIUDA,"HEAD",3,0)="VISIT/EVENT DATE^VISIT/EVENT DATE^.07^TIUVDT^5/15/2001@08:15^1^1"
. S ^TIU(8925.1,TIUDA,"HEAD",4,0)="AUTHOR^DICTATING PROVIDER^1202^^HOWSER,DOOGEY^1^1"
. S ^TIU(8925.1,TIUDA,"HEAD",5,0)="DATE/TIME OF DICTATION^DICTATION DATE/TIME^1307^TIUDDT^5/16/2001@09:25^0^1"
. S ^TIU(8925.1,TIUDA,"HEAD",6,0)="LOCATION^PATIENT LOCATION^1205^TIULOC^MEDICAL-CONSULT 6200^1^1"
. S ^TIU(8925.1,TIUDA,"HEAD",7,0)="EXPECTED COSIGNER^EXPECTED COSIGNER^1208^^WELBY,MARCUS^1^0"
. S ^TIU(8925.1,TIUDA,"HEAD",8,0)="CONSULT REQUEST NUMBER^CONSULT REQUEST #^1405^TIUCNNBR^1455^1^1"
. S ^TIU(8925.1,TIUDA,"HEAD",8,1)="S X=""C.""_X"
. S ^TIU(8925.1,TIUDA,"HEAD",9,0)="TIU DOCUMENT NUMBER^TIU DOCUMENT #^.001^TIUPLDA^543^1^0"
. S ^TIU(8925.1,TIUDA,"HEAD",10,0)="PROCEDURE SUMMARY CODE^PROCEDURE SUMMARY CODE^70201^TIUPSC^Normal^1^0"
. S ^TIU(8925.1,TIUDA,"HEAD",11,0)="DATE/TIME PERFORMED^DATE/TIME PERFORMED^70202^TIUDTP^5/15/2001@08:00^1^0"
ELSE D
. I $P($G(^TIU(8925.1,TIUDA,"HEAD",5,0)),U,1)="DATE/TIME OF DICTATION",$P(^(0),U,3)=1301 S $P(^(0),U,3)=1307
Q
;
CLPAC() ;Get pointer to CLINICAL COORDINATOR User Class
; Input -- None
; Output -- USR Class file (#8930) IEN
N TIUY
S TIUY=$O(^USR(8930,"B","CLINICAL COORDINATOR",0))
Q TIUY
;
INDEX(DA,TIUFPRIV) ;Call IX^DIK to re-index the CLINICAL PROCEDURES entry
; Input -- DA TIU Document Defintion file (#8925.1) IEN
; TIUFPRIV DD Privilege Flag
; Output -- None
N DIK
S DIK="^TIU(8925.1," D IX^DIK
Q
;
ATTACH(TIUDA,TIUFPRIV) ;Attach CLINICAL PROCEDURES to appropriate parent
; Input -- TIUDA TIU Document Defintion file (#8925.1) IEN
; TIUFPRIV DD Privilege Flag
; Output -- None
N DIC,DLAYGO,DIE,DR,X,Y
D BMES^XPDUTL("The new CLINICAL PROCEDURES Class will now be added under")
S DA(1)=38 ;CLINICAL DOCUMENTS Class
D BMES^XPDUTL("the "_$P(^TIU(8925.1,DA(1),0),U)_" Class...")
S DIC="^TIU(8925.1,"_DA(1)_",10,",DIC(0)="NXL"
S DIC("P")=$P(^DD(8925.1,10,0),U,2),X="`"_TIUDA
D ^DIC ; Create the sub-entry for CLINICAL PROCEDURES
I +Y'>0 D G ATTACHQ
. D BMES^XPDUTL("Unable to add CLINICAL PROCEDURES under "_$P($G(^TIU(8925.1,DA(1),0)),U))
. D BMES^XPDUTL("You'll have to attach it manually.")
S DA=+Y,DIK=DIC K DIC
S ^TIU(8925.1,DA(1),10,DA,0)=$G(^TIU(8925.1,DA(1),10,DA,0))_"^^^Clinical Procedures"
D IX^DIK ; Cross-reference new subfile entry
ATTACHQ Q
;
DONE ;Let the user know
; Input -- None
; Output -- None
D BMES^XPDUTL("Okay, I'm done.")
D BMES^XPDUTL("Please finish your implementation of CLINICAL PROCEDURES by adding")
D BMES^XPDUTL("any Document Classes and Titles as appropriate using the Create")
D BMES^XPDUTL("Document Definitions Option under the TIUF DOCUMENT DEFINITION MGR Menu")
D BMES^XPDUTL("as described in the Post-Installation Instructions.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPS109 6784 printed Nov 22, 2024@17:53:52 Page 2
TIUPS109 ;SLC/RMO - Post-Install for TIU*1*109 ;11/7/00@10:04:20
+1 ;;1.0;Text Integration Utilities;**109**;Jun 20, 1997
+2 ;
+3 ;Register TIU RPCs that support Clinical Procedures
+4 DO ENREG
+5 ;
+6 ;Create or Update Clinical Procedures Class
+7 DO ENCP
+8 QUIT
+9 ;
ENREG ;Entry point to Register TIU RPCs that support Clinical Procedures
+1 NEW MENU,RPC
+2 SET MENU="OR CPRS GUI CHART"
+3 FOR RPC="TIU IS THIS A CLINPROC?","TIU IDENTIFY CLINPROC CLASS","TIU LONG LIST CLINPROC TITLES"
DO INSERT(MENU,RPC)
+4 QUIT
+5 ;
INSERT(OPTION,RPC) ; Call FM Updater with each RPC
+1 ; Input -- OPTION Option file (#19) Name field (#.01)
+2 ; RPC RPC sub-file (#19.05) RPC field (#.01)
+3 ; Output -- None
+4 NEW FDA,FDAIEN,ERR,DIERR
+5 SET FDA(19,"?1,",.01)=OPTION
+6 SET FDA(19.05,"?+2,?1,",.01)=RPC
+7 DO UPDATE^DIE("E","FDA","FDAIEN","ERR")
+8 QUIT
+9 ;
ENCP ;Entry point to Create Clinical Procedures Class
+1 ; Input -- None
+2 ; Output -- None
+3 NEW TIUDA,TIUFPRIV,TIUNEW
+4 SET TIUFPRIV=1
SET TIUNEW=0
SET TIUDA=$$CHKCP
+5 IF +TIUDA>0
IF $PIECE(TIUDA,U,2)="CL"
Begin DoDot:1
+6 DO BMES^XPDUTL("You already have a CLASS called CLINICAL PROCEDURES...")
+7 DO BMES^XPDUTL("The new methods and properties to support the TIU/CP interface")
+8 DO BMES^XPDUTL("will be MERGED with the existing data. UPLOAD HEADERS")
+9 DO BMES^XPDUTL("which you have defined will NOT be overwritten.")
+10 SET TIUDA=+TIUDA
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 DO BMES^XPDUTL("I'm going to create a new Document Definition for CLINICAL PROCEDURES now.")
+13 SET TIUDA=$$CREATE(TIUFPRIV)
if +TIUDA
SET TIUNEW=1
+14 IF +TIUDA'>0
DO BMES^XPDUTL("Couldn't create Document Definition entry for CLINICAL PROCEDURES...")
End DoDot:1
if +TIUDA'>0
GOTO ENCPQ
+15 DO SET(TIUDA,TIUFPRIV)
+16 DO INDEX(TIUDA,TIUFPRIV)
+17 IF +TIUNEW
DO ATTACH(TIUDA,TIUFPRIV)
+18 DO DONE
ENCPQ QUIT
+1 ;
CHKCP() ;Check for CLINICAL PROCEDURES entry in Document Definition file
+1 ; Input -- None
+2 ; Output -- Document Definition Data from the TIU Document Definition file (#8925.1)
+3 ; 1st Piece=IEN
+4 ; 2nd Piece=Type field (#.04)
+5 NEW TIUY
+6 SET TIUY=+$ORDER(^TIU(8925.1,"B","CLINICAL PROCEDURES",0))
+7 IF +TIUY
SET $PIECE(TIUY,U,2)=$PIECE($GET(^TIU(8925.1,+TIUY,0)),U,4)
+8 QUIT TIUY
+9 ;
CREATE(TIUFPRIV) ;Create a record for the CLINICAL PROCEDURES Document Definition
+1 ; Input -- TIUFPRIV DD Privilege Flag
+2 ; Output -- TIU Document Defintion file (#8925.1) IEN
+3 NEW DIC,DLAYGO,X,Y
+4 SET (DIC,DLAYGO)="^TIU(8925.1,"
SET DIC(0)="MXL"
SET X="CLINICAL PROCEDURES"
+5 DO ^DIC
+6 QUIT +$GET(Y)
+7 ;
SET(TIUDA,TIUFPRIV) ;Set the data in the new Document Definition record
+1 ; Input -- TIUDA TIU Document Definition file (#8925.1) IEN
+2 ; TIUFPRIV DD Privilege Flag
+3 ; Output -- None
+4 NEW TIUCLP
+5 SET TIUCLP=$$CLPAC
+6 SET ^TIU(8925.1,TIUDA,0)="CLINICAL PROCEDURES^CP^Clinical Procedures^CL^^"_TIUCLP_"^11^^^^^^1"
+7 SET ^TIU(8925.1,TIUDA,1)="8925^1^2;TEXT"
+8 SET ^TIU(8925.1,TIUDA,3)="^1^0"
+9 ;Upload
SET ^TIU(8925.1,TIUDA,4)="D LOOKUP^TIUPUTCP"
+10 SET ^TIU(8925.1,TIUDA,4.1)="D POST^TIUCPCL(DA,""INCOMPLETE"")"
+11 SET ^TIU(8925.1,TIUDA,4.4)="D ROLLBACK^TIUCPCL(TIUDA)"
+12 SET ^TIU(8925.1,TIUDA,4.45)="D CHANGE^TIUCPCL(TIUDA)"
+13 ;Upload
SET ^TIU(8925.1,TIUDA,4.5)="D FOLLOWUP^TIUPUTCP(TIUREC(""#""))"
+14 ;Upload
SET ^TIU(8925.1,TIUDA,4.8)="D GETCP^TIUPUTCP"
+15 SET ^TIU(8925.1,TIUDA,4.9)="D POST^TIUCPCL(DA,""COMPLETED"")"
+16 ;Upload/Edit
SET ^TIU(8925.1,TIUDA,5)="[TIU ENTER/EDIT CLINPROC RESULT]"
+17 SET ^TIU(8925.1,TIUDA,6)="D ENTRY^TIUPRCN"
+18 SET ^TIU(8925.1,TIUDA,6.1)="Progress Notes^Vice SF 509^^0"
+19 SET ^TIU(8925.1,TIUDA,7)="D ENPN^TIUVSIT(.TIU,.DFN,1)"
+20 SET ^TIU(8925.1,TIUDA,8)="S TIUASK=$$CHEKPN^TIULD(.TIU,.TIUBY)"
+21 ; -- Don't modify upload header, if already defined --
+22 ;Upload
IF '$DATA(^TIU(8925.1,TIUDA,"HEAD"))
Begin DoDot:1
+23 SET ^TIU(8925.1,TIUDA,"HEAD",0)="^8925.12A^11^11"
+24 SET ^TIU(8925.1,TIUDA,"HEAD",1,0)="TITLE^TITLE OF CLINICAL PROCEDURE^.01^TIUTITLE^GENERAL PROCEDURE^1^1"
+25 SET ^TIU(8925.1,TIUDA,"HEAD",2,0)="SSN^PATIENT SSN^.02^TIUSSN^555-12-1234^1^1"
+26 SET ^TIU(8925.1,TIUDA,"HEAD",2,1)="S X=$TR(X,""-/"","""")"
+27 SET ^TIU(8925.1,TIUDA,"HEAD",3,0)="VISIT/EVENT DATE^VISIT/EVENT DATE^.07^TIUVDT^5/15/2001@08:15^1^1"
+28 SET ^TIU(8925.1,TIUDA,"HEAD",4,0)="AUTHOR^DICTATING PROVIDER^1202^^HOWSER,DOOGEY^1^1"
+29 SET ^TIU(8925.1,TIUDA,"HEAD",5,0)="DATE/TIME OF DICTATION^DICTATION DATE/TIME^1307^TIUDDT^5/16/2001@09:25^0^1"
+30 SET ^TIU(8925.1,TIUDA,"HEAD",6,0)="LOCATION^PATIENT LOCATION^1205^TIULOC^MEDICAL-CONSULT 6200^1^1"
+31 SET ^TIU(8925.1,TIUDA,"HEAD",7,0)="EXPECTED COSIGNER^EXPECTED COSIGNER^1208^^WELBY,MARCUS^1^0"
+32 SET ^TIU(8925.1,TIUDA,"HEAD",8,0)="CONSULT REQUEST NUMBER^CONSULT REQUEST #^1405^TIUCNNBR^1455^1^1"
+33 SET ^TIU(8925.1,TIUDA,"HEAD",8,1)="S X=""C.""_X"
+34 SET ^TIU(8925.1,TIUDA,"HEAD",9,0)="TIU DOCUMENT NUMBER^TIU DOCUMENT #^.001^TIUPLDA^543^1^0"
+35 SET ^TIU(8925.1,TIUDA,"HEAD",10,0)="PROCEDURE SUMMARY CODE^PROCEDURE SUMMARY CODE^70201^TIUPSC^Normal^1^0"
+36 SET ^TIU(8925.1,TIUDA,"HEAD",11,0)="DATE/TIME PERFORMED^DATE/TIME PERFORMED^70202^TIUDTP^5/15/2001@08:00^1^0"
End DoDot:1
+37 IF '$TEST
Begin DoDot:1
+38 IF $PIECE($GET(^TIU(8925.1,TIUDA,"HEAD",5,0)),U,1)="DATE/TIME OF DICTATION"
IF $PIECE(^(0),U,3)=1301
SET $PIECE(^(0),U,3)=1307
End DoDot:1
+39 QUIT
+40 ;
CLPAC() ;Get pointer to CLINICAL COORDINATOR User Class
+1 ; Input -- None
+2 ; Output -- USR Class file (#8930) IEN
+3 NEW TIUY
+4 SET TIUY=$ORDER(^USR(8930,"B","CLINICAL COORDINATOR",0))
+5 QUIT TIUY
+6 ;
INDEX(DA,TIUFPRIV) ;Call IX^DIK to re-index the CLINICAL PROCEDURES entry
+1 ; Input -- DA TIU Document Defintion file (#8925.1) IEN
+2 ; TIUFPRIV DD Privilege Flag
+3 ; Output -- None
+4 NEW DIK
+5 SET DIK="^TIU(8925.1,"
DO IX^DIK
+6 QUIT
+7 ;
ATTACH(TIUDA,TIUFPRIV) ;Attach CLINICAL PROCEDURES to appropriate parent
+1 ; Input -- TIUDA TIU Document Defintion file (#8925.1) IEN
+2 ; TIUFPRIV DD Privilege Flag
+3 ; Output -- None
+4 NEW DIC,DLAYGO,DIE,DR,X,Y
+5 DO BMES^XPDUTL("The new CLINICAL PROCEDURES Class will now be added under")
+6 ;CLINICAL DOCUMENTS Class
SET DA(1)=38
+7 DO BMES^XPDUTL("the "_$PIECE(^TIU(8925.1,DA(1),0),U)_" Class...")
+8 SET DIC="^TIU(8925.1,"_DA(1)_",10,"
SET DIC(0)="NXL"
+9 SET DIC("P")=$PIECE(^DD(8925.1,10,0),U,2)
SET X="`"_TIUDA
+10 ; Create the sub-entry for CLINICAL PROCEDURES
DO ^DIC
+11 IF +Y'>0
Begin DoDot:1
+12 DO BMES^XPDUTL("Unable to add CLINICAL PROCEDURES under "_$PIECE($GET(^TIU(8925.1,DA(1),0)),U))
+13 DO BMES^XPDUTL("You'll have to attach it manually.")
End DoDot:1
GOTO ATTACHQ
+14 SET DA=+Y
SET DIK=DIC
KILL DIC
+15 SET ^TIU(8925.1,DA(1),10,DA,0)=$GET(^TIU(8925.1,DA(1),10,DA,0))_"^^^Clinical Procedures"
+16 ; Cross-reference new subfile entry
DO IX^DIK
ATTACHQ QUIT
+1 ;
DONE ;Let the user know
+1 ; Input -- None
+2 ; Output -- None
+3 DO BMES^XPDUTL("Okay, I'm done.")
+4 DO BMES^XPDUTL("Please finish your implementation of CLINICAL PROCEDURES by adding")
+5 DO BMES^XPDUTL("any Document Classes and Titles as appropriate using the Create")
+6 DO BMES^XPDUTL("Document Definitions Option under the TIUF DOCUMENT DEFINITION MGR Menu")
+7 DO BMES^XPDUTL("as described in the Post-Installation Instructions.")
+8 QUIT
