Routine: XUP285R

XUP285R ;IHS/OIT/FBD - REPAIR MISSING RECORD FOR PATCH XU*8.0*285; May 20, 2011

 ;;8.0;KERNEL;**1017**;May 20, 2011;Build 3

 N PKG,VERSION,PATCH,RTN,INSTDATE

 D INIT

 D MAIN

 D CLEANUP

INIT ;PRIMARY MODULE INITIALIZATION

 S U="^"

 S PKG="XU"       ;PACKAGE NAMESPACE

 S VERSION="8.0"  ;PACKAGE VERSION

 S PATCH="285"    ;SPECIFIC PATCH NUMBER

 S RTN="XQALFWD"  ;ROUTINE TO TEST FOR PATCH PRESENCE

 S INSTDATE=$O(^XPD(9.7,"B","XOBS 1.5",0)),INSTDATE=$P(^XPD(9.7,INSTDATE,0),U,3)  ;INSTALL DATE OF XOBS 1.5 PATCH WILL BE USED FOR THIS PATCH RECORD

MAIN ;PRIMARY MODULE EXECUTION

 ;CHECK IF PATCH IS ALREADY RECORDED IN PATCH APPLICATON HISTORY

 I '+$O(^DIC(9.4,"C",PKG,0)) D MES^XPDUTL(PKG_" not found in PACKAGE file; aborting.") Q

 S PKG=$O(^DIC(9.4,"C",PKG,0))

 I '+$O(^DIC(9.4,PKG,22,"B",VERSION,0)) D MES^XPDUTL("Version "_VERSION_" not found in PACKAGE file entry for "_PKG_"; aborting.") Q

 S VERSION=$O(^DIC(9.4,PKG,22,"B",VERSION,0))

 I +$O(^DIC(9.4,PKG,22,VERSION,"PAH","B",PATCH,0)) D MES^XPDUTL("Patch "_PATCH_" already recorded in PACKAGE file entry for "_PKG_" v."_VERSION_" .") Q

 ;OK, THE PATCH IS VERIFIED AS NOT LOGGED - SO LOG IT IF IT IS PRESENT

 I $$PPRESENT(RTN,PATCH) D LOGPATCH

PPRESENT(RTN,PATCH) ;DETERMINE IF A PATCH IS DOCUMENTED IN A SPECIFIC ROUTINE

 N PRESENT,PPDL,SPDL

 N PTR        ;POINTER FOR INCREMENTAL PATCH SCAN

 S PPDL="**"  ;PRIMARY PATCH DELIMITER

 S SPDL=","   ;SECONDARY PATCH DELIMITER

 S PRESENT=0  ;PATCH PRESENCE FLAG

 S %="S %=$T(+2^"_RTN_")" X %  ;PULL THE VERSION LINE FROM THE ROUTINE

 S %=$P(%,PPDL,2)    ;AND EXTRACT THE PATCH LIST

 I $L(%,SPDL)>1 D    ;IF MORE THAN ONE,

 .F PTR=1:1:$L(%,SPDL) D

 ..S:$P(%,SPDL,PTR)=PATCH PRESENT=1

 .E  S:%=PATCH PRESENT=1

 Q PRESENT

