Routine: BTIUPOS2

BTIUPOS2 ; IHS/ITSC/LJF - More IHS post initialization actions ;

 ;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004

PROTCL ;EP;  fix entries in protocols previously sent

 NEW DIE,DA,DR,X,Y

 S DIE="^ORD(101,"

 ; fix screen for Make Addendum protocol

 S DA=$O(^ORD(101,"B","TIU ACTION MAKE ADDENDUM",0)) Q:'DA

 S DR="24///I $D(^XUSEC(""TIUZCLIN2"",+$G(DUZ)))" D ^DIE

PATCHES ;EP mark package file entry with patch #s required by OE/RR

 D BMES^XPDUTL("Adding older patches to patch history . . .")

 NEW PKG,VER,COUNT,PATCH,DA,DIC,X,Y

 S PKG=$O(^DIC(9.4,"C","TIU",0)) Q:'PKG

 S VER=$O(^DIC(9.4,PKG,22,"B","1.0",0)) I 'VER D ADD(PKG) Q:VER<1

 F COUNT=1:1 S PATCH=$P($T(PATCH+COUNT),";;",2) Q:PATCH=""  D

 . I $D(^DIC(9.4,PKG,22,VER,"PAH","B",PATCH)) Q   ;already in file

 . S DIC="^DIC(9.4,"_PKG_",22,"_VER_",""PAH"","

 . S DA(2)=PKG,DA(1)=VER,DIC(0)="L"

 . S DIC("P")=$P(^DD(9.49,1105,0),U,2)

 . S X=PATCH,DIC("DR")=".02///"_DT_";.03///`"_DUZ

 . D ^DIC

ADD(IEN) ; add version to Package file

 NEW DIC,X,Y,DA

 S DIC="^DIC(9.4,"_IEN_",22,",DIC(0)="L",X="1.0"

 S DIC("P")=$P(^DD(9.4,22,0),U,2)

 S DIC("DR")="2///"_DT_";3///`"_DUZ,DA(1)=IEN

 D ^DIC S VER=+Y

PATCH ;;

 ;;1 SEQ #4;;IMAGING 3.0

 ;;3 SEQ #5;; Other TIU patches

 ;;4 SEQ #8;;GMRC*3*4

 ;;7 SEQ #9;;OR*3*10

 ;;15 SEQ #10;;OR*3*2/OR*3*10

 ;;19 SEQ #19;;GMRC*3*4/OR*3*10

 ;;28 SEQ #22;;OR*3*10

 ;;31 SEQ #34;;GMRC*3*4

 ;;47 SEQ #60;;OR*3*10/IMAGING 3.0

 ;;76 SEQ #70;;OR*3*10

 ;;63 SEQ #76;;IMAGING 3.0

 ;;80 SEQ #82;;OR*3*10

 ;;102 SEQ #86;;OR*3*10

 ;;89 SEQ #90;;OR*3*10

 ;;108 SEQ #99;;OR*3*85

 ;;100 SEQ #103;;OR*3*109

 ;;105 SEQ #106;;OR*3*85

 ;;119 SEQ #109;;OR*3*109

 ;;125 SEQ #113;;OR*3*109

 ;;127 SEQ #118;;OR*3*116

 ;;122 SEQ #119;;OR*3*116

 ;;109 SEQ #123;;Clinical Procedures

 ;;124 SEQ #124;;OR*3*148/OR*3*141

 ;;138 SEQ #125;;OR*3*148

 ;;150 SEQ #142;;OR*3*153

 ;;135 SEQ #144;;TIU*1.0*170

BTIUPOS2  ; IHS/ITSC/LJF - More IHS post initialization actions ;

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004

 +2       ;

 +3        QUIT

PROTCL    ;EP;  fix entries in protocols previously sent

 +1        NEW DIE,DA,DR,X,Y

 +2        SET DIE="^ORD(101,"

 +3       ; fix screen for Make Addendum protocol

 +4        SET DA=$ORDER(^ORD(101,"B","TIU ACTION MAKE ADDENDUM",0))

           IF 'DA

               QUIT

 +5        SET DR="24///I $D(^XUSEC(""TIUZCLIN2"",+$G(DUZ)))"

           DO ^DIE

 +6        QUIT

 +7       ;

PATCHES   ;EP mark package file entry with patch #s required by OE/RR

 +1        DO BMES^XPDUTL("Adding older patches to patch history . . .")

 +2        NEW PKG,VER,COUNT,PATCH,DA,DIC,X,Y

 +3        SET PKG=$ORDER(^DIC(9.4,"C","TIU",0))

           IF 'PKG

               QUIT

 +4        SET VER=$ORDER(^DIC(9.4,PKG,22,"B","1.0",0))

           IF 'VER

               DO ADD(PKG)

               IF VER<1

                   QUIT

 +5        FOR COUNT=1:1

               SET PATCH=$PIECE($TEXT(PATCH+COUNT),";;",2)

               IF PATCH=""

                   QUIT

               Begin DoDot:1

 +6       ;already in file

                   IF $DATA(^DIC(9.4,PKG,22,VER,"PAH","B",PATCH))

                       QUIT

 +7                SET DIC="^DIC(9.4,"_PKG_",22,"_VER_",""PAH"","

 +8                SET DA(2)=PKG

                   SET DA(1)=VER

                   SET DIC(0)="L"

 +9                SET DIC("P")=$PIECE(^DD(9.49,1105,0),U,2)

 +10               SET X=PATCH

                   SET DIC("DR")=".02///"_DT_";.03///`"_DUZ

 +11               DO ^DIC

               End DoDot:1

 +12       QUIT

 +13      ;

ADD(IEN)  ; add version to Package file

 +1        NEW DIC,X,Y,DA

 +2        SET DIC="^DIC(9.4,"_IEN_",22,"

           SET DIC(0)="L"

           SET X="1.0"

 +3        SET DIC("P")=$PIECE(^DD(9.4,22,0),U,2)

 +4        SET DIC("DR")="2///"_DT_";3///`"_DUZ

           SET DA(1)=IEN

 +5        DO ^DIC

           SET VER=+Y

 +6        QUIT

 +7       ;

PATCH     ;;

 +1       ;;1 SEQ #4;;IMAGING 3.0

 +2       ;;3 SEQ #5;; Other TIU patches

 +3       ;;4 SEQ #8;;GMRC*3*4

 +4       ;;7 SEQ #9;;OR*3*10

 +5       ;;15 SEQ #10;;OR*3*2/OR*3*10

 +6       ;;19 SEQ #19;;GMRC*3*4/OR*3*10

 +7       ;;28 SEQ #22;;OR*3*10

 +8       ;;31 SEQ #34;;GMRC*3*4

 +9       ;;47 SEQ #60;;OR*3*10/IMAGING 3.0

 +10      ;;76 SEQ #70;;OR*3*10

 +11      ;;63 SEQ #76;;IMAGING 3.0

 +12      ;;80 SEQ #82;;OR*3*10

 +13      ;;102 SEQ #86;;OR*3*10

 +14      ;;89 SEQ #90;;OR*3*10

 +15      ;;108 SEQ #99;;OR*3*85

 +16      ;;100 SEQ #103;;OR*3*109

 +17      ;;105 SEQ #106;;OR*3*85

 +18      ;;119 SEQ #109;;OR*3*109

 +19      ;;125 SEQ #113;;OR*3*109

 +20      ;;127 SEQ #118;;OR*3*116

 +21      ;;122 SEQ #119;;OR*3*116

 +22      ;;109 SEQ #123;;Clinical Procedures

 +23      ;;124 SEQ #124;;OR*3*148/OR*3*141

 +24      ;;138 SEQ #125;;OR*3*148

 +25      ;;150 SEQ #142;;OR*3*153

 +26      ;;135 SEQ #144;;TIU*1.0*170

BTIUPOS2.m