BTIUP13.m

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      ;