source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPS14.m@ 841

Last change on this file since 841 was 613, checked in by George Lilly, 16 years ago

initial load of WorldVistAEHR
File size: 6.2 KB
RevLine 
[613]1TIUPS14 ; SLC/JER - Post-Install for TIU*1*4;Dec 05, 1997 08:30 ;2/3/98@09:52:05
2 ;;1.0;Text Integration Utilities;**4**;Jun 20, 1997
3MAIN ; Control subroutine
4 N TIUDA,TIULVL,TIULNM,TIUCONT,TIUFPRIV,TIUNEW
5 I +$L($T(GET^GMRCTIU))'>0 D Q
6 . W !!,$C(7),"You must install CONSULT/REQUEST TRACKING 3.0 before",!?6,"implementing this part of patch TIU*1*4."
7 S TIUFPRIV=1,TIUNEW=0,TIUDA=$$TEST
8 I +TIUDA>0 D Q:+$G(TIUCONT)'>0
9 . S TIULVL=$P(TIUDA,U,2)
10 . S TIULNM=$S(TIULVL="CL":"CLASS",1:"DOCUMENT CLASS")
11 . W !!,"You already have a ",TIULNM," called CONSULTS under "
12 . W $$CLNAME(+TIUDA),"...",!
13 . W !,"The new methods and properties to support the TIU/CT interface"
14 . W !,"will be MERGED with the existing data. UPLOAD HEADERS and"
15 . W !,"PRINT METHODS which you have defined will NOT be overwritten.",!
16 . S TIUCONT=+$$READ^TIUU("Y"," Okay to continue","NO")
17 . I 'TIUCONT W !!,"Great...No harm done!",!
18 . S TIUDA=+TIUDA
19 I +TIUDA'>0 D Q:+TIUDA'>0
20 . W !!,"I'm going to create a new Document Definition for CONSULTS now."
21 . S TIUDA=$$CREATE S:+TIUDA TIUNEW=1
22 . W:+TIUDA'>0 !!,$C(7),"Couldn't create Document Definition entry for CONSULTS...",!
23 D:$G(TIULVL)']"" ASK(TIUDA,.TIULVL)
24 I $G(TIULVL)']"" W !!,"Great...No harm done!",! Q
25 D SET(TIUDA,TIULVL)
26 D INDEX(TIUDA)
27 I +TIUNEW D ATTACH(TIUDA,TIULVL)
28 D DONE(TIULVL)
29 Q
30DONE(TIULVL) ; Let the user know
31 N TIUCRLF S TIUCRLF=$C(13)_$C(10)
32 W !!,"Okay, I'm done...Please finish your implementation of CONSULTS by"
33 W " adding any",!,$S(TIULVL="CL":"Document Classes and ",1:""),"Titles"
34 W " as appropriate using the Create Document Definitions",$S(TIULVL="CL":TIUCRLF,1:" "),"Option",$S(TIULVL="CL":" ",1:TIUCRLF)
35 W "under the TIUF DOCUMENT DEFINITION MGR Menu, as described in"
36 W " Step #3",!,"of the Post-Installation Instructions.",!
37 Q
38CLNAME(TIUDA) ; Get parent class's name
39 N TIUY
40 S TIUY=$P($G(^TIU(8925.1,+$$DOCCLASS^TIULC1(TIUDA),0)),U)
41 Q $G(TIUY)
42TEST() ; Check for CONSULTS entry in Document Defintion file
43 N TIUY
44 S TIUY=+$O(^TIU(8925.1,"B","CONSULTS",0))
45 I +TIUY S $P(TIUY,U,2)=$P($G(^TIU(8925.1,+TIUY,0)),U,4)
46 Q TIUY
47CREATE() ; Create a record for the CONSULTS Document Definition
48 N DIC,DLAYGO,X,Y
49 S (DIC,DLAYGO)="^TIU(8925.1,",DIC(0)="MXL",X="CONSULTS"
50 D ^DIC
51 Q +$G(Y)
52ASK(TIUDA,LEVEL) ; Ascertain whether to make CONSULTS a CLASS or DC
53 N TIUPRMT
54 W !!,"GREAT! A new Document Definition has been created for CONSULTS."
55 W !,"Next, you need to decide whether you want CONSULTS to be set up"
56 W !,"as a separate CLASS (comparable to DISCHARGE SUMMARY or PROGRESS"
57 W !,"NOTES), or whether you want CONSULTS defined as a DOCUMENT CLASS"
58 W !,"under PROGRESS NOTES. The benefits of each strategy are outlined"
59 W !,"in the POST-INSTALLATION instructions for this patch.",!
60 W !,"NOTE: If you're not yet CERTAIN which strategy you want your site"
61 W !,"to adopt, then quit here, and get consensus first (it's easier to"
62 W !,"get permission than forgiveness, in this case)!",!
63 S TIUPRMT="Define CONSULTS as a CLASS or DOCUMENT CLASS"
64 S LEVEL=$$READ^TIUU("S^CL:Class;DC:Document Class",TIUPRMT)
65 I $P(LEVEL,U)']"" S LEVEL="" Q
66 W !!,"Okay, you've indicated that you want to make CONSULTS a "
67 W $P(LEVEL,U,2),".",! S TIUPRMT=" Okay to continue"
68 S TIUY=$$READ^TIUU("Y",TIUPRMT,"NO")
69 I +TIUY'>0 S LEVEL=""
70 E S LEVEL=$P(LEVEL,U)
71 Q
72INDEX(DA) ; Call IX^DIK to re-index the CONSULTS entry
73 N DIK
74 S DIK="^TIU(8925.1," D IX^DIK
75 Q
76SET(TIUDA,LEVEL) ; Set the data in the new Document Definition record
77 N TIUCLP
78 S TIUCLP=$$CLPAC
79 S ^TIU(8925.1,TIUDA,0)="CONSULTS^CNST^CONSULTS^"_LEVEL_"^^"_TIUCLP_"^11"
80 S ^TIU(8925.1,TIUDA,1)="8925^1^2;TEXT"
81 S ^TIU(8925.1,TIUDA,3)="^^0"
82 S ^TIU(8925.1,TIUDA,4)="D LOOKUP^TIUPUTCN"
83 S ^TIU(8925.1,TIUDA,4.1)="D POST^TIUCNSLT(DA,""INCOMPLETE"")"
84 S ^TIU(8925.1,TIUDA,4.4)="D ROLLBACK^TIUCNSLT(TIUDA)"
85 S ^TIU(8925.1,TIUDA,4.45)="D CHANGE^TIUCNSLT(TIUDA)"
86 S ^TIU(8925.1,TIUDA,4.5)="D FOLLOWUP^TIUPUTCN(TIUREC(""#""))"
87 S ^TIU(8925.1,TIUDA,4.8)="D GETPN^TIUCHLP"
88 S ^TIU(8925.1,TIUDA,4.9)="D POST^TIUCNSLT(DA,""COMPLETED"")"
89 S ^TIU(8925.1,TIUDA,5)="[TIU ENTER/EDIT CONSULT RESULT]"
90 ; -- Don't modify PRINT METHOD if already defined --
91 I '$D(^TIU(8925.1,TIUDA,6)) S ^TIU(8925.1,TIUDA,6)="D ENTRY^TIUPRCN"
92 ; -- If not already specified initialize ALLOW CUSTOM HEADERS to O
93 I '$D(^TIU(8925.1,TIUDA,6.1)) S ^TIU(8925.1,TIUDA,6.1)="^^^0"
94 S ^TIU(8925.1,TIUDA,7)="D ENPN^TIUVSIT(.TIU,.DFN,1)"
95 S ^TIU(8925.1,TIUDA,8)="S TIUASK=$$CHEKPN^TIULD(.TIU,.TIUBY)"
96 ; -- Don't modify upload header, if already defined --
97 I '$D(^TIU(8925.1,TIUDA,"HEAD")) D
98 . S ^TIU(8925.1,TIUDA,"HEAD",0)="^8925.12A^8^8"
99 . S ^TIU(8925.1,TIUDA,"HEAD",1,0)="TITLE^TITLE OF CONSULT^.01^TIUTITLE^PULMONARY CONSULT^1^1"
100 . S ^TIU(8925.1,TIUDA,"HEAD",2,0)="SSN^PATIENT SSN^.02^TIUSSN^555-12-1234^1^1"
101 . S ^TIU(8925.1,TIUDA,"HEAD",2,1)="S X=$TR(X,""-/"","""")"
102 . S ^TIU(8925.1,TIUDA,"HEAD",3,0)="VISIT/EVENT DATE^VISIT/EVENT DATE^.07^TIUVDT^5/15/97@08:15^1^1"
103 . S ^TIU(8925.1,TIUDA,"HEAD",4,0)="AUTHOR^DICTATING PROVIDER^1202^^HOWSER,DOOGEY^1^1"
104 . S ^TIU(8925.1,TIUDA,"HEAD",5,0)="DATE/TIME OF DICTATION^DICTATION DATE/TIME^1301^TIUDDT^5/16/97@09:25^0^1"
105 . S ^TIU(8925.1,TIUDA,"HEAD",6,0)="LOCATION^PATIENT LOCATION^1205^TIULOC^MEDICAL-CONSULT 6200^1^1"
106 . S ^TIU(8925.1,TIUDA,"HEAD",7,0)="EXPECTED COSIGNER^EXPECTED COSIGNER^1208^^WELBY,MARCUS^1^0"
107 . S ^TIU(8925.1,TIUDA,"HEAD",8,0)="CONSULT REQUEST NUMBER^CONSULT REQUEST #^1405^TIUCNNBR^1455^1^1"
108 . S ^TIU(8925.1,TIUDA,"HEAD",8,1)="S X=""C.""_X"
109 Q
110ATTACH(TIUDA,TIULVL) ; Attach CONSULTS to appropriate parent
111 N DIC,DLAYGO,DIE,DR,TIULNM,TIUSEQ,X,Y
112 S TIULNM=$S(TIULVL="DC":"DOCUMENT CLASS",1:"CLASS")
113 W !!,"FANTASTIC! Your NEW ",TIULNM," CONSULTS will now be added under"
114 S DA(1)=$S(TIULVL="DC":3,1:38)
115 W !,"the ",$P(^TIU(8925.1,DA(1),0),U)," Class...",!
116 S DIC="^TIU(8925.1,"_DA(1)_",10,",DIC(0)="NXL"
117 S DIC("P")=$P(^DD(8925.1,10,0),U,2),X="`"_TIUDA
118 D ^DIC ; Create the sub-entry for CONSULTS
119 I +Y'>0 D Q
120 . W !!,$C(7),"Unable to add CONSULTS under ",$P($G(^TIU(8925.1,DA(1),0)),U)
121 . W !,"You'll have to attach it manually."
122 S DA=+Y,DIK=DIC,TIUSEQ=$P(@(DIC_"0)"),U,4) K DIC
123 S ^TIU(8925.1,DA(1),10,DA,0)=$G(^TIU(8925.1,DA(1),10,DA,0))_U_TIUSEQ_U_TIUSEQ_U_"Consults"
124 D IX^DIK ; Cross-reference new subfile entry
125 Q
126CLPAC() ; Get pointer to CLINICAL COORDINATOR User Class
127 N TIUY
128 S TIUY=$O(^USR(8930,"B","CLINICAL COORDINATOR",0))
129 Q TIUY
Note: See TracBrowser for help on using the repository browser.