Routine: ABSPOSEV

ABSPOSEV ; IHS/SD/lwj  - Point of Sale environment checker  [ 05/28/2002  10:03 AM ]

 ;;1.0;PHARMACY POINT OF SALE;**20,23,28,31,32,33,34,36,37,38,39,40,42,43,44**;JUN 21, 2001;Build 38

 ;IHS/SD/RLT - 3/22/07 - Patch 20

 ;          New environment checker.  Replaced ABSPOSEC.

 ;          Added patch 1014 check for Kernel.

 ;IHS/SD/RLT - 11/21/07 - Patch 23

 ;          Added AICD v3.51 patch 7 check.

 ; This routine is an environment checker used with the installation

 ; of patches of the Point of Sale software.

 ; It will check for the following RPMS packages, their version

 ; and patch numbers before allowing the user to continue

 ; with the installation of patch 1 for Point of Sale:

 ;    Fileman                   (DI)    v21

 ;    Kernel                    (XU)    v8.0   patch 1014

 ;    IHS Patient Dictionaries  (AUPN)  V99.1

 ;    IHS Dictionary Pointers   (AUT)   V98.1  patch 8

 ;    Outpatient Pharmacy       (PSO)   V6.0   patch 4

 ;    Pharmacy Point of Sale    (ABSP)  V1.0

 ;    Patient Registration      (AG)    V7.1   patch 1

 ;    IHS ICD/CPT LOOKUP & GRPR (AICD)  V3.51  patch 7

 ; (XPDQUIT will be set to 2 if the above mention packages are not

 ; at the require version and patch level.  2 indicates that

 ; the KIDS install will abort the installation, but will leave the

 ; ^XTMP global in place.)

CHECK ;EP - called from Kids install routine

 ; First let's make sure they have DUZ(0) defined, and greet the user

 N ABSPMSG

 S ABSPMSG=""

 I '$G(DUZ) S ABSPMSG="DUZ UNDEFINED OR 0." D SORRY(ABSPMSG,2) Q

 I '$L($G(DUZ(0))) S ABSPMSG="DUZ(0) UNDEFINED OR NULL." D SORRY(ABSPMSG,2) Q

 N ABSPERS

 S ABSPERS=$P($G(^VA(200,DUZ,0)),U)

 W !!,$$CJ^XLFSTR("Hello, "_$P(ABSPERS,",",2)_" "_$P(ABSPERS,","),IOM)

 ;IHS/OIT/SCR - 09/22/08 Patch 28 ; replaced line

 ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **26**.",IOM),!

 ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **28**.",IOM),!

 ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **30**.",IOM),!

 ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **31**.",IOM),!

 ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **32**.",IOM),!

 ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **33**.",IOM),!

 ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **34**.",IOM),!

 ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **36**.",IOM),!

 ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **37**.",IOM),!

 ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **38**.",IOM),!

 ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **39**.",IOM),!

 ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **40**.",IOM),!

 ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **42**.",IOM),!

 ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **43**.",IOM),!

 W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **44**.",IOM),!

 ; Suppress the "Disable Options..." and "Move Routines..." install questions

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

 ; check versions and patch if needed

 N ABSPSTOP

 S ABSPSTOP=0

 D VCHK("DI","21.0")          ;Fileman

 D VPCHK("XU","8.0",1014)     ;Kernel

 D VCHK("AUPN","99.1")        ;IHS Patient Dictionaries

 ;D VCHK("AUT","98.1")         ;IHS Dictionary Pointers   ;IHS/OIT/CNI/SCR 042810 patch 39 replaced with line below

 D VPCHK("AUT","98.1",23)         ;IHS Dictionary Pointers   aut_9810.23k

 ;D SVPCHK("PSO","6.0",3)      ;Outpatient Pharmacy

 D VCHK("ABSP","1.0")         ;Pharmacy Point of Sale

 ;D VPCHK("AG","7.1",1)        ;Patient Registration ;IHS/OIT/SCR 09/22/08 Patch 28: replaced line below

 ;D VPCHK("AG","7.1",2)        ;Patient Registration

 D VPCHK("AG","7.1",10)        ;Patient Registration ;OIT/CAS/RCS 07052012 - Patch 44 Update to latest A/R - HEAT #75114

 D VPCHK("AICD","3.51",7)     ;IHS ICD/CPT LOOKUP & GRPR

 D VPCHK("APSP","7.0",1008)      ;IHS PHARMACY MODIFICATIONS ;IHS/OIT/SCR 011210 PATCH 36

 ;IHS/OIT/SCR 09/23/08 PATCH 28 START CHANGES

 ;I ($$VERSION^XPDUTL("ABM")="2.5") D ;IHS/OIT/CNI/SCR 042810 Patch 39: replaced with 2 lines below

 ;D VCHK("ABM","2.6")

 I ($$VERSION^XPDUTL("ABM")="2.6") D

 .;D VPCHK("ABM","2.5",15)

 .D VPCHK("ABM","2.6",1)

 ;IHS Third Party Billing

 ;I $$VERSION^XPDUTL("BAR") '= "" D VCHK("BAR","1.8")     -- IHS Accounts Receivable

 ;IHS/OIT/SCR 09/23/08 PATCH 28 END CHANGES

 W !!

 I ABSPSTOP=1 D  Q

 . S ABSPMSG="You cannot continue, your environment does NOT meet all requirements."

 . D SORRY(ABSPMSG,2)

