ABMENVCK ;IHS/SD/SDR - ENVIRONMENT CHECKER ;
;;2.6;IHS Third Party Billing;**1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27**;NOV 12, 2009;Build 486
;IHS/SD/SDR 2.6*14 updated checker to look for patches after 8 (meaning 9 thru 13)
;IHS/SD/SDR 2.6*16 Updated patches for patch 16
;IHS/SD/SDR 2.6*17 Updated to check for patch 16
;IHS/SD/SDR 2.6*18 Check for patch 17
;IHS/SD/SDR 2.6*19 Check for patch 18
;IHS/SD/SDR 2.6*20 Check for patch 19
;IHS/SD/SDR 2.6*21 Check for patch 20
;IHS/SD/SDR 2.6*22 Check for patch 21
;IHS/SD/SDR 2.6*24 check for patches 22 and 23
;IHS/SD/SDR 2.6*26 check for p25, aupn*99.1*26
;IHS/SD/SDR 2.6*27 check for p26; fixed so messages write for all checks; BSCV only wrote a message if it was missing. Now more in line
; with notes file
;
;
I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q
;
I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q
;
S X=$P(^VA(200,DUZ,0),U)
W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_" Patch "_$P($T(+2),";",5)_".",IOM),!
;
S XPDQUIT=0
;
I '$$VCHK("DI","22.0",2) S XPDQUIT=2 ;abm*2.6*2
;start old abm*2.6*27 IHS/SD/SDR SAC findings
;;AUM*9.1*4 needed for new clinic code mapping
;S X=$$PATCH^XPDUTL("AUM*9.1*4") ;abm*2.6*4
;I X'=1 W !,$$CJ^XLFSTR("AUM v9.1 Patch 4 NOT INSTALLED",IOM) S XPDQUIT=2 ;abm*2.6*4
;I X=1 W !,$$CJ^XLFSTR("AUM v9.1 Patch 4 installed.",IOM) ;abm*2.6*4
;end old abm*2.6*27 IHS/SD/SDR SAC findings
I '$$VCHK("AUM","10.1",2) S XPDQUIT=2 ;abm*2.6*2
;
;start new abm*2.6*26 IHS/SD/SDR CR9264
K X
S X=$$PATCH^XPDUTL("AUPN*99.1*26")
I X'=1 W !,$$CJ^XLFSTR("AUPN v99.1 Patch 26 NOT INSTALLED",IOM) S XPDQUIT=2
I X=1 W !,$$CJ^XLFSTR("AUPN v99.1 Patch 26 installed.",IOM)
;end new abm*2.6*26 IHS/SD/SDR CR9264
;
I '$$VCHK("ABM","2.6",2) S XPDQUIT=2 ;abm*2.6*1
;start old code abm*2.6*7
;;start new code abm*2.6*2
;K X
;S X=$$PATCH^XPDUTL("ABM*2.6*4")
;I X'=1 W !,$$CJ^XLFSTR("ABM v2.6 Patch 4 NOT INSTALLED",IOM) S XPDQUIT=2
;I X=1 W !,$$CJ^XLFSTR("ABM v2.6 Patch 4 installed.",IOM)
;;end new code abm*2.6*2
;end old code start new code abm*2.6*7
N X,ABM,I
S ABM=1
;F I=1:1:6 D ;abm*2.6*9
;F I=1:1:8 D ;abm*2.6*9 ;ABM*2.6*14
;F I=1:1:13 D ;abm*2.6*14 ;abm*2.6*15
;F I=1:1:14 D ;abm*2.6*14 ;abm*2.6*15 ;abm*2.6*17
;F I=1:1:16 D ;abm*2.6*17 ;abm*2.6*18
;F I=1:1:18 D ;abm*2.6*17 ;abm*2.6*19
;F I=1:1:19 D ;abm*2.6*17 ;abm*2.6*18 ;abm*2.6*21
;F I=1:1:20 D ;abm*2.6*21 IHS/SD/SDR ;abm*2.6*22 IHS/SD/SDR
;F I=1:1:21 D ;abm*2.6*21 IHS/SD/SDR ;abm*2.6*22 IHS/SD/SDR ;abm*2.6*24 IHS/SD/SDR
;F I=1:1:23 D ;abm*2.6*24 IHS/SD/SDR ;abm*2.6*25 IHS/SD/SDR
;F I=1:1:24 D ;abm*2.6*25 IHS/SD/SDR ;abm*2.6*26 IHS/SD/SDR
;F I=1:1:25 D ;abm*2.6*26 IHS/SD/SDR ;abm*2.6*27 IHS/SD/SDR
F I=1:1:26 D ;abm*2.6*27 IHS/SD/SDR
.S X=$$PATCH^XPDUTL("ABM*2.6*"_I)
.I X'=1 S ABM=0 W !,$$CJ^XLFSTR("Need Third Party Billing v2.6 Patch "_I_"..... "_$S(ABM=0:"NOT ",1:"")_"Present",IOM)
I ABM=0 S XPDQUIT=2
;end new code abm*2.6*7
;
I '$$VCHK("AUT","98.1",2) S XPDQUIT=2
;
S X=$$LAST^ABMENVCK("IHS DICTIONARIES (POINTERS)","98.1")
I $P(X,U,1)'=14&($P(X,U,1)'>14) W !,$$CJ^XLFSTR("AUT v98.1 Patch 14 NOT INSTALLED",IOM) S XPDQUIT=2
;
I '$$VCHK("XU","8.0",2) S XPDQUIT=2
K X
S X=$$PATCH^XPDUTL("XU*8.0*1013")
I X'=1 W !,$$CJ^XLFSTR("KERNEL v8.0 Patch 1013 NOT INSTALLED",IOM) S XPDQUIT=2
;I X=1 W !,$$CJ^XLFSTR("XU Patch 1013 installed.",IOM) ;abm*2.6*27 IHS/SD/SDR SAC findings
K X
S X=$$PATCH^XPDUTL("XU*8.0*1014")
I X'=1 W !,$$CJ^XLFSTR("KERNEL v8.0 Patch 1014 NOT INSTALLED",IOM) S XPDQUIT=2
;I X=1 W !,$$CJ^XLFSTR("XU Patch 1014 installed.",IOM) ;abm*2.6*27 IHS/SD/SDR SAC findings
;
;start new code abm*2.6*10
N X,ABM,I
S ABM=1
F I=1:1:3 D
.S X=$$PATCH^XPDUTL("BCSV*1.0*"_I)
.;I X'=1 S ABM=0 W !,$$CJ^XLFSTR("Need BCSV IHS Code Set Versioning v1.0 Patch "_I_"..... "_$S(ABM=0:"NOT ",1:"")_"Present",IOM) ;abm*2.6*27 IHS/SD/SDR SAC findings
.I X'=1 S ABM=0 ;abm*2.6*27 IHS/SD/SDR SAC findings
.W !,$$CJ^XLFSTR("Need BCSV IHS Code Set Versioning v1.0 Patch "_I_"..... "_$S(ABM=0:"NOT ",1:"")_"Present",IOM) ;abm*2.6*27 IHS/SD/SDR SAC findings
I ABM=0 S XPDQUIT=2
;end new code abm*2.6*10
;
NEW DA,DIC
S X="ABM",DIC="^DIC(9.4,",DIC(0)="",D="C"
D IX^DIC
I Y<0,$D(^DIC(9.4,"C","ABM")) D S XPDQUIT=2
.W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""ABM"" prefix.",IOM)
.W !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
.W !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
.Q
;
I $G(XPDENV)=1 D
.; The following line prevents the "Disable Options..." and "Move
.; Routines..." questions from being asked during the install.
.S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
.D OPTSAV("ABMMENU")
.Q
;
I XPDQUIT D SORRY(XPDQUIT) Q
;
W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
;
I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2) Q
Q
;
SORRY(X) ;
KILL DIFQ
S XPDQUIT=X
W:'$D(ZTQUEUED) *7,!,$$CJ^XLFSTR("Sorry....",IOM),$$DIR^XBDIR("E","Press RETURN")
Q
;
VCHK(ABMPRE,ABMVER,ABMQUIT) ; Check versions needed.
;
NEW ABMV
S ABMV=$$VERSION^XPDUTL(ABMPRE)
W !,$$CJ^XLFSTR("Need at least "_ABMPRE_" v "_ABMVER_"....."_ABMPRE_" v "_ABMV_" Present",IOM)
I ABMV<ABMVER W *7,!,$$CJ^XLFSTR("^^^^**NEEDS FIXED**^^^^",IOM) Q 0
Q 1
;
OPTSAV(ABMM) ;
D BMES^XPDUTL("Saving the configuration of option '"_ABMM_"'...")
I $D(^XTMP("ABMENVCK",7.2,"OPTSAV",ABMM)) D BMES^XPDUTL("NOT SAVED. Option '"_ABMM_"' has previously been saved.") Q
I '$D(^XTMP("ABMENVCK")) S ^XTMP("ABMENVCK",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"ABMENVCK - SAVE OPTION CONFIGURATIONS."
NEW I,A
S I=$O(^DIC(19,"B",ABMM,0))
I 'I D BMES^XPDUTL("NOT SAVED. Option '"_ABMM_"' not found in OPTION file.") Q
S A=0
F S A=$O(^DIC(19,I,10,A)) Q:'A S ^XTMP("ABMENVCK",7.2,"OPTSAV",ABMM,A)=$P(^DIC(19,+^DIC(19,I,10,A,0),0),U,1)_U_$P(^DIC(19,I,10,A,0),U,2,3)
Q
;
INSTALLD(ABMINSTL) ;EP - Determine if patch ABMINSTL was installed, where ABMINSTL is
; the name of the INSTALL. E.g "ABM*2.5*6".
;;^DIC(9.4,D0,22,D1,PAH,D2,0)=
;;(#.01) PATCH APPLICATION HISTORY [1F] ^ (#.02)DATE APPLIED [2D] ^ (#.03) APPLIED BY [3P] ^
NEW DIC,X,Y
S X=$P(ABMINSTL,"*",1)
S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
D IX^DIC
I Y<1 Q 0
S DIC=DIC_+Y_",22,",X=$P(ABMINSTL,"*",2)
D ^DIC
I Y<1 Q 0
S DIC=DIC_+Y_",""PAH"",",X=$P(ABMINSTL,"*",3)
D ^DIC
Q $S(Y<1:0,1:1)
;
LAST(PKG,VER) ;EP - returns last patch applied for a Package, PATCH^DATE
; Patch includes Seq # if Released
N PKGIEN,VERIEN,LATEST,PATCH,SUBIEN
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
. I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST S LATEST=$P(^(0),U,2),PATCH=$P(^(0),U)
. I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)=LATEST,$P(^(0),U)>PATCH S PATCH=$P(^(0),U)
Q PATCH_U_LATEST
ABMENVCK ;IHS/SD/SDR - ENVIRONMENT CHECKER ;
+1 ;;2.6;IHS Third Party Billing;**1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27**;NOV 12, 2009;Build 486
+2 ;IHS/SD/SDR 2.6*14 updated checker to look for patches after 8 (meaning 9 thru 13)
+3 ;IHS/SD/SDR 2.6*16 Updated patches for patch 16
+4 ;IHS/SD/SDR 2.6*17 Updated to check for patch 16
+5 ;IHS/SD/SDR 2.6*18 Check for patch 17
+6 ;IHS/SD/SDR 2.6*19 Check for patch 18
+7 ;IHS/SD/SDR 2.6*20 Check for patch 19
+8 ;IHS/SD/SDR 2.6*21 Check for patch 20
+9 ;IHS/SD/SDR 2.6*22 Check for patch 21
+10 ;IHS/SD/SDR 2.6*24 check for patches 22 and 23
+11 ;IHS/SD/SDR 2.6*26 check for p25, aupn*99.1*26
+12 ;IHS/SD/SDR 2.6*27 check for p26; fixed so messages write for all checks; BSCV only wrote a message if it was missing. Now more in line
+13 ; with notes file
+14 ;
+15 ;
+16 IF '$GET(DUZ)
WRITE !,"DUZ UNDEFINED OR 0."
DO SORRY(2)
QUIT
+17 ;
+18 IF '$LENGTH($GET(DUZ(0)))
WRITE !,"DUZ(0) UNDEFINED OR NULL."
DO SORRY(2)
QUIT
+19 ;
+20 SET X=$PIECE(^VA(200,DUZ,0),U)
+21 WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)
+22 WRITE !!,$$CJ^XLFSTR("Checking Environment for "_$PIECE($TEXT(+2),";",4)_" V "_$PIECE($TEXT(+2),";",3)_" Patch "_$PIECE($TEXT(+2),";",5)_".",IOM),!
+23 ;
+24 SET XPDQUIT=0
+25 ;
+26 ;abm*2.6*2
IF '$$VCHK("DI","22.0",2)
SET XPDQUIT=2
+27 ;start old abm*2.6*27 IHS/SD/SDR SAC findings
+28 ;;AUM*9.1*4 needed for new clinic code mapping
+29 ;S X=$$PATCH^XPDUTL("AUM*9.1*4") ;abm*2.6*4
+30 ;I X'=1 W !,$$CJ^XLFSTR("AUM v9.1 Patch 4 NOT INSTALLED",IOM) S XPDQUIT=2 ;abm*2.6*4
+31 ;I X=1 W !,$$CJ^XLFSTR("AUM v9.1 Patch 4 installed.",IOM) ;abm*2.6*4
+32 ;end old abm*2.6*27 IHS/SD/SDR SAC findings
+33 ;abm*2.6*2
IF '$$VCHK("AUM","10.1",2)
SET XPDQUIT=2
+34 ;
+35 ;start new abm*2.6*26 IHS/SD/SDR CR9264
+36 KILL X
+37 SET X=$$PATCH^XPDUTL("AUPN*99.1*26")
+38 IF X'=1
WRITE !,$$CJ^XLFSTR("AUPN v99.1 Patch 26 NOT INSTALLED",IOM)
SET XPDQUIT=2
+39 IF X=1
WRITE !,$$CJ^XLFSTR("AUPN v99.1 Patch 26 installed.",IOM)
+40 ;end new abm*2.6*26 IHS/SD/SDR CR9264
+41 ;
+42 ;abm*2.6*1
IF '$$VCHK("ABM","2.6",2)
SET XPDQUIT=2
+43 ;start old code abm*2.6*7
+44 ;;start new code abm*2.6*2
+45 ;K X
+46 ;S X=$$PATCH^XPDUTL("ABM*2.6*4")
+47 ;I X'=1 W !,$$CJ^XLFSTR("ABM v2.6 Patch 4 NOT INSTALLED",IOM) S XPDQUIT=2
+48 ;I X=1 W !,$$CJ^XLFSTR("ABM v2.6 Patch 4 installed.",IOM)
+49 ;;end new code abm*2.6*2
+50 ;end old code start new code abm*2.6*7
+51 NEW X,ABM,I
+52 SET ABM=1
+53 ;F I=1:1:6 D ;abm*2.6*9
+54 ;F I=1:1:8 D ;abm*2.6*9 ;ABM*2.6*14
+55 ;F I=1:1:13 D ;abm*2.6*14 ;abm*2.6*15
+56 ;F I=1:1:14 D ;abm*2.6*14 ;abm*2.6*15 ;abm*2.6*17
+57 ;F I=1:1:16 D ;abm*2.6*17 ;abm*2.6*18
+58 ;F I=1:1:18 D ;abm*2.6*17 ;abm*2.6*19
+59 ;F I=1:1:19 D ;abm*2.6*17 ;abm*2.6*18 ;abm*2.6*21
+60 ;F I=1:1:20 D ;abm*2.6*21 IHS/SD/SDR ;abm*2.6*22 IHS/SD/SDR
+61 ;F I=1:1:21 D ;abm*2.6*21 IHS/SD/SDR ;abm*2.6*22 IHS/SD/SDR ;abm*2.6*24 IHS/SD/SDR
+62 ;F I=1:1:23 D ;abm*2.6*24 IHS/SD/SDR ;abm*2.6*25 IHS/SD/SDR
+63 ;F I=1:1:24 D ;abm*2.6*25 IHS/SD/SDR ;abm*2.6*26 IHS/SD/SDR
+64 ;F I=1:1:25 D ;abm*2.6*26 IHS/SD/SDR ;abm*2.6*27 IHS/SD/SDR
+65 ;abm*2.6*27 IHS/SD/SDR
FOR I=1:1:26
Begin DoDot:1
+66 SET X=$$PATCH^XPDUTL("ABM*2.6*"_I)
+67 IF X'=1
SET ABM=0
WRITE !,$$CJ^XLFSTR("Need Third Party Billing v2.6 Patch "_I_"..... "_$SELECT(ABM=0:"NOT ",1:"")_"Present",IOM)
End DoDot:1
+68 IF ABM=0
SET XPDQUIT=2
+69 ;end new code abm*2.6*7
+70 ;
+71 IF '$$VCHK("AUT","98.1",2)
SET XPDQUIT=2
+72 ;
+73 SET X=$$LAST^ABMENVCK("IHS DICTIONARIES (POINTERS)","98.1")
+74 IF $PIECE(X,U,1)'=14&($PIECE(X,U,1)'>14)
WRITE !,$$CJ^XLFSTR("AUT v98.1 Patch 14 NOT INSTALLED",IOM)
SET XPDQUIT=2
+75 ;
+76 IF '$$VCHK("XU","8.0",2)
SET XPDQUIT=2
+77 KILL X
+78 SET X=$$PATCH^XPDUTL("XU*8.0*1013")
+79 IF X'=1
WRITE !,$$CJ^XLFSTR("KERNEL v8.0 Patch 1013 NOT INSTALLED",IOM)
SET XPDQUIT=2
+80 ;I X=1 W !,$$CJ^XLFSTR("XU Patch 1013 installed.",IOM) ;abm*2.6*27 IHS/SD/SDR SAC findings
+81 KILL X
+82 SET X=$$PATCH^XPDUTL("XU*8.0*1014")
+83 IF X'=1
WRITE !,$$CJ^XLFSTR("KERNEL v8.0 Patch 1014 NOT INSTALLED",IOM)
SET XPDQUIT=2
+84 ;I X=1 W !,$$CJ^XLFSTR("XU Patch 1014 installed.",IOM) ;abm*2.6*27 IHS/SD/SDR SAC findings
+85 ;
+86 ;start new code abm*2.6*10
+87 NEW X,ABM,I
+88 SET ABM=1
+89 FOR I=1:1:3
Begin DoDot:1
+90 SET X=$$PATCH^XPDUTL("BCSV*1.0*"_I)
+91 ;I X'=1 S ABM=0 W !,$$CJ^XLFSTR("Need BCSV IHS Code Set Versioning v1.0 Patch "_I_"..... "_$S(ABM=0:"NOT ",1:"")_"Present",IOM) ;abm*2.6*27 IHS/SD/SDR SAC findings
+92 ;abm*2.6*27 IHS/SD/SDR SAC findings
IF X'=1
SET ABM=0
+93 ;abm*2.6*27 IHS/SD/SDR SAC findings
WRITE !,$$CJ^XLFSTR("Need BCSV IHS Code Set Versioning v1.0 Patch "_I_"..... "_$SELECT(ABM=0:"NOT ",1:"")_"Present",IOM)
End DoDot:1
+94 IF ABM=0
SET XPDQUIT=2
+95 ;end new code abm*2.6*10
+96 ;
+97 NEW DA,DIC
+98 SET X="ABM"
SET DIC="^DIC(9.4,"
SET DIC(0)=""
SET D="C"
+99 DO IX^DIC
+100 IF Y<0
IF $DATA(^DIC(9.4,"C","ABM"))
Begin DoDot:1
+101 WRITE !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""ABM"" prefix.",IOM)
+102 WRITE !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
+103 WRITE !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
+104 QUIT
End DoDot:1
SET XPDQUIT=2
+105 ;
+106 IF $GET(XPDENV)=1
Begin DoDot:1
+107 ; The following line prevents the "Disable Options..." and "Move
+108 ; Routines..." questions from being asked during the install.
+109 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+110 DO OPTSAV("ABMMENU")
+111 QUIT
End DoDot:1
+112 ;
+113 IF XPDQUIT
DO SORRY(XPDQUIT)
QUIT
+114 ;
+115 WRITE !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
+116 ;
+117 IF '$$DIR^XBDIR("E","","","","","",1)
DO SORRY(2)
QUIT
+118 QUIT
+119 ;
SORRY(X) ;
+1 KILL DIFQ
+2 SET XPDQUIT=X
+3 IF '$DATA(ZTQUEUED)
WRITE *7,!,$$CJ^XLFSTR("Sorry....",IOM),$$DIR^XBDIR("E","Press RETURN")
+4 QUIT
+5 ;
VCHK(ABMPRE,ABMVER,ABMQUIT) ; Check versions needed.
+1 ;
+2 NEW ABMV
+3 SET ABMV=$$VERSION^XPDUTL(ABMPRE)
+4 WRITE !,$$CJ^XLFSTR("Need at least "_ABMPRE_" v "_ABMVER_"....."_ABMPRE_" v "_ABMV_" Present",IOM)
+5 IF ABMV<ABMVER
WRITE *7,!,$$CJ^XLFSTR("^^^^**NEEDS FIXED**^^^^",IOM)
QUIT 0
+6 QUIT 1
+7 ;
OPTSAV(ABMM) ;
+1 DO BMES^XPDUTL("Saving the configuration of option '"_ABMM_"'...")
+2 IF $DATA(^XTMP("ABMENVCK",7.2,"OPTSAV",ABMM))
DO BMES^XPDUTL("NOT SAVED. Option '"_ABMM_"' has previously been saved.")
QUIT
+3 IF '$DATA(^XTMP("ABMENVCK"))
SET ^XTMP("ABMENVCK",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"ABMENVCK - SAVE OPTION CONFIGURATIONS."
+4 NEW I,A
+5 SET I=$ORDER(^DIC(19,"B",ABMM,0))
+6 IF 'I
DO BMES^XPDUTL("NOT SAVED. Option '"_ABMM_"' not found in OPTION file.")
QUIT
+7 SET A=0
+8 FOR
SET A=$ORDER(^DIC(19,I,10,A))
IF 'A
QUIT
SET ^XTMP("ABMENVCK",7.2,"OPTSAV",ABMM,A)=$PIECE(^DIC(19,+^DIC(19,I,10,A,0),0),U,1)_U_$PIECE(^DIC(19,I,10,A,0),U,2,3)
+9 QUIT
+10 ;
INSTALLD(ABMINSTL) ;EP - Determine if patch ABMINSTL was installed, where ABMINSTL is
+1 ; the name of the INSTALL. E.g "ABM*2.5*6".
+2 ;;^DIC(9.4,D0,22,D1,PAH,D2,0)=
+3 ;;(#.01) PATCH APPLICATION HISTORY [1F] ^ (#.02)DATE APPLIED [2D] ^ (#.03) APPLIED BY [3P] ^
+4 NEW DIC,X,Y
+5 SET X=$PIECE(ABMINSTL,"*",1)
+6 SET DIC="^DIC(9.4,"
SET DIC(0)="FM"
SET D="C"
+7 DO IX^DIC
+8 IF Y<1
QUIT 0
+9 SET DIC=DIC_+Y_",22,"
SET X=$PIECE(ABMINSTL,"*",2)
+10 DO ^DIC
+11 IF Y<1
QUIT 0
+12 SET DIC=DIC_+Y_",""PAH"","
SET X=$PIECE(ABMINSTL,"*",3)
+13 DO ^DIC
+14 QUIT $SELECT(Y<1:0,1:1)
+15 ;
LAST(PKG,VER) ;EP - returns last patch applied for a Package, PATCH^DATE
+1 ; Patch includes Seq # if Released
+2 NEW PKGIEN,VERIEN,LATEST,PATCH,SUBIEN
+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 IF $PIECE(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST
SET LATEST=$PIECE(^(0),U,2)
SET PATCH=$PIECE(^(0),U)
+9 IF $PIECE(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)=LATEST
IF $PIECE(^(0),U)>PATCH
SET PATCH=$PIECE(^(0),U)
End DoDot:1
+10 QUIT PATCH_U_LATEST
