source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPS109.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1TIUPS109 ;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 ;
11ENREG ;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 ;
17INSERT(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 ;
27ENCP ;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
46ENCPQ Q
47 ;
48CHKCP() ;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 ;
58CREATE(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 ;
66SET(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 ;
107CLPAC() ;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 ;
114INDEX(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 ;
122ATTACH(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
139ATTACHQ Q
140 ;
141DONE ;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
Note: See TracBrowser for help on using the repository browser.