BTIUP3.m

BTIUP3 ; IHS/CIA/MGH - POST INSTALL FOR PATCH 1003;03-Jan-2006 11:22;MGH

 ;;1.0;TEXT INTEGRATION UTILITIES;**1003**;SEPT 04, 2005

 ;

ENV ;EP environment check

 N PATCH

 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0

 ;

 S PATCH="TIU*1.0*1002"

 I '$$PATCH(PATCH) D  Q

 . W !,"You must first install "_PATCH_"." S XPDQUIT=2

 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 pre install code

CLEAN ; Delete the BTIU OBJECT DESCRIPTION file

 NEW DIU

 S DIU=9003130.1,DIU(0)="DT"

 D EN^DIU2

 Q

 ;

POST ;EP; beginning of post install code

 D DOCDEF

 Q

 ;

 ;

DOCDEF ; clean up any dangling pointers in Document Definition file

 NEW DOC,ITEM,PTR,SEQ,TEXT

 S DOC=0 F  S DOC=$O(^TIU(8925.1,DOC)) Q:'DOC  D

 . Q:'$O(^TIU(8925.1,DOC,10,0))    ;no items

 . S ITEM=0

 . F  S ITEM=$O(^TIU(8925.1,DOC,10,ITEM)) Q:'ITEM  D

 . . S PTR=$P(^TIU(8925.1,DOC,10,ITEM,0),U)     ;item pointer

 . . Q:$D(^TIU(8925.1,PTR,0))                   ;skip if good pointer

 . . S SEQ=$P(^TIU(8925.1,DOC,10,ITEM,0),U,3)   ;sequence

 . . S TEXT=$P(^TIU(8925.1,DOC,10,ITEM,0),U,4)  ;menu text

 . . ;

 . . ; kill cross-references and main item entry

 . . K ^TIU(8925.1,DOC,10,"B",PTR,ITEM)

 . . I SEQ]"" K ^TIU(8925.1,DOC,10,"AC",SEQ,ITEM)

 . . I TEXT]"" K ^TIU(8925.1,DOC,10,"C",TEXT,ITEM)

 . . K ^TIU(8925.1,DOC,10,ITEM)

 Q

BTIUP3    ; IHS/CIA/MGH - POST INSTALL FOR PATCH 1003;03-Jan-2006 11:22;MGH

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**1003**;SEPT 04, 2005

 +2       ;

ENV       ;EP environment check

 +1        NEW PATCH

 +2        SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0

 +3       ;

 +4        SET PATCH="TIU*1.0*1002"

 +5        IF '$$PATCH(PATCH)

               Begin DoDot:1

 +6                WRITE !,"You must first install "_PATCH_"."

                   SET XPDQUIT=2

               End DoDot:1

               QUIT 

 +7        QUIT 

 +8       ;

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 pre install code

CLEAN     ; Delete the BTIU OBJECT DESCRIPTION file

 +1        NEW DIU

 +2        SET DIU=9003130.1

           SET DIU(0)="DT"

 +3        DO EN^DIU2

 +4        QUIT 

 +5       ;

POST      ;EP; beginning of post install code

 +1        DO DOCDEF

 +2        QUIT 

 +3       ;

 +4       ;

DOCDEF    ; clean up any dangling pointers in Document Definition file

 +1        NEW DOC,ITEM,PTR,SEQ,TEXT

 +2        SET DOC=0

           FOR 

               SET DOC=$ORDER(^TIU(8925.1,DOC))

               IF 'DOC

                   QUIT 

               Begin DoDot:1

 +3       ;no items

                   IF '$ORDER(^TIU(8925.1,DOC,10,0))

                       QUIT 

 +4                SET ITEM=0

 +5                FOR 

                       SET ITEM=$ORDER(^TIU(8925.1,DOC,10,ITEM))

                       IF 'ITEM

                           QUIT 

                       Begin DoDot:2

 +6       ;item pointer

                           SET PTR=$PIECE(^TIU(8925.1,DOC,10,ITEM,0),U)

 +7       ;skip if good pointer

                           IF $DATA(^TIU(8925.1,PTR,0))

                               QUIT 

 +8       ;sequence

                           SET SEQ=$PIECE(^TIU(8925.1,DOC,10,ITEM,0),U,3)

 +9       ;menu text

                           SET TEXT=$PIECE(^TIU(8925.1,DOC,10,ITEM,0),U,4)

 +10      ;

 +11      ; kill cross-references and main item entry

 +12                       KILL ^TIU(8925.1,DOC,10,"B",PTR,ITEM)

 +13                       IF SEQ]""

                               KILL ^TIU(8925.1,DOC,10,"AC",SEQ,ITEM)

 +14                       IF TEXT]""

                               KILL ^TIU(8925.1,DOC,10,"C",TEXT,ITEM)

 +15                       KILL ^TIU(8925.1,DOC,10,ITEM)

                       End DoDot:2

               End DoDot:1

 +16       QUIT