VCHK(ABSPPRE,ABSPVER)         ; Check version only

 N ABSPV

 S ABSPV=$$VERSION^XPDUTL(ABSPPRE)

 W !,"Required ",ABSPPRE," V",ABSPVER,?29

 W "...  Present ",ABSPPRE," V",ABSPV

 I ABSPV<ABSPVER D  Q

 . S ABSPSTOP=1

 . W ?65,"*** ERROR ***"

 W ?65,"OK"

VPCHK(ABSPPRE,ABSPVER,ABSPPTCH) ; Check version and patch

 N ABSPV,ABSPP,ABSPIEN,ABSPPKG,ABSPLAST

 S ABSPV=$$VERSION^XPDUTL(ABSPPRE)

 S ABSPP=$$PATCH^XPDUTL(ABSPPRE_"*"_ABSPVER_"*"_ABSPPTCH)

 S ABSPIEN=$O(^DIC(9.4,"C",ABSPPRE,""))

 S ABSPPKG=$P($G(^DIC(9.4,ABSPIEN,0)),U)

 S ABSPLAST=$P($$LAST(ABSPPKG),U)

 W !,"Required ",ABSPPRE," V",ABSPVER," Patch ",ABSPPTCH,?29

 W "...  Present ",ABSPPRE," V",ABSPV," Patch ",ABSPLAST

 I ABSPV<ABSPVER!(ABSPP'=1) D  Q

 . S ABSPSTOP=1

 . W ?65,"*** ERROR  ***"

 W ?65,"OK"

SVPCHK(ABSPPRE,ABSPVER,ABSPPTCH) ;Special version and patch check for PSO

 N ABSPV,ABSPP,ABSPIEN,ABSPPKG,ABSPLAST

 S ABSPV=$$VERSION^XPDUTL(ABSPPRE)

 S ABSPP=$$PATCH^XPDUTL(ABSPPRE_"*"_ABSPVER_"*"_ABSPPTCH)

 I ABSPVER'>"6.0"&(ABSPPTCH'>3) D

 . S X="APSQUTL" X ^%ZOSF("TEST")        ;check for Patch 3

 . S:$T ABSPP=1                          ;found Patch 3

 S ABSPIEN=$O(^DIC(9.4,"C",ABSPPRE,""))

 S ABSPPKG=$P($G(^DIC(9.4,ABSPIEN,0)),U)

 S ABSPLAST=$P($$LAST(ABSPPKG),U)

 W !,"Required ",ABSPPRE," V",ABSPVER," Patch ",ABSPPTCH,?29

 W "...  Present ",ABSPPRE," V",ABSPV," Patch ",ABSPLAST

 ;(current version < required version) or

 ;       (required patch not found  and  last patch < required patch)

 I ABSPV<ABSPVER!((ABSPP'=1)&(ABSPLAST<ABSPPTCH)) D  Q

 . S ABSPSTOP=1

 . W ?65,"*** ERROR  ***"

 W ?65,"OK"

LAST(PKG,VER) ;returns last patch applied for a Package, PATCH^DATE

 ;        Patch includes Seq # if Released

 N PKGIEN,VERIEN,LATEST,PATCH,SUBIEN,PATCHDT

 I $G(VER)="" S VER=$$VERSION^XPDUTL(PKG) Q:'VER -1

 S PKGIEN=$O(^DIC(9.4,"B",PKG,"")) Q:'PKGIEN -1

 S VERIEN=$O(^DIC(9.4,PKGIEN,22,"B",VER,"")) Q:'VERIEN -1

 S LATEST=-1,PATCH=-1,SUBIEN=0

 F  S SUBIEN=$O(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN)) Q:SUBIEN'>0  D

 . S PATCHDT=$P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)

 . S PATCHNO=$P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U)

 . I PATCHDT=LATEST&(PATCHNO>PATCH) D

 .. S LATEST=PATCHDT,PATCH=PATCHNO

 . I PATCHDT>LATEST D

 .. S LATEST=PATCHDT,PATCH=PATCHNO

 Q PATCH_U_LATEST

