1 | TIUPS109 ;SLC/RMO - Post-Install for TIU*1*109 ;11/7/00@10:04:20
|
---|
2 | ;;1.0;Text Integration Utilities;**109**;Jun 20, 1997
|
---|
3 | ;
|
---|
4 | ;Register TIU RPCs that support Clinical Procedures
|
---|
5 | D ENREG
|
---|
6 | ;
|
---|
7 | ;Create or Update Clinical Procedures Class
|
---|
8 | D ENCP
|
---|
9 | Q
|
---|
10 | ;
|
---|
11 | ENREG ;Entry point to Register TIU RPCs that support Clinical Procedures
|
---|
12 | N MENU,RPC
|
---|
13 | S MENU="OR CPRS GUI CHART"
|
---|
14 | F RPC="TIU IS THIS A CLINPROC?","TIU IDENTIFY CLINPROC CLASS","TIU LONG LIST CLINPROC TITLES" D INSERT(MENU,RPC)
|
---|
15 | Q
|
---|
16 | ;
|
---|
17 | INSERT(OPTION,RPC) ; Call FM Updater with each RPC
|
---|
18 | ; Input -- OPTION Option file (#19) Name field (#.01)
|
---|
19 | ; RPC RPC sub-file (#19.05) RPC field (#.01)
|
---|
20 | ; Output -- None
|
---|
21 | N FDA,FDAIEN,ERR,DIERR
|
---|
22 | S FDA(19,"?1,",.01)=OPTION
|
---|
23 | S FDA(19.05,"?+2,?1,",.01)=RPC
|
---|
24 | D UPDATE^DIE("E","FDA","FDAIEN","ERR")
|
---|
25 | Q
|
---|
26 | ;
|
---|
27 | ENCP ;Entry point to Create Clinical Procedures Class
|
---|
28 | ; Input -- None
|
---|
29 | ; Output -- None
|
---|
30 | N TIUDA,TIUFPRIV,TIUNEW
|
---|
31 | S TIUFPRIV=1,TIUNEW=0,TIUDA=$$CHKCP
|
---|
32 | I +TIUDA>0,$P(TIUDA,U,2)="CL" D
|
---|
33 | . D BMES^XPDUTL("You already have a CLASS called CLINICAL PROCEDURES...")
|
---|
34 | . D BMES^XPDUTL("The new methods and properties to support the TIU/CP interface")
|
---|
35 | . D BMES^XPDUTL("will be MERGED with the existing data. UPLOAD HEADERS")
|
---|
36 | . D BMES^XPDUTL("which you have defined will NOT be overwritten.")
|
---|
37 | . S TIUDA=+TIUDA
|
---|
38 | ELSE D G ENCPQ:+TIUDA'>0
|
---|
39 | . D BMES^XPDUTL("I'm going to create a new Document Definition for CLINICAL PROCEDURES now.")
|
---|
40 | . S TIUDA=$$CREATE(TIUFPRIV) S:+TIUDA TIUNEW=1
|
---|
41 | . I +TIUDA'>0 D BMES^XPDUTL("Couldn't create Document Definition entry for CLINICAL PROCEDURES...")
|
---|
42 | D SET(TIUDA,TIUFPRIV)
|
---|
43 | D INDEX(TIUDA,TIUFPRIV)
|
---|
44 | I +TIUNEW D ATTACH(TIUDA,TIUFPRIV)
|
---|
45 | D DONE
|
---|
46 | ENCPQ Q
|
---|
47 | ;
|
---|
48 | CHKCP() ;Check for CLINICAL PROCEDURES entry in Document Definition file
|
---|
49 | ; Input -- None
|
---|
50 | ; Output -- Document Definition Data from the TIU Document Definition file (#8925.1)
|
---|
51 | ; 1st Piece=IEN
|
---|
52 | ; 2nd Piece=Type field (#.04)
|
---|
53 | N TIUY
|
---|
54 | S TIUY=+$O(^TIU(8925.1,"B","CLINICAL PROCEDURES",0))
|
---|
55 | I +TIUY S $P(TIUY,U,2)=$P($G(^TIU(8925.1,+TIUY,0)),U,4)
|
---|
56 | Q TIUY
|
---|
57 | ;
|
---|
58 | CREATE(TIUFPRIV) ;Create a record for the CLINICAL PROCEDURES Document Definition
|
---|
59 | ; Input -- TIUFPRIV DD Privilege Flag
|
---|
60 | ; Output -- TIU Document Defintion file (#8925.1) IEN
|
---|
61 | N DIC,DLAYGO,X,Y
|
---|
62 | S (DIC,DLAYGO)="^TIU(8925.1,",DIC(0)="MXL",X="CLINICAL PROCEDURES"
|
---|
63 | D ^DIC
|
---|
64 | Q +$G(Y)
|
---|
65 | ;
|
---|
66 | SET(TIUDA,TIUFPRIV) ;Set the data in the new Document Definition record
|
---|
67 | ; Input -- TIUDA TIU Document Definition file (#8925.1) IEN
|
---|
68 | ; TIUFPRIV DD Privilege Flag
|
---|
69 | ; Output -- None
|
---|
70 | N TIUCLP
|
---|
71 | S TIUCLP=$$CLPAC
|
---|
72 | S ^TIU(8925.1,TIUDA,0)="CLINICAL PROCEDURES^CP^Clinical Procedures^CL^^"_TIUCLP_"^11^^^^^^1"
|
---|
73 | S ^TIU(8925.1,TIUDA,1)="8925^1^2;TEXT"
|
---|
74 | S ^TIU(8925.1,TIUDA,3)="^1^0"
|
---|
75 | S ^TIU(8925.1,TIUDA,4)="D LOOKUP^TIUPUTCP" ;Upload
|
---|
76 | S ^TIU(8925.1,TIUDA,4.1)="D POST^TIUCPCL(DA,""INCOMPLETE"")"
|
---|
77 | S ^TIU(8925.1,TIUDA,4.4)="D ROLLBACK^TIUCPCL(TIUDA)"
|
---|
78 | S ^TIU(8925.1,TIUDA,4.45)="D CHANGE^TIUCPCL(TIUDA)"
|
---|
79 | S ^TIU(8925.1,TIUDA,4.5)="D FOLLOWUP^TIUPUTCP(TIUREC(""#""))" ;Upload
|
---|
80 | S ^TIU(8925.1,TIUDA,4.8)="D GETCP^TIUPUTCP" ;Upload
|
---|
81 | S ^TIU(8925.1,TIUDA,4.9)="D POST^TIUCPCL(DA,""COMPLETED"")"
|
---|
82 | S ^TIU(8925.1,TIUDA,5)="[TIU ENTER/EDIT CLINPROC RESULT]" ;Upload/Edit
|
---|
83 | S ^TIU(8925.1,TIUDA,6)="D ENTRY^TIUPRCN"
|
---|
84 | S ^TIU(8925.1,TIUDA,6.1)="Progress Notes^Vice SF 509^^0"
|
---|
85 | S ^TIU(8925.1,TIUDA,7)="D ENPN^TIUVSIT(.TIU,.DFN,1)"
|
---|
86 | S ^TIU(8925.1,TIUDA,8)="S TIUASK=$$CHEKPN^TIULD(.TIU,.TIUBY)"
|
---|
87 | ; -- Don't modify upload header, if already defined --
|
---|
88 | I '$D(^TIU(8925.1,TIUDA,"HEAD")) D ;Upload
|
---|
89 | . S ^TIU(8925.1,TIUDA,"HEAD",0)="^8925.12A^11^11"
|
---|
90 | . S ^TIU(8925.1,TIUDA,"HEAD",1,0)="TITLE^TITLE OF CLINICAL PROCEDURE^.01^TIUTITLE^GENERAL PROCEDURE^1^1"
|
---|
91 | . S ^TIU(8925.1,TIUDA,"HEAD",2,0)="SSN^PATIENT SSN^.02^TIUSSN^555-12-1234^1^1"
|
---|
92 | . S ^TIU(8925.1,TIUDA,"HEAD",2,1)="S X=$TR(X,""-/"","""")"
|
---|
93 | . S ^TIU(8925.1,TIUDA,"HEAD",3,0)="VISIT/EVENT DATE^VISIT/EVENT DATE^.07^TIUVDT^5/15/2001@08:15^1^1"
|
---|
94 | . S ^TIU(8925.1,TIUDA,"HEAD",4,0)="AUTHOR^DICTATING PROVIDER^1202^^HOWSER,DOOGEY^1^1"
|
---|
95 | . S ^TIU(8925.1,TIUDA,"HEAD",5,0)="DATE/TIME OF DICTATION^DICTATION DATE/TIME^1307^TIUDDT^5/16/2001@09:25^0^1"
|
---|
96 | . S ^TIU(8925.1,TIUDA,"HEAD",6,0)="LOCATION^PATIENT LOCATION^1205^TIULOC^MEDICAL-CONSULT 6200^1^1"
|
---|
97 | . S ^TIU(8925.1,TIUDA,"HEAD",7,0)="EXPECTED COSIGNER^EXPECTED COSIGNER^1208^^WELBY,MARCUS^1^0"
|
---|
98 | . S ^TIU(8925.1,TIUDA,"HEAD",8,0)="CONSULT REQUEST NUMBER^CONSULT REQUEST #^1405^TIUCNNBR^1455^1^1"
|
---|
99 | . S ^TIU(8925.1,TIUDA,"HEAD",8,1)="S X=""C.""_X"
|
---|
100 | . S ^TIU(8925.1,TIUDA,"HEAD",9,0)="TIU DOCUMENT NUMBER^TIU DOCUMENT #^.001^TIUPLDA^543^1^0"
|
---|
101 | . S ^TIU(8925.1,TIUDA,"HEAD",10,0)="PROCEDURE SUMMARY CODE^PROCEDURE SUMMARY CODE^70201^TIUPSC^Normal^1^0"
|
---|
102 | . S ^TIU(8925.1,TIUDA,"HEAD",11,0)="DATE/TIME PERFORMED^DATE/TIME PERFORMED^70202^TIUDTP^5/15/2001@08:00^1^0"
|
---|
103 | ELSE D
|
---|
104 | . 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
|
---|
105 | Q
|
---|
106 | ;
|
---|
107 | CLPAC() ;Get pointer to CLINICAL COORDINATOR User Class
|
---|
108 | ; Input -- None
|
---|
109 | ; Output -- USR Class file (#8930) IEN
|
---|
110 | N TIUY
|
---|
111 | S TIUY=$O(^USR(8930,"B","CLINICAL COORDINATOR",0))
|
---|
112 | Q TIUY
|
---|
113 | ;
|
---|
114 | INDEX(DA,TIUFPRIV) ;Call IX^DIK to re-index the CLINICAL PROCEDURES entry
|
---|
115 | ; Input -- DA TIU Document Defintion file (#8925.1) IEN
|
---|
116 | ; TIUFPRIV DD Privilege Flag
|
---|
117 | ; Output -- None
|
---|
118 | N DIK
|
---|
119 | S DIK="^TIU(8925.1," D IX^DIK
|
---|
120 | Q
|
---|
121 | ;
|
---|
122 | ATTACH(TIUDA,TIUFPRIV) ;Attach CLINICAL PROCEDURES to appropriate parent
|
---|
123 | ; Input -- TIUDA TIU Document Defintion file (#8925.1) IEN
|
---|
124 | ; TIUFPRIV DD Privilege Flag
|
---|
125 | ; Output -- None
|
---|
126 | N DIC,DLAYGO,DIE,DR,X,Y
|
---|
127 | D BMES^XPDUTL("The new CLINICAL PROCEDURES Class will now be added under")
|
---|
128 | S DA(1)=38 ;CLINICAL DOCUMENTS Class
|
---|
129 | D BMES^XPDUTL("the "_$P(^TIU(8925.1,DA(1),0),U)_" Class...")
|
---|
130 | S DIC="^TIU(8925.1,"_DA(1)_",10,",DIC(0)="NXL"
|
---|
131 | S DIC("P")=$P(^DD(8925.1,10,0),U,2),X="`"_TIUDA
|
---|
132 | D ^DIC ; Create the sub-entry for CLINICAL PROCEDURES
|
---|
133 | I +Y'>0 D G ATTACHQ
|
---|
134 | . D BMES^XPDUTL("Unable to add CLINICAL PROCEDURES under "_$P($G(^TIU(8925.1,DA(1),0)),U))
|
---|
135 | . D BMES^XPDUTL("You'll have to attach it manually.")
|
---|
136 | S DA=+Y,DIK=DIC K DIC
|
---|
137 | S ^TIU(8925.1,DA(1),10,DA,0)=$G(^TIU(8925.1,DA(1),10,DA,0))_"^^^Clinical Procedures"
|
---|
138 | D IX^DIK ; Cross-reference new subfile entry
|
---|
139 | ATTACHQ Q
|
---|
140 | ;
|
---|
141 | DONE ;Let the user know
|
---|
142 | ; Input -- None
|
---|
143 | ; Output -- None
|
---|
144 | D BMES^XPDUTL("Okay, I'm done.")
|
---|
145 | D BMES^XPDUTL("Please finish your implementation of CLINICAL PROCEDURES by adding")
|
---|
146 | D BMES^XPDUTL("any Document Classes and Titles as appropriate using the Create")
|
---|
147 | D BMES^XPDUTL("Document Definitions Option under the TIUF DOCUMENT DEFINITION MGR Menu")
|
---|
148 | D BMES^XPDUTL("as described in the Post-Installation Instructions.")
|
---|
149 | Q
|
---|