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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPS14 6527 printed Apr 09, 2024@21:41:17 Page 2
TIUPS14 ; SLC/JER - Post-Install for TIU*1*4;Dec 05, 1997 08:30 ;2/3/98@09:52:05
+1 ;;1.0;Text Integration Utilities;**4**;Jun 20, 1997
MAIN ; Control subroutine
+1 NEW TIUDA,TIULVL,TIULNM,TIUCONT,TIUFPRIV,TIUNEW
+2 IF +$LENGTH($TEXT(GET^GMRCTIU))'>0
Begin DoDot:1
+3 WRITE !!,$CHAR(7),"You must install CONSULT/REQUEST TRACKING 3.0 before",!?6,"implementing this part of patch TIU*1*4."
End DoDot:1
QUIT
+4 SET TIUFPRIV=1
SET TIUNEW=0
SET TIUDA=$$TEST
+5 IF +TIUDA>0
Begin DoDot:1
+6 SET TIULVL=$PIECE(TIUDA,U,2)
+7 SET TIULNM=$SELECT(TIULVL="CL":"CLASS",1:"DOCUMENT CLASS")
+8 WRITE !!,"You already have a ",TIULNM," called CONSULTS under "
+9 WRITE $$CLNAME(+TIUDA),"...",!
+10 WRITE !,"The new methods and properties to support the TIU/CT interface"
+11 WRITE !,"will be MERGED with the existing data. UPLOAD HEADERS and"
+12 WRITE !,"PRINT METHODS which you have defined will NOT be overwritten.",!
+13 SET TIUCONT=+$$READ^TIUU("Y"," Okay to continue","NO")
+14 IF 'TIUCONT
WRITE !!,"Great...No harm done!",!
+15 SET TIUDA=+TIUDA
End DoDot:1
if +$GET(TIUCONT)'>0
QUIT
+16 IF +TIUDA'>0
Begin DoDot:1
+17 WRITE !!,"I'm going to create a new Document Definition for CONSULTS now."
+18 SET TIUDA=$$CREATE
if +TIUDA
SET TIUNEW=1
+19 if +TIUDA'>0
WRITE !!,$CHAR(7),"Couldn't create Document Definition entry for CONSULTS...",!
End DoDot:1
if +TIUDA'>0
QUIT
+20 if $GET(TIULVL)']""
DO ASK(TIUDA,.TIULVL)
+21 IF $GET(TIULVL)']""
WRITE !!,"Great...No harm done!",!
QUIT
+22 DO SET(TIUDA,TIULVL)
+23 DO INDEX(TIUDA)
+24 IF +TIUNEW
DO ATTACH(TIUDA,TIULVL)
+25 DO DONE(TIULVL)
+26 QUIT
DONE(TIULVL) ; Let the user know
+1 NEW TIUCRLF
SET TIUCRLF=$CHAR(13)_$CHAR(10)
+2 WRITE !!,"Okay, I'm done...Please finish your implementation of CONSULTS by"
+3 WRITE " adding any",!,$SELECT(TIULVL="CL":"Document Classes and ",1:""),"Titles"
+4 WRITE " as appropriate using the Create Document Definitions",$SELECT(TIULVL="CL":TIUCRLF,1:" "),"Option",$SELECT(TIULVL="CL":" ",1:TIUCRLF)
+5 WRITE "under the TIUF DOCUMENT DEFINITION MGR Menu, as described in"
+6 WRITE " Step #3",!,"of the Post-Installation Instructions.",!
+7 QUIT
CLNAME(TIUDA) ; Get parent class's name
+1 NEW TIUY
+2 SET TIUY=$PIECE($GET(^TIU(8925.1,+$$DOCCLASS^TIULC1(TIUDA),0)),U)
+3 QUIT $GET(TIUY)
TEST() ; Check for CONSULTS entry in Document Defintion file
+1 NEW TIUY
+2 SET TIUY=+$ORDER(^TIU(8925.1,"B","CONSULTS",0))
+3 IF +TIUY
SET $PIECE(TIUY,U,2)=$PIECE($GET(^TIU(8925.1,+TIUY,0)),U,4)
+4 QUIT TIUY
CREATE() ; Create a record for the CONSULTS Document Definition
+1 NEW DIC,DLAYGO,X,Y
+2 SET (DIC,DLAYGO)="^TIU(8925.1,"
SET DIC(0)="MXL"
SET X="CONSULTS"
+3 DO ^DIC
+4 QUIT +$GET(Y)
ASK(TIUDA,LEVEL) ; Ascertain whether to make CONSULTS a CLASS or DC
+1 NEW TIUPRMT
+2 WRITE !!,"GREAT! A new Document Definition has been created for CONSULTS."
+3 WRITE !,"Next, you need to decide whether you want CONSULTS to be set up"
+4 WRITE !,"as a separate CLASS (comparable to DISCHARGE SUMMARY or PROGRESS"
+5 WRITE !,"NOTES), or whether you want CONSULTS defined as a DOCUMENT CLASS"
+6 WRITE !,"under PROGRESS NOTES. The benefits of each strategy are outlined"
+7 WRITE !,"in the POST-INSTALLATION instructions for this patch.",!
+8 WRITE !,"NOTE: If you're not yet CERTAIN which strategy you want your site"
+9 WRITE !,"to adopt, then quit here, and get consensus first (it's easier to"
+10 WRITE !,"get permission than forgiveness, in this case)!",!
+11 SET TIUPRMT="Define CONSULTS as a CLASS or DOCUMENT CLASS"
+12 SET LEVEL=$$READ^TIUU("S^CL:Class;DC:Document Class",TIUPRMT)
+13 IF $PIECE(LEVEL,U)']""
SET LEVEL=""
QUIT
+14 WRITE !!,"Okay, you've indicated that you want to make CONSULTS a "
+15 WRITE $PIECE(LEVEL,U,2),".",!
SET TIUPRMT=" Okay to continue"
+16 SET TIUY=$$READ^TIUU("Y",TIUPRMT,"NO")
+17 IF +TIUY'>0
SET LEVEL=""
+18 IF '$TEST
SET LEVEL=$PIECE(LEVEL,U)
+19 QUIT
INDEX(DA) ; Call IX^DIK to re-index the CONSULTS entry
+1 NEW DIK
+2 SET DIK="^TIU(8925.1,"
DO IX^DIK
+3 QUIT
SET(TIUDA,LEVEL) ; Set the data in the new Document Definition record
+1 NEW TIUCLP
+2 SET TIUCLP=$$CLPAC
+3 SET ^TIU(8925.1,TIUDA,0)="CONSULTS^CNST^CONSULTS^"_LEVEL_"^^"_TIUCLP_"^11"
+4 SET ^TIU(8925.1,TIUDA,1)="8925^1^2;TEXT"
+5 SET ^TIU(8925.1,TIUDA,3)="^^0"
+6 SET ^TIU(8925.1,TIUDA,4)="D LOOKUP^TIUPUTCN"
+7 SET ^TIU(8925.1,TIUDA,4.1)="D POST^TIUCNSLT(DA,""INCOMPLETE"")"
+8 SET ^TIU(8925.1,TIUDA,4.4)="D ROLLBACK^TIUCNSLT(TIUDA)"
+9 SET ^TIU(8925.1,TIUDA,4.45)="D CHANGE^TIUCNSLT(TIUDA)"
+10 SET ^TIU(8925.1,TIUDA,4.5)="D FOLLOWUP^TIUPUTCN(TIUREC(""#""))"
+11 SET ^TIU(8925.1,TIUDA,4.8)="D GETPN^TIUCHLP"
+12 SET ^TIU(8925.1,TIUDA,4.9)="D POST^TIUCNSLT(DA,""COMPLETED"")"
+13 SET ^TIU(8925.1,TIUDA,5)="[TIU ENTER/EDIT CONSULT RESULT]"
+14 ; -- Don't modify PRINT METHOD if already defined --
+15 IF '$DATA(^TIU(8925.1,TIUDA,6))
SET ^TIU(8925.1,TIUDA,6)="D ENTRY^TIUPRCN"
+16 ; -- If not already specified initialize ALLOW CUSTOM HEADERS to O
+17 IF '$DATA(^TIU(8925.1,TIUDA,6.1))
SET ^TIU(8925.1,TIUDA,6.1)="^^^0"
+18 SET ^TIU(8925.1,TIUDA,7)="D ENPN^TIUVSIT(.TIU,.DFN,1)"
+19 SET ^TIU(8925.1,TIUDA,8)="S TIUASK=$$CHEKPN^TIULD(.TIU,.TIUBY)"
+20 ; -- Don't modify upload header, if already defined --
+21 IF '$DATA(^TIU(8925.1,TIUDA,"HEAD"))
Begin DoDot:1
+22 SET ^TIU(8925.1,TIUDA,"HEAD",0)="^8925.12A^8^8"
+23 SET ^TIU(8925.1,TIUDA,"HEAD",1,0)="TITLE^TITLE OF CONSULT^.01^TIUTITLE^PULMONARY CONSULT^1^1"
+24 SET ^TIU(8925.1,TIUDA,"HEAD",2,0)="SSN^PATIENT SSN^.02^TIUSSN^555-12-1234^1^1"
+25 SET ^TIU(8925.1,TIUDA,"HEAD",2,1)="S X=$TR(X,""-/"","""")"
+26 SET ^TIU(8925.1,TIUDA,"HEAD",3,0)="VISIT/EVENT DATE^VISIT/EVENT DATE^.07^TIUVDT^5/15/97@08:15^1^1"
+27 SET ^TIU(8925.1,TIUDA,"HEAD",4,0)="AUTHOR^DICTATING PROVIDER^1202^^HOWSER,DOOGEY^1^1"
+28 SET ^TIU(8925.1,TIUDA,"HEAD",5,0)="DATE/TIME OF DICTATION^DICTATION DATE/TIME^1301^TIUDDT^5/16/97@09:25^0^1"
+29 SET ^TIU(8925.1,TIUDA,"HEAD",6,0)="LOCATION^PATIENT LOCATION^1205^TIULOC^MEDICAL-CONSULT 6200^1^1"
+30 SET ^TIU(8925.1,TIUDA,"HEAD",7,0)="EXPECTED COSIGNER^EXPECTED COSIGNER^1208^^WELBY,MARCUS^1^0"
+31 SET ^TIU(8925.1,TIUDA,"HEAD",8,0)="CONSULT REQUEST NUMBER^CONSULT REQUEST #^1405^TIUCNNBR^1455^1^1"
+32 SET ^TIU(8925.1,TIUDA,"HEAD",8,1)="S X=""C.""_X"
End DoDot:1
+33 QUIT
ATTACH(TIUDA,TIULVL) ; Attach CONSULTS to appropriate parent
+1 NEW DIC,DLAYGO,DIE,DR,TIULNM,TIUSEQ,X,Y
+2 SET TIULNM=$SELECT(TIULVL="DC":"DOCUMENT CLASS",1:"CLASS")
+3 WRITE !!,"FANTASTIC! Your NEW ",TIULNM," CONSULTS will now be added under"
+4 SET DA(1)=$SELECT(TIULVL="DC":3,1:38)
+5 WRITE !,"the ",$PIECE(^TIU(8925.1,DA(1),0),U)," Class...",!
+6 SET DIC="^TIU(8925.1,"_DA(1)_",10,"
SET DIC(0)="NXL"
+7 SET DIC("P")=$PIECE(^DD(8925.1,10,0),U,2)
SET X="`"_TIUDA
+8 ; Create the sub-entry for CONSULTS
DO ^DIC
+9 IF +Y'>0
Begin DoDot:1
+10 WRITE !!,$CHAR(7),"Unable to add CONSULTS under ",$PIECE($GET(^TIU(8925.1,DA(1),0)),U)
+11 WRITE !,"You'll have to attach it manually."
End DoDot:1
QUIT
+12 SET DA=+Y
SET DIK=DIC
SET TIUSEQ=$PIECE(@(DIC_"0)"),U,4)
KILL DIC
+13 SET ^TIU(8925.1,DA(1),10,DA,0)=$GET(^TIU(8925.1,DA(1),10,DA,0))_U_TIUSEQ_U_TIUSEQ_U_"Consults"
+14 ; Cross-reference new subfile entry
DO IX^DIK
+15 QUIT
CLPAC() ; Get pointer to CLINICAL COORDINATOR User Class
+1 NEW TIUY
+2 SET TIUY=$ORDER(^USR(8930,"B","CLINICAL COORDINATOR",0))
+3 QUIT TIUY
