VistA-WorldVistAEHR/r/TEXT_INTEGRATION_UTILITIES-.../TIUPS14.m

130 lines
6.2 KiB
Mathematica

TIUPS14 ; SLC/JER - Post-Install for TIU*1*4;Dec 05, 1997 08:30 ;2/3/98@09:52:05
;;1.0;Text Integration Utilities;**4**;Jun 20, 1997
MAIN ; Control subroutine
N TIUDA,TIULVL,TIULNM,TIUCONT,TIUFPRIV,TIUNEW
I +$L($T(GET^GMRCTIU))'>0 D Q
. W !!,$C(7),"You must install CONSULT/REQUEST TRACKING 3.0 before",!?6,"implementing this part of patch TIU*1*4."
S TIUFPRIV=1,TIUNEW=0,TIUDA=$$TEST
I +TIUDA>0 D Q:+$G(TIUCONT)'>0
. S TIULVL=$P(TIUDA,U,2)
. S TIULNM=$S(TIULVL="CL":"CLASS",1:"DOCUMENT CLASS")
. W !!,"You already have a ",TIULNM," called CONSULTS under "
. W $$CLNAME(+TIUDA),"...",!
. W !,"The new methods and properties to support the TIU/CT interface"
. W !,"will be MERGED with the existing data. UPLOAD HEADERS and"
. W !,"PRINT METHODS which you have defined will NOT be overwritten.",!
. S TIUCONT=+$$READ^TIUU("Y"," Okay to continue","NO")
. I 'TIUCONT W !!,"Great...No harm done!",!
. S TIUDA=+TIUDA
I +TIUDA'>0 D Q:+TIUDA'>0
. W !!,"I'm going to create a new Document Definition for CONSULTS now."
. S TIUDA=$$CREATE S:+TIUDA TIUNEW=1
. W:+TIUDA'>0 !!,$C(7),"Couldn't create Document Definition entry for CONSULTS...",!
D:$G(TIULVL)']"" ASK(TIUDA,.TIULVL)
I $G(TIULVL)']"" W !!,"Great...No harm done!",! Q
D SET(TIUDA,TIULVL)
D INDEX(TIUDA)
I +TIUNEW D ATTACH(TIUDA,TIULVL)
D DONE(TIULVL)
Q
DONE(TIULVL) ; Let the user know
N TIUCRLF S TIUCRLF=$C(13)_$C(10)
W !!,"Okay, I'm done...Please finish your implementation of CONSULTS by"
W " adding any",!,$S(TIULVL="CL":"Document Classes and ",1:""),"Titles"
W " as appropriate using the Create Document Definitions",$S(TIULVL="CL":TIUCRLF,1:" "),"Option",$S(TIULVL="CL":" ",1:TIUCRLF)
W "under the TIUF DOCUMENT DEFINITION MGR Menu, as described in"
W " Step #3",!,"of the Post-Installation Instructions.",!
Q
CLNAME(TIUDA) ; Get parent class's name
N TIUY
S TIUY=$P($G(^TIU(8925.1,+$$DOCCLASS^TIULC1(TIUDA),0)),U)
Q $G(TIUY)
TEST() ; Check for CONSULTS entry in Document Defintion file
N TIUY
S TIUY=+$O(^TIU(8925.1,"B","CONSULTS",0))
I +TIUY S $P(TIUY,U,2)=$P($G(^TIU(8925.1,+TIUY,0)),U,4)
Q TIUY
CREATE() ; Create a record for the CONSULTS Document Definition
N DIC,DLAYGO,X,Y
S (DIC,DLAYGO)="^TIU(8925.1,",DIC(0)="MXL",X="CONSULTS"
D ^DIC
Q +$G(Y)
ASK(TIUDA,LEVEL) ; Ascertain whether to make CONSULTS a CLASS or DC
N TIUPRMT
W !!,"GREAT! A new Document Definition has been created for CONSULTS."
W !,"Next, you need to decide whether you want CONSULTS to be set up"
W !,"as a separate CLASS (comparable to DISCHARGE SUMMARY or PROGRESS"
W !,"NOTES), or whether you want CONSULTS defined as a DOCUMENT CLASS"
W !,"under PROGRESS NOTES. The benefits of each strategy are outlined"
W !,"in the POST-INSTALLATION instructions for this patch.",!
W !,"NOTE: If you're not yet CERTAIN which strategy you want your site"
W !,"to adopt, then quit here, and get consensus first (it's easier to"
W !,"get permission than forgiveness, in this case)!",!
S TIUPRMT="Define CONSULTS as a CLASS or DOCUMENT CLASS"
S LEVEL=$$READ^TIUU("S^CL:Class;DC:Document Class",TIUPRMT)
I $P(LEVEL,U)']"" S LEVEL="" Q
W !!,"Okay, you've indicated that you want to make CONSULTS a "
W $P(LEVEL,U,2),".",! S TIUPRMT=" Okay to continue"
S TIUY=$$READ^TIUU("Y",TIUPRMT,"NO")
I +TIUY'>0 S LEVEL=""
E S LEVEL=$P(LEVEL,U)
Q
INDEX(DA) ; Call IX^DIK to re-index the CONSULTS entry
N DIK
S DIK="^TIU(8925.1," D IX^DIK
Q
SET(TIUDA,LEVEL) ; Set the data in the new Document Definition record
N TIUCLP
S TIUCLP=$$CLPAC
S ^TIU(8925.1,TIUDA,0)="CONSULTS^CNST^CONSULTS^"_LEVEL_"^^"_TIUCLP_"^11"
S ^TIU(8925.1,TIUDA,1)="8925^1^2;TEXT"
S ^TIU(8925.1,TIUDA,3)="^^0"
S ^TIU(8925.1,TIUDA,4)="D LOOKUP^TIUPUTCN"
S ^TIU(8925.1,TIUDA,4.1)="D POST^TIUCNSLT(DA,""INCOMPLETE"")"
S ^TIU(8925.1,TIUDA,4.4)="D ROLLBACK^TIUCNSLT(TIUDA)"
S ^TIU(8925.1,TIUDA,4.45)="D CHANGE^TIUCNSLT(TIUDA)"
S ^TIU(8925.1,TIUDA,4.5)="D FOLLOWUP^TIUPUTCN(TIUREC(""#""))"
S ^TIU(8925.1,TIUDA,4.8)="D GETPN^TIUCHLP"
S ^TIU(8925.1,TIUDA,4.9)="D POST^TIUCNSLT(DA,""COMPLETED"")"
S ^TIU(8925.1,TIUDA,5)="[TIU ENTER/EDIT CONSULT RESULT]"
; -- Don't modify PRINT METHOD if already defined --
I '$D(^TIU(8925.1,TIUDA,6)) S ^TIU(8925.1,TIUDA,6)="D ENTRY^TIUPRCN"
; -- If not already specified initialize ALLOW CUSTOM HEADERS to O
I '$D(^TIU(8925.1,TIUDA,6.1)) S ^TIU(8925.1,TIUDA,6.1)="^^^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
. S ^TIU(8925.1,TIUDA,"HEAD",0)="^8925.12A^8^8"
. S ^TIU(8925.1,TIUDA,"HEAD",1,0)="TITLE^TITLE OF CONSULT^.01^TIUTITLE^PULMONARY CONSULT^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/97@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^1301^TIUDDT^5/16/97@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"
Q
ATTACH(TIUDA,TIULVL) ; Attach CONSULTS to appropriate parent
N DIC,DLAYGO,DIE,DR,TIULNM,TIUSEQ,X,Y
S TIULNM=$S(TIULVL="DC":"DOCUMENT CLASS",1:"CLASS")
W !!,"FANTASTIC! Your NEW ",TIULNM," CONSULTS will now be added under"
S DA(1)=$S(TIULVL="DC":3,1:38)
W !,"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 CONSULTS
I +Y'>0 D Q
. W !!,$C(7),"Unable to add CONSULTS under ",$P($G(^TIU(8925.1,DA(1),0)),U)
. W !,"You'll have to attach it manually."
S DA=+Y,DIK=DIC,TIUSEQ=$P(@(DIC_"0)"),U,4) K DIC
S ^TIU(8925.1,DA(1),10,DA,0)=$G(^TIU(8925.1,DA(1),10,DA,0))_U_TIUSEQ_U_TIUSEQ_U_"Consults"
D IX^DIK ; Cross-reference new subfile entry
Q
CLPAC() ; Get pointer to CLINICAL COORDINATOR User Class
N TIUY
S TIUY=$O(^USR(8930,"B","CLINICAL COORDINATOR",0))
Q TIUY