BTIUP13 ; IHS/CIA/MGH - ENV CHECK FOR PATCH 1013;24-Mar-2015 15:19;DU
;;1.0;TEXT INTEGRATION UTILITIES;**1013**;SEPT 04, 2005;Build 33
;
ENV ;EP environment check
N PATCH,IN,STAT,INSTDA
S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
;
S PATCH="TIU*1.0*1012"
I '$$PATCH(PATCH) D Q
. W !,"You must first install "_PATCH_"." S XPDABORT=1
S PATCH="BJPC*2.0*10"
I '$$PATCH(PATCH) D Q
. W !,"You must first install "_PATCH_"." S XPDABORT=1
S PATCH="ATX*5.1*11"
I '$$PATCH(PATCH) D Q
. W !,"You must first install "_PATCH_"." S XPDABORT=1
Q
PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnnn
;copy of code from XPDUTL but modified to handle 4 digit IHS patch numbers
Q:X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N 0
NEW NUM,I,J
S I=$O(^DIC(9.4,"C",$P(X,"*"),0)) Q:'I 0
S J=$O(^DIC(9.4,I,22,"B",$P(X,"*",2),0)),X=$P(X,"*",3) Q:'J 0
;check if patch is just a number
Q:$O(^DIC(9.4,I,22,J,"PAH","B",X,0)) 1
S NUM=$O(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
Q (X=+NUM)
;
PRE ;EP; beginning of pret install code
Q
POST ;EP; beginning of post install code
N DTOUT,DUOUT,TIU,TIUFPRIV,TIUIEN,TIUMSG,TIUPRNT,TIUTMP S TIUFPRIV=1
I $$LOOKUP(8930,"CLINICAL COORDINATOR","X")<0 W !!,"Installation Error: CLASS OWNER cannot be defined." S XPDABORT=1 G EXIT
I $$LOOKUP(8925.1,"RESCINDED ADVANCE DIRECTIVE","X")>0 W !!,"RESCINDED ADVANCE DIRECTIVE already exists." G EXIT
F D Q:TIUPRNT>0!($D(XPDABORT))
. W ! S TIUPRNT=$$LOOKUP(8925.1,,"AEQ","I $P(^(0),U,4)=""DC""","Select TIU DOCUMENT CLASS name for the new title RESCINDED ADVANCE DIRECTIVE: ")
. I $D(DTOUT) W !!,"Installation Aborted due to TIMEOUT." S XPDABORT=1 Q
. I $D(DUOUT) W !!,"Installation Aborted by USER." S XPDABORT=1 Q
. I TIUPRNT<0 W !!,"Installation Error: Invalid Selection",!
. I W !,"A DOCUMENT CLASS must be entered or '^' to abort." Q
. W ! I '$$READ^TIUU("Y","Is this correct","YES") S TIUPRNT=0
I +$G(TIUPRNT)'>0 G EXIT
S TIU(8925.1,"+1,",.01)="RESCINDED ADVANCE DIRECTIVE"
S TIU(8925.1,"+1,",.02)=""
S TIU(8925.1,"+1,",.03)="RESCINDED ADVANCE DIRECTIVE"
S TIU(8925.1,"+1,",.04)="DOC"
S TIU(8925.1,"+1,",.05)=""
S TIU(8925.1,"+1,",.06)=$$LOOKUP(8930,"CLINICAL COORDINATOR")
S TIU(8925.1,"+1,",.07)=13
S TIU(8925.1,"+1,",3.02)=1
S TIU(8925.1,"+1,",99)=$H
W !!,"Creating RESCINDED ADVANCE DIRECTIVE title..."
D UPDATE^DIE("","TIU","TIUIEN","TIUMSG")
I $D(TIUMSG) D S XPDABORT=1 G EXIT
. W !!,"The following error message was returned:",!
. S TIUMSG="" F S TIUMSG=$O(TIUMSG("DIERR",1,"TEXT",TIUMSG)) Q:TIUMSG="" W !,TIUMSG("DIERR",1,"TEXT",TIUMSG)
W "DONE."
S TIU(8925.14,"+2,"_TIUPRNT_",",.01)=TIUIEN(1)
S TIU(8925.14,"+2,"_TIUPRNT_",",4)="Recinded Advance Directive"
W !!,"Adding "_$P(^TIU(8925.1,TIUPRNT,0),U)_" as parent..."
D UPDATE^DIE("","TIU","TIUIEN","TIUMSG")
I $D(TIUMSG) D S XPDABORT=1 G EXIT
. W !!,"The following error message was returned:",!
. S TIUMSG="" F S TIUMSG=$O(TIUMSG("DIERR",1,"TEXT",TIUMSG)) Q:TIUMSG="" W !,TIUMSG("DIERR",1,"TEXT",TIUMSG)
W "DONE.",!
S TIUIEN(TIUIEN(1))=TIUIEN(1)
S TIU(8925.1,TIUIEN(1)_",",3)="TIUTMP"
I $D(TIUMSG) D S XPDABORT=1 G EXIT
. W !!,"The following error message was returned:",!
. S TIUMSG="" F S TIUMSG=$O(TIUMSG("DIERR",1,"TEXT",TIUMSG)) Q:TIUMSG="" W !,TIUMSG("DIERR",1,"TEXT",TIUMSG)
W "DONE.",!
W !,"*** The RESCINDED ADVANCE DIRECTIVE***"
W !,"*** title must be activated before use. ***"
EXIT D
.N DIR,X,Y S DIR(0)="E" W ! D ^DIR
Q
REM ;
N TIUTMP
S TIUTMP=$$LOOKUP(8925.1,"RESCINDED ADVANCE DIRECTIVE")
I TIUTMP>0 S $P(^TIU(8925.1,TIUTMP,0),U,13)=0
Q
LOOKUP(FILE,NAME,TYPE,SCREEN,PROMPT) ;
; file = file # to perform lookup on
; [name] = for instance lookups - required if type is missing
; [type] = for inquiries to file (eg: "AEQ") - required if name is missing
; [screen] = screen for lookup/inquiries
; [prompt] = replace default prompt
;
N DIC,X,Y S DIC=$G(FILE),DIC("S")=$G(SCREEN),X=$G(NAME)
I $D(TYPE) S DIC(0)=TYPE
I $D(PROMPT) S DIC("A")=PROMPT
D ^DIC
Q +Y
Q
;
BTIUP13 ; IHS/CIA/MGH - ENV CHECK FOR PATCH 1013;24-Mar-2015 15:19;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1013**;SEPT 04, 2005;Build 33
+2 ;
ENV ;EP environment check
+1 NEW PATCH,IN,STAT,INSTDA
+2 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+3 ;
+4 SET PATCH="TIU*1.0*1012"
+5 IF '$$PATCH(PATCH)
Begin DoDot:1
+6 WRITE !,"You must first install "_PATCH_"."
SET XPDABORT=1
End DoDot:1
QUIT
+7 SET PATCH="BJPC*2.0*10"
+8 IF '$$PATCH(PATCH)
Begin DoDot:1
+9 WRITE !,"You must first install "_PATCH_"."
SET XPDABORT=1
End DoDot:1
QUIT
+10 SET PATCH="ATX*5.1*11"
+11 IF '$$PATCH(PATCH)
Begin DoDot:1
+12 WRITE !,"You must first install "_PATCH_"."
SET XPDABORT=1
End DoDot:1
QUIT
+13 QUIT
PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnnn
+1 ;copy of code from XPDUTL but modified to handle 4 digit IHS patch numbers
+2 IF X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N
QUIT 0
+3 NEW NUM,I,J
+4 SET I=$ORDER(^DIC(9.4,"C",$PIECE(X,"*"),0))
IF 'I
QUIT 0
+5 SET J=$ORDER(^DIC(9.4,I,22,"B",$PIECE(X,"*",2),0))
SET X=$PIECE(X,"*",3)
IF 'J
QUIT 0
+6 ;check if patch is just a number
+7 IF $ORDER(^DIC(9.4,I,22,J,"PAH","B",X,0))
QUIT 1
+8 SET NUM=$ORDER(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
+9 QUIT (X=+NUM)
+10 ;
PRE ;EP; beginning of pret install code
+1 QUIT
POST ;EP; beginning of post install code
+1 NEW DTOUT,DUOUT,TIU,TIUFPRIV,TIUIEN,TIUMSG,TIUPRNT,TIUTMP
SET TIUFPRIV=1
+2 IF $$LOOKUP(8930,"CLINICAL COORDINATOR","X")<0
WRITE !!,"Installation Error: CLASS OWNER cannot be defined."
SET XPDABORT=1
GOTO EXIT
+3 IF $$LOOKUP(8925.1,"RESCINDED ADVANCE DIRECTIVE","X")>0
WRITE !!,"RESCINDED ADVANCE DIRECTIVE already exists."
GOTO EXIT
+4 FOR
Begin DoDot:1
+5 WRITE !
SET TIUPRNT=$$LOOKUP(8925.1,,"AEQ","I $P(^(0),U,4)=""DC""","Select TIU DOCUMENT CLASS name for the new title RESCINDED ADVANCE DIRECTIVE: ")
+6 IF $DATA(DTOUT)
WRITE !!,"Installation Aborted due to TIMEOUT."
SET XPDABORT=1
QUIT
+7 IF $DATA(DUOUT)
WRITE !!,"Installation Aborted by USER."
SET XPDABORT=1
QUIT
+8 IF TIUPRNT<0
WRITE !!,"Installation Error: Invalid Selection",!
+9 IF $TEST
WRITE !,"A DOCUMENT CLASS must be entered or '^' to abort."
QUIT
+10 WRITE !
IF '$$READ^TIUU("Y","Is this correct","YES")
SET TIUPRNT=0
End DoDot:1
IF TIUPRNT>0!($DATA(XPDABORT))
QUIT
+11 IF +$GET(TIUPRNT)'>0
GOTO EXIT
+12 SET TIU(8925.1,"+1,",.01)="RESCINDED ADVANCE DIRECTIVE"
+13 SET TIU(8925.1,"+1,",.02)=""
+14 SET TIU(8925.1,"+1,",.03)="RESCINDED ADVANCE DIRECTIVE"
+15 SET TIU(8925.1,"+1,",.04)="DOC"
+16 SET TIU(8925.1,"+1,",.05)=""
+17 SET TIU(8925.1,"+1,",.06)=$$LOOKUP(8930,"CLINICAL COORDINATOR")
+18 SET TIU(8925.1,"+1,",.07)=13
+19 SET TIU(8925.1,"+1,",3.02)=1
+20 SET TIU(8925.1,"+1,",99)=$HOROLOG
+21 WRITE !!,"Creating RESCINDED ADVANCE DIRECTIVE title..."
+22 DO UPDATE^DIE("","TIU","TIUIEN","TIUMSG")
+23 IF $DATA(TIUMSG)
Begin DoDot:1
+24 WRITE !!,"The following error message was returned:",!
+25 SET TIUMSG=""
FOR
SET TIUMSG=$ORDER(TIUMSG("DIERR",1,"TEXT",TIUMSG))
IF TIUMSG=""
QUIT
WRITE !,TIUMSG("DIERR",1,"TEXT",TIUMSG)
End DoDot:1
SET XPDABORT=1
GOTO EXIT
+26 WRITE "DONE."
+27 SET TIU(8925.14,"+2,"_TIUPRNT_",",.01)=TIUIEN(1)
+28 SET TIU(8925.14,"+2,"_TIUPRNT_",",4)="Recinded Advance Directive"
+29 WRITE !!,"Adding "_$PIECE(^TIU(8925.1,TIUPRNT,0),U)_" as parent..."
+30 DO UPDATE^DIE("","TIU","TIUIEN","TIUMSG")
+31 IF $DATA(TIUMSG)
Begin DoDot:1
+32 WRITE !!,"The following error message was returned:",!
+33 SET TIUMSG=""
FOR
SET TIUMSG=$ORDER(TIUMSG("DIERR",1,"TEXT",TIUMSG))
IF TIUMSG=""
QUIT
WRITE !,TIUMSG("DIERR",1,"TEXT",TIUMSG)
End DoDot:1
SET XPDABORT=1
GOTO EXIT
+34 WRITE "DONE.",!
+35 SET TIUIEN(TIUIEN(1))=TIUIEN(1)
+36 SET TIU(8925.1,TIUIEN(1)_",",3)="TIUTMP"
+37 IF $DATA(TIUMSG)
Begin DoDot:1
+38 WRITE !!,"The following error message was returned:",!
+39 SET TIUMSG=""
FOR
SET TIUMSG=$ORDER(TIUMSG("DIERR",1,"TEXT",TIUMSG))
IF TIUMSG=""
QUIT
WRITE !,TIUMSG("DIERR",1,"TEXT",TIUMSG)
End DoDot:1
SET XPDABORT=1
GOTO EXIT
+40 WRITE "DONE.",!
+41 WRITE !,"*** The RESCINDED ADVANCE DIRECTIVE***"
+42 WRITE !,"*** title must be activated before use. ***"
EXIT Begin DoDot:1
+1 NEW DIR,X,Y
SET DIR(0)="E"
WRITE !
DO ^DIR
End DoDot:1
+2 QUIT
REM ;
+1 NEW TIUTMP
+2 SET TIUTMP=$$LOOKUP(8925.1,"RESCINDED ADVANCE DIRECTIVE")
+3 IF TIUTMP>0
SET $PIECE(^TIU(8925.1,TIUTMP,0),U,13)=0
+4 QUIT
LOOKUP(FILE,NAME,TYPE,SCREEN,PROMPT) ;
+1 ; file = file # to perform lookup on
+2 ; [name] = for instance lookups - required if type is missing
+3 ; [type] = for inquiries to file (eg: "AEQ") - required if name is missing
+4 ; [screen] = screen for lookup/inquiries
+5 ; [prompt] = replace default prompt
+6 ;
+7 NEW DIC,X,Y
SET DIC=$GET(FILE)
SET DIC("S")=$GET(SCREEN)
SET X=$GET(NAME)
+8 IF $DATA(TYPE)
SET DIC(0)=TYPE
+9 IF $DATA(PROMPT)
SET DIC("A")=PROMPT
+10 DO ^DIC
+11 QUIT +Y
+12 QUIT
+13 ;