SORRY(ABSPMSG,ABSPQUIT)      ; let the user know we didn't have what we needed

 N ABSPV

 K DIFQ

 S XPDQUIT=$G(ABSPQUIT)

 W !,$$CJ^XLFSTR($G(ABSPMSG),IOM)

 W *7,!,$$CJ^XLFSTR("Sorry.....",IOM)

 Q:$D(ZTQUEUED)

 S ABSPV=$$DIR^XBDIR("E","Press RETURN")

ABSPOSEV  ; IHS/SD/lwj  - Point of Sale environment checker  [ 05/28/2002  10:03 AM ]

 +1       ;;1.0;PHARMACY POINT OF SALE;**20,23,28,31,32,33,34,36,37,38,39,40,42,43,44**;JUN 21, 2001;Build 38

 +2       ;

 +3       ;IHS/SD/RLT - 3/22/07 - Patch 20

 +4       ;          New environment checker.  Replaced ABSPOSEC.

 +5       ;          Added patch 1014 check for Kernel.

 +6       ;

 +7       ;IHS/SD/RLT - 11/21/07 - Patch 23

 +8       ;          Added AICD v3.51 patch 7 check.

 +9       ;

 +10      ; This routine is an environment checker used with the installation

 +11      ; of patches of the Point of Sale software.

 +12      ; It will check for the following RPMS packages, their version

 +13      ; and patch numbers before allowing the user to continue

 +14      ; with the installation of patch 1 for Point of Sale:

 +15      ;

 +16      ;    Fileman                   (DI)    v21

 +17      ;    Kernel                    (XU)    v8.0   patch 1014

 +18      ;    IHS Patient Dictionaries  (AUPN)  V99.1

 +19      ;    IHS Dictionary Pointers   (AUT)   V98.1  patch 8

 +20      ;    Outpatient Pharmacy       (PSO)   V6.0   patch 4

 +21      ;    Pharmacy Point of Sale    (ABSP)  V1.0

 +22      ;    Patient Registration      (AG)    V7.1   patch 1

 +23      ;    IHS ICD/CPT LOOKUP & GRPR (AICD)  V3.51  patch 7

 +24      ;

 +25      ; (XPDQUIT will be set to 2 if the above mention packages are not

 +26      ; at the require version and patch level.  2 indicates that

 +27      ; the KIDS install will abort the installation, but will leave the

 +28      ; ^XTMP global in place.)

 +29      ;

 +30      ;