LOGPATCH ;CREATE AN ENTRY IN THE PACKAGE FILE (#9.4) FOR A GIVEN VERSION/PATCH

 N DIC,DA

 N D0  ;JUST MAKING SURE THIS VARIABLE DOESN'T EXIST

 S DA(1)=VERSION,DA(2)=PKG

 S DIC="^DIC(9.4,"_DA(2)_",22,"_DA(1)_",""PAH"","

 S DIC(0)="LZ"

 S X=PATCH

 S DIC("DR")=".02///"_INSTDATE_";.03///`"_DUZ

 D FILE^DICN

 I +Y>1 D MES^XPDUTL("Patch #"_PATCH_" entry added - multiple IEN "_+Y_".")

CLEANUP ;PRIMARY MODULE CLOSEOUT

XUP285R   ;IHS/OIT/FBD - REPAIR MISSING RECORD FOR PATCH XU*8.0*285; May 20, 2011

 +1       ;;8.0;KERNEL;**1017**;May 20, 2011;Build 3

 +2       ;

 +3        NEW PKG,VERSION,PATCH,RTN,INSTDATE

 +4        DO INIT

 +5        DO MAIN

 +6        DO CLEANUP

 +7        QUIT

 +8       ;

INIT      ;PRIMARY MODULE INITIALIZATION

 +1        SET U="^"

 +2       ;PACKAGE NAMESPACE

           SET PKG="XU"

 +3       ;PACKAGE VERSION

           SET VERSION="8.0"

 +4       ;SPECIFIC PATCH NUMBER

           SET PATCH="285"

 +5       ;ROUTINE TO TEST FOR PATCH PRESENCE

           SET RTN="XQALFWD"

 +6       ;INSTALL DATE OF XOBS 1.5 PATCH WILL BE USED FOR THIS PATCH RECORD

           SET INSTDATE=$ORDER(^XPD(9.7,"B","XOBS 1.5",0))

           SET INSTDATE=$PIECE(^XPD(9.7,INSTDATE,0),U,3)

 +7        QUIT

 +8       ;

MAIN      ;PRIMARY MODULE EXECUTION

 +1       ;

 +2       ;CHECK IF PATCH IS ALREADY RECORDED IN PATCH APPLICATON HISTORY

 +3       ;

 +4        IF '+$ORDER(^DIC(9.4,"C",PKG,0))

               DO MES^XPDUTL(PKG_" not found in PACKAGE file; aborting.")

               QUIT

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

 +6        IF '+$ORDER(^DIC(9.4,PKG,22,"B",VERSION,0))

               DO MES^XPDUTL("Version "_VERSION_" not found in PACKAGE file entry for "_PKG_"; aborting.")

               QUIT

 +7        SET VERSION=$ORDER(^DIC(9.4,PKG,22,"B",VERSION,0))

 +8        IF +$ORDER(^DIC(9.4,PKG,22,VERSION,"PAH","B",PATCH,0))

               DO MES^XPDUTL("Patch "_PATCH_" already recorded in PACKAGE file entry for "_PKG_" v."_VERSION_" .")

               QUIT

 +9       ;

 +10      ;OK, THE PATCH IS VERIFIED AS NOT LOGGED - SO LOG IT IF IT IS PRESENT

 +11      ;

 +12       IF $$PPRESENT(RTN,PATCH)

               DO LOGPATCH

 +13       QUIT

 +14      ;

PPRESENT(RTN,PATCH) ;DETERMINE IF A PATCH IS DOCUMENTED IN A SPECIFIC ROUTINE

 +1        NEW PRESENT,PPDL,SPDL

 +2       ;POINTER FOR INCREMENTAL PATCH SCAN

           NEW PTR

 +3       ;PRIMARY PATCH DELIMITER

           SET PPDL="**"

 +4       ;SECONDARY PATCH DELIMITER

           SET SPDL=","

 +5       ;PATCH PRESENCE FLAG

           SET PRESENT=0

 +6       ;

 +7       ;PULL THE VERSION LINE FROM THE ROUTINE

           SET %="S %=$T(+2^"_RTN_")"

           XECUTE %

 +8       ;AND EXTRACT THE PATCH LIST

           SET %=$PIECE(%,PPDL,2)

 +9       ;IF MORE THAN ONE,

           IF $LENGTH(%,SPDL)>1

               Begin DoDot:1

 +10               FOR PTR=1:1:$LENGTH(%,SPDL)

                       Begin DoDot:2

 +11                       IF $PIECE(%,SPDL,PTR)=PATCH

                               SET PRESENT=1

                       End DoDot:2

 +12              IF '$TEST

                       IF %=PATCH

                           SET PRESENT=1

               End DoDot:1

 +13       QUIT PRESENT

 +14      ;

LOGPATCH  ;CREATE AN ENTRY IN THE PACKAGE FILE (#9.4) FOR A GIVEN VERSION/PATCH

 +1        NEW DIC,DA

 +2       ;JUST MAKING SURE THIS VARIABLE DOESN'T EXIST

           NEW D0

 +3        SET DA(1)=VERSION

           SET DA(2)=PKG

 +4        SET DIC="^DIC(9.4,"_DA(2)_",22,"_DA(1)_",""PAH"","

 +5        SET DIC(0)="LZ"

 +6        SET X=PATCH

 +7        SET DIC("DR")=".02///"_INSTDATE_";.03///`"_DUZ

 +8        DO FILE^DICN

 +9        IF +Y>1

               DO MES^XPDUTL("Patch #"_PATCH_" entry added - multiple IEN "_+Y_".")

 +10       QUIT

 +11      ;

CLEANUP   ;PRIMARY MODULE CLOSEOUT

 +1        QUIT

XUP285R.m