CHECK     ;EP - called from Kids install routine

 +1       ; First let's make sure they have DUZ(0) defined, and greet the user

 +2       ;

 +3        NEW ABSPMSG

 +4        SET ABSPMSG=""

 +5        IF '$GET(DUZ)

               SET ABSPMSG="DUZ UNDEFINED OR 0."

               DO SORRY(ABSPMSG,2)

               QUIT

 +6        IF '$LENGTH($GET(DUZ(0)))

               SET ABSPMSG="DUZ(0) UNDEFINED OR NULL."

               DO SORRY(ABSPMSG,2)

               QUIT

 +7       ;

 +8        NEW ABSPERS

 +9        SET ABSPERS=$PIECE($GET(^VA(200,DUZ,0)),U)

 +10       WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(ABSPERS,",",2)_" "_$PIECE(ABSPERS,","),IOM)

 +11      ;IHS/OIT/SCR - 09/22/08 Patch 28 ; replaced line

 +12      ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **26**.",IOM),!

 +13      ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **28**.",IOM),!

 +14      ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **30**.",IOM),!

 +15      ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **31**.",IOM),!

 +16      ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **32**.",IOM),!

 +17      ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **33**.",IOM),!

 +18      ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **34**.",IOM),!

 +19      ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **36**.",IOM),!

 +20      ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **37**.",IOM),!

 +21      ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **38**.",IOM),!

 +22      ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **39**.",IOM),!

 +23      ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **40**.",IOM),!

 +24      ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **42**.",IOM),!

 +25      ;W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_"  Ver: "_$P($T(+2),";",3)_"  Patch: **43**.",IOM),!

 +26       WRITE !!,$$CJ^XLFSTR("Checking Environment for "_$PIECE($TEXT(+2),";",4)_"  Ver: "_$PIECE($TEXT(+2),";",3)_"  Patch: **44**.",IOM),!

 +27      ;

 +28      ; Suppress the "Disable Options..." and "Move Routines..." install questions

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

 +30      ;

 +31      ; check versions and patch if needed

 +32      ;

 +33       NEW ABSPSTOP

 +34       SET ABSPSTOP=0

 +35      ;Fileman

           DO VCHK("DI","21.0")

 +36      ;Kernel

           DO VPCHK("XU","8.0",1014)

 +37      ;IHS Patient Dictionaries

           DO VCHK("AUPN","99.1")

 +38      ;D VCHK("AUT","98.1")         ;IHS Dictionary Pointers   ;IHS/OIT/CNI/SCR 042810 patch 39 replaced with line below

 +39      ;IHS Dictionary Pointers   aut_9810.23k

           DO VPCHK("AUT","98.1",23)

 +40      ;D SVPCHK("PSO","6.0",3)      ;Outpatient Pharmacy

 +41      ;Pharmacy Point of Sale

           DO VCHK("ABSP","1.0")

 +42      ;D VPCHK("AG","7.1",1)        ;Patient Registration ;IHS/OIT/SCR 09/22/08 Patch 28: replaced line below

 +43      ;D VPCHK("AG","7.1",2)        ;Patient Registration

 +44      ;Patient Registration ;OIT/CAS/RCS 07052012 - Patch 44 Update to latest A/R - HEAT #75114

           DO VPCHK("AG","7.1",10)

 +45      ;IHS ICD/CPT LOOKUP & GRPR

           DO VPCHK("AICD","3.51",7)

 +46      ;IHS PHARMACY MODIFICATIONS ;IHS/OIT/SCR 011210 PATCH 36

           DO VPCHK("APSP","7.0",1008)

 +47      ;IHS/OIT/SCR 09/23/08 PATCH 28 START CHANGES

 +48      ;I ($$VERSION^XPDUTL("ABM")="2.5") D ;IHS/OIT/CNI/SCR 042810 Patch 39: replaced with 2 lines below

 +49      ;D VCHK("ABM","2.6")

 +50       IF ($$VERSION^XPDUTL("ABM")="2.6")

               Begin DoDot:1

 +51      ;D VPCHK("ABM","2.5",15)

 +52               DO VPCHK("ABM","2.6",1)

               End DoDot:1

 +53      ;IHS Third Party Billing

 +54      ;I $$VERSION^XPDUTL("BAR") '= "" D VCHK("BAR","1.8")     -- IHS Accounts Receivable

 +55      ;IHS/OIT/SCR 09/23/08 PATCH 28 END CHANGES

 +56       WRITE !!

 +57       IF ABSPSTOP=1

               Begin DoDot:1

 +58               SET ABSPMSG="You cannot continue, your environment does NOT meet all requirements."

 +59               DO SORRY(ABSPMSG,2)

               End DoDot:1

               QUIT

 +60       QUIT

 +61      ;

VCHK(ABSPPRE,ABSPVER) ; Check version only

 +1       ;

 +2        NEW ABSPV

 +3        SET ABSPV=$$VERSION^XPDUTL(ABSPPRE)

 +4        WRITE !,"Required ",ABSPPRE," V",ABSPVER,?29

 +5        WRITE "...  Present ",ABSPPRE," V",ABSPV

 +6        IF ABSPV<ABSPVER

               Begin DoDot:1

 +7                SET ABSPSTOP=1

 +8                WRITE ?65,"*** ERROR ***"

               End DoDot:1

               QUIT

 +9        WRITE ?65,"OK"

 +10       QUIT

 +11      ;

VPCHK(ABSPPRE,ABSPVER,ABSPPTCH) ; Check version and patch

 +1       ;

 +2        NEW ABSPV,ABSPP,ABSPIEN,ABSPPKG,ABSPLAST

 +3        SET ABSPV=$$VERSION^XPDUTL(ABSPPRE)

 +4        SET ABSPP=$$PATCH^XPDUTL(ABSPPRE_"*"_ABSPVER_"*"_ABSPPTCH)

 +5        SET ABSPIEN=$ORDER(^DIC(9.4,"C",ABSPPRE,""))

 +6        SET ABSPPKG=$PIECE($GET(^DIC(9.4,ABSPIEN,0)),U)

 +7        SET ABSPLAST=$PIECE($$LAST(ABSPPKG),U)

 +8        WRITE !,"Required ",ABSPPRE," V",ABSPVER," Patch ",ABSPPTCH,?29

 +9        WRITE "...  Present ",ABSPPRE," V",ABSPV," Patch ",ABSPLAST

 +10       IF ABSPV<ABSPVER!(ABSPP'=1)

               Begin DoDot:1

 +11               SET ABSPSTOP=1

 +12               WRITE ?65,"*** ERROR  ***"

               End DoDot:1

               QUIT

 +13       WRITE ?65,"OK"

 +14       QUIT

 +15      ;

SVPCHK(ABSPPRE,ABSPVER,ABSPPTCH) ;Special version and patch check for PSO

 +1       ;

 +2        NEW ABSPV,ABSPP,ABSPIEN,ABSPPKG,ABSPLAST

 +3        SET ABSPV=$$VERSION^XPDUTL(ABSPPRE)

 +4        SET ABSPP=$$PATCH^XPDUTL(ABSPPRE_"*"_ABSPVER_"*"_ABSPPTCH)

 +5        IF ABSPVER'>"6.0"&(ABSPPTCH'>3)

               Begin DoDot:1

 +6       ;check for Patch 3

                   SET X="APSQUTL"

                   XECUTE ^%ZOSF("TEST")

 +7       ;found Patch 3

                   IF $TEST

                       SET ABSPP=1

               End DoDot:1

 +8        SET ABSPIEN=$ORDER(^DIC(9.4,"C",ABSPPRE,""))

 +9        SET ABSPPKG=$PIECE($GET(^DIC(9.4,ABSPIEN,0)),U)

 +10       SET ABSPLAST=$PIECE($$LAST(ABSPPKG),U)

 +11       WRITE !,"Required ",ABSPPRE," V",ABSPVER," Patch ",ABSPPTCH,?29

 +12       WRITE "...  Present ",ABSPPRE," V",ABSPV," Patch ",ABSPLAST

 +13      ;(current version < required version) or

 +14      ;       (required patch not found  and  last patch < required patch)

 +15       IF ABSPV<ABSPVER!((ABSPP'=1)&(ABSPLAST<ABSPPTCH))

               Begin DoDot:1

 +16               SET ABSPSTOP=1

 +17               WRITE ?65,"*** ERROR  ***"

               End DoDot:1

               QUIT

 +18       WRITE ?65,"OK"

 +19       QUIT

 +20      ;

LAST(PKG,VER) ;returns last patch applied for a Package, PATCH^DATE

 +1       ;        Patch includes Seq # if Released

 +2        NEW PKGIEN,VERIEN,LATEST,PATCH,SUBIEN,PATCHDT

 +3        IF $GET(VER)=""

               SET VER=$$VERSION^XPDUTL(PKG)

               IF 'VER

                   QUIT -1

 +4        SET PKGIEN=$ORDER(^DIC(9.4,"B",PKG,""))

           IF 'PKGIEN

               QUIT -1

 +5        SET VERIEN=$ORDER(^DIC(9.4,PKGIEN,22,"B",VER,""))

           IF 'VERIEN

               QUIT -1

 +6        SET LATEST=-1

           SET PATCH=-1

           SET SUBIEN=0

 +7        FOR

               SET SUBIEN=$ORDER(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN))

               IF SUBIEN'>0

                   QUIT

               Begin DoDot:1

 +8                SET PATCHDT=$PIECE(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)

 +9                SET PATCHNO=$PIECE(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U)

 +10               IF PATCHDT=LATEST&(PATCHNO>PATCH)

                       Begin DoDot:2

 +11                       SET LATEST=PATCHDT

                           SET PATCH=PATCHNO

                       End DoDot:2

 +12               IF PATCHDT>LATEST

                       Begin DoDot:2

 +13                       SET LATEST=PATCHDT

                           SET PATCH=PATCHNO

                       End DoDot:2

               End DoDot:1

 +14       QUIT PATCH_U_LATEST

 +15      ;

SORRY(ABSPMSG,ABSPQUIT) ; let the user know we didn't have what we needed

 +1       ;

 +2        NEW ABSPV

 +3        KILL DIFQ

 +4        SET XPDQUIT=$GET(ABSPQUIT)

 +5        WRITE !,$$CJ^XLFSTR($GET(ABSPMSG),IOM)

 +6        WRITE *7,!,$$CJ^XLFSTR("Sorry.....",IOM)

 +7        IF $DATA(ZTQUEUED)

               QUIT

 +8        SET ABSPV=$$DIR^XBDIR("E","Press RETURN")

 +9        QUIT

ABSPOSEV.m