AVA32P24 ;IHS/OIT/FBD - AVA 93.2 PATCH 24 ENVIRONMENT CHECK
;;93.2;VA SUPPORT FILES;**24**;MAY 16, 2018;Build 6
;
;
ENV ;----- ENVIRONMENT CHECK
;
N IORVOFF,IORVON
;
D ^XBKVAR
D HOME^%ZIS
;
D DUZ
I $G(XPDQUIT) D SORRY Q
;
D RV
D XPZ
D HELLO
D VER
I '$$CHKPAT("AVA*93.2*23") S XPDQUIT=1
D DUPE
D OK
;
I $D(XPDQUIT) W !,"INSTALL ABORTED!"
;
Q
;
DUZ ;----- CHECK FOR VALID DUZ VARIABLES
;
I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D FAIL(2)
I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D FAIL(2)
I '($G(DUZ(0))["@") W !,"THE DD UPDATES REQUIRE AN '@' IN YOUR DUZ(0)" D FAIL(2)
Q
;
RV ;----- SET REVERSE VIDEO ON/OFF VARIABLES
;
D HOME^%ZIS
N X
S X="IORVON;IORVOFF"
D ENDR^%ZISS
Q
;
XPZ ;----- PREVENT 'DISABLE OPTIONS' AND 'MOVE ROUTINES' PROMPTS
;
I $G(XPDENV)=1 D
. S XPDDIQ("XPZ1")=0 ;SUPPRESS 'DISABLE OPTIONS' PROMPT
. S XPDDIQ("XPZ2")=0 ;SUPPRESS 'MOVE ROUTINES' PROMPT
Q
;
HELLO ;----- HELLO MESSAGE AND ENVIRONMENT CHECK
;
N X
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)
Q
;
VER ;----- CHECK FOR VERSIONS
;
I $$VCHK("AVA","93.2",2)
I $$VCHK("DI","22.0",2)
I $$VCHK("XU","8.0",2)
Q
;
CHKPAT(X) ;
;----- CHECK IF PATCH HAS BEEN INSTALLED
;
; RETURNS 1 IF PATCH HAS BEEN INSTALLED, 0 IF NOT
;
N XPDA,OK
S OK=0
S XPDA=0
F S XPDA=$O(^XPD(9.7,"B",X,XPDA)) Q:'XPDA D
. I $P($G(^XPD(9.7,XPDA,0)),U,9)=3 S OK=1
S AVAMSG=$S(OK'=1:"Missing <<<--- FIX IT!",1:"Present.")
W !,$$CJ^XLFSTR("Need patch "_X_"....."_AVAMSG,IOM)
Q OK
;
DUPE ;----- CHECK FOR DUPLICATE AVA ENTRIES IN PACKAGE FILE
;
N D,DA,DIC,X,Y
S X="AVA",DIC="^DIC(9.4,",DIC(0)="",D="C"
D IX^DIC
I Y<0,$D(^DIC(9.4,"C","AVA")) D
. W !!,*7,*7,$$CJ^XLFSTR("You have more than one entry in the ",IOM)
. W !,$$CJ^XLFSTR("PACKAGE file with an 'AVA' prefix. ",IOM)
. W !,$$CJ^XLFSTR(IORVON_"One entry needs to be deleted"_IORVOFF,IOM)
. W !,$$CJ^XLFSTR("FIX IT! Before proceeding. ",IOM),!!,*7,*7
. D FAIL(2)
Q
;
OK ;----- OK TO INSTALL?
;
I $D(XPDQUIT) D
. W !!,$$CJ^XLFSTR(IORVON_"Please FIX it!!"_IORVOFF,IOM) D SORRY
;
I '$D(XPDQUIT) D
. W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
. I '$$DIR^XBDIR("E","","","","","",1) D FAIL(2)
Q
;
FAIL(X) ;----- SET XPDQUIT
;
K DIFQ
S XPDQUIT=X
Q
;
SORRY ;----- ISSUE 'SORRY... PRESS RETURN' MESSAGES
;
N Y
I '$D(ZTQUEUED) D
. W *7,!,$$CJ^XLFSTR("Sorry.... ",IOM)
. S Y=$$DIR^XBDIR("E","Press RETURN")
Q
;
VCHK(AVAPRE,AVAVER,AVAQUIT) ;
;----- CHECK VERSIONS NEEDED
;
N AVAV,AVAMSG,Y
;
S Y=1
S AVAV=$$VERSION^XPDUTL(AVAPRE)
S AVAMSG=$S(AVAV<AVAVER:" <<<--- FIX IT!",1:"")
;
W !,$$CJ^XLFSTR("Need at least "_AVAPRE_" v "_AVAVER_"....."_AVAPRE_" v "_AVAV_" Present"_AVAMSG,IOM)
;
I AVAV<AVAVER D FAIL(AVAQUIT) S Y=0
;
Q Y
;
PRE ;EP -- PRE-INSTALL FROM KIDS.
;
D ^XBKVAR
;
D BMES^XPDUTL("Beginning pre-install routine (PRE^AVA32P24)...")
;
;ANY PRE-INSTALL SUBROUTINE CALLS GO HERE
;
D MES^XPDUTL("Pre-install routine is complete.")
Q
;
POST ;EP -- POST-INSTALL FROM KIDS.
;
D ^XBKVAR
;
D BMES^XPDUTL("Beginning post-install routine (POST^AVA32P24)...")
;
D BMES^XPDUTL("Reconciling DEA# input transforms between files 200 (NEW PERSON) and 6 (PROVIDER)...")
N INPTX
S INPTX=$P(^DD(200,53.2,0),U,5,99) ;EXTRACT INPUT TRANSFORM FROM FILE 200'S DEA# FIELD...
S ^DD(6,5,0)=$P(^DD(6,5,0),U,1,4)_"^"_INPTX ;...AND INCORPORATE INTO DEA# FIELD IN FILE 6.
D BMES^XPDUTL("Input transform reconciliation complete.")
;
D BMES^XPDUTL("Delivering AVA*93.2*24 install message to select users...")
D MAIL
;
D BMES^XPDUTL("Post-install routine is complete.")
Q
MAIL ;----- SEND INSTALL MAIL MESSAGE
;
N DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
;
K ^TMP("AVAP24MS",$J)
;
S ^TMP("AVAP24MS",$J,1)=" --- AVA v 93.2, Patch 24, has been installed into this namespace ---"
;
I $G(XPDA) D
. S %=0
. F S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'% D
. . S ^TMP("AVAP24MS",$J,(%+1))=" "_^(%,0)
;
S XMSUB=$P($P($T(+1),";",2)," ",3,99)
S XMDUZ=$S($G(DUZ):DUZ,1:.5)
S XMTEXT="^TMP(""AVAP24MS"",$J,"
S XMY(1)=""
S XMY(DUZ)=""
;
F %="XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
;
D ^XMD
;
K ^TMP("AVAP24MS",$J)
;
Q
;
SINGLE(K) ;----- GET HOLDERS OF A SINGLE KEY K.
;
N Y
;
Q:'$D(^XUSEC(K))
;
S Y=0
F S Y=$O(^XUSEC(K,Y)) Q:'Y S XMY(Y)=""
;
Q
AVA32P24 ;IHS/OIT/FBD - AVA 93.2 PATCH 24 ENVIRONMENT CHECK
+1 ;;93.2;VA SUPPORT FILES;**24**;MAY 16, 2018;Build 6
+2 ;
+3 ;
ENV ;----- ENVIRONMENT CHECK
+1 ;
+2 NEW IORVOFF,IORVON
+3 ;
+4 DO ^XBKVAR
+5 DO HOME^%ZIS
+6 ;
+7 DO DUZ
+8 IF $GET(XPDQUIT)
DO SORRY
QUIT
+9 ;
+10 DO RV
+11 DO XPZ
+12 DO HELLO
+13 DO VER
+14 IF '$$CHKPAT("AVA*93.2*23")
SET XPDQUIT=1
+15 DO DUPE
+16 DO OK
+17 ;
+18 IF $DATA(XPDQUIT)
WRITE !,"INSTALL ABORTED!"
+19 ;
+20 QUIT
+21 ;
DUZ ;----- CHECK FOR VALID DUZ VARIABLES
+1 ;
+2 IF '$GET(DUZ)
WRITE !,"DUZ UNDEFINED OR 0."
DO FAIL(2)
+3 IF '$LENGTH($GET(DUZ(0)))
WRITE !,"DUZ(0) UNDEFINED OR NULL."
DO FAIL(2)
+4 IF '($GET(DUZ(0))["@")
WRITE !,"THE DD UPDATES REQUIRE AN '@' IN YOUR DUZ(0)"
DO FAIL(2)
+5 QUIT
+6 ;
RV ;----- SET REVERSE VIDEO ON/OFF VARIABLES
+1 ;
+2 DO HOME^%ZIS
+3 NEW X
+4 SET X="IORVON;IORVOFF"
+5 DO ENDR^%ZISS
+6 QUIT
+7 ;
XPZ ;----- PREVENT 'DISABLE OPTIONS' AND 'MOVE ROUTINES' PROMPTS
+1 ;
+2 IF $GET(XPDENV)=1
Begin DoDot:1
+3 ;SUPPRESS 'DISABLE OPTIONS' PROMPT
SET XPDDIQ("XPZ1")=0
+4 ;SUPPRESS 'MOVE ROUTINES' PROMPT
SET XPDDIQ("XPZ2")=0
End DoDot:1
+5 QUIT
+6 ;
HELLO ;----- HELLO MESSAGE AND ENVIRONMENT CHECK
+1 ;
+2 NEW X
+3 SET X=$PIECE(^VA(200,DUZ,0),U)
+4 WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)
+5 WRITE !!,$$CJ^XLFSTR("Checking Environment for "_$PIECE($TEXT(+2),";",4)_" V "_$PIECE($TEXT(+2),";",3)_" Patch "_$PIECE($TEXT(+2),";",5)_".",IOM)
+6 QUIT
+7 ;
VER ;----- CHECK FOR VERSIONS
+1 ;
+2 IF $$VCHK("AVA","93.2",2)
+3 IF $$VCHK("DI","22.0",2)
+4 IF $$VCHK("XU","8.0",2)
+5 QUIT
+6 ;
CHKPAT(X) ;
+1 ;----- CHECK IF PATCH HAS BEEN INSTALLED
+2 ;
+3 ; RETURNS 1 IF PATCH HAS BEEN INSTALLED, 0 IF NOT
+4 ;
+5 NEW XPDA,OK
+6 SET OK=0
+7 SET XPDA=0
+8 FOR
SET XPDA=$ORDER(^XPD(9.7,"B",X,XPDA))
IF 'XPDA
QUIT
Begin DoDot:1
+9 IF $PIECE($GET(^XPD(9.7,XPDA,0)),U,9)=3
SET OK=1
End DoDot:1
+10 SET AVAMSG=$SELECT(OK'=1:"Missing <<<--- FIX IT!",1:"Present.")
+11 WRITE !,$$CJ^XLFSTR("Need patch "_X_"....."_AVAMSG,IOM)
+12 QUIT OK
+13 ;
DUPE ;----- CHECK FOR DUPLICATE AVA ENTRIES IN PACKAGE FILE
+1 ;
+2 NEW D,DA,DIC,X,Y
+3 SET X="AVA"
SET DIC="^DIC(9.4,"
SET DIC(0)=""
SET D="C"
+4 DO IX^DIC
+5 IF Y<0
IF $DATA(^DIC(9.4,"C","AVA"))
Begin DoDot:1
+6 WRITE !!,*7,*7,$$CJ^XLFSTR("You have more than one entry in the ",IOM)
+7 WRITE !,$$CJ^XLFSTR("PACKAGE file with an 'AVA' prefix. ",IOM)
+8 WRITE !,$$CJ^XLFSTR(IORVON_"One entry needs to be deleted"_IORVOFF,IOM)
+9 WRITE !,$$CJ^XLFSTR("FIX IT! Before proceeding. ",IOM),!!,*7,*7
+10 DO FAIL(2)
End DoDot:1
+11 QUIT
+12 ;
OK ;----- OK TO INSTALL?
+1 ;
+2 IF $DATA(XPDQUIT)
Begin DoDot:1
+3 WRITE !!,$$CJ^XLFSTR(IORVON_"Please FIX it!!"_IORVOFF,IOM)
DO SORRY
End DoDot:1
+4 ;
+5 IF '$DATA(XPDQUIT)
Begin DoDot:1
+6 WRITE !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
+7 IF '$$DIR^XBDIR("E","","","","","",1)
DO FAIL(2)
End DoDot:1
+8 QUIT
+9 ;
FAIL(X) ;----- SET XPDQUIT
+1 ;
+2 KILL DIFQ
+3 SET XPDQUIT=X
+4 QUIT
+5 ;
SORRY ;----- ISSUE 'SORRY... PRESS RETURN' MESSAGES
+1 ;
+2 NEW Y
+3 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+4 WRITE *7,!,$$CJ^XLFSTR("Sorry.... ",IOM)
+5 SET Y=$$DIR^XBDIR("E","Press RETURN")
End DoDot:1
+6 QUIT
+7 ;
VCHK(AVAPRE,AVAVER,AVAQUIT) ;
+1 ;----- CHECK VERSIONS NEEDED
+2 ;
+3 NEW AVAV,AVAMSG,Y
+4 ;
+5 SET Y=1
+6 SET AVAV=$$VERSION^XPDUTL(AVAPRE)
+7 SET AVAMSG=$SELECT(AVAV<AVAVER:" <<<--- FIX IT!",1:"")
+8 ;
+9 WRITE !,$$CJ^XLFSTR("Need at least "_AVAPRE_" v "_AVAVER_"....."_AVAPRE_" v "_AVAV_" Present"_AVAMSG,IOM)
+10 ;
+11 IF AVAV<AVAVER
DO FAIL(AVAQUIT)
SET Y=0
+12 ;
+13 QUIT Y
+14 ;
PRE ;EP -- PRE-INSTALL FROM KIDS.
+1 ;
+2 DO ^XBKVAR
+3 ;
+4 DO BMES^XPDUTL("Beginning pre-install routine (PRE^AVA32P24)...")
+5 ;
+6 ;ANY PRE-INSTALL SUBROUTINE CALLS GO HERE
+7 ;
+8 DO MES^XPDUTL("Pre-install routine is complete.")
+9 QUIT
+10 ;
POST ;EP -- POST-INSTALL FROM KIDS.
+1 ;
+2 DO ^XBKVAR
+3 ;
+4 DO BMES^XPDUTL("Beginning post-install routine (POST^AVA32P24)...")
+5 ;
+6 DO BMES^XPDUTL("Reconciling DEA# input transforms between files 200 (NEW PERSON) and 6 (PROVIDER)...")
+7 NEW INPTX
+8 ;EXTRACT INPUT TRANSFORM FROM FILE 200'S DEA# FIELD...
SET INPTX=$PIECE(^DD(200,53.2,0),U,5,99)
+9 ;...AND INCORPORATE INTO DEA# FIELD IN FILE 6.
SET ^DD(6,5,0)=$PIECE(^DD(6,5,0),U,1,4)_"^"_INPTX
+10 DO BMES^XPDUTL("Input transform reconciliation complete.")
+11 ;
+12 DO BMES^XPDUTL("Delivering AVA*93.2*24 install message to select users...")
+13 DO MAIL
+14 ;
+15 DO BMES^XPDUTL("Post-install routine is complete.")
+16 QUIT
MAIL ;----- SEND INSTALL MAIL MESSAGE
+1 ;
+2 NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
+3 ;
+4 KILL ^TMP("AVAP24MS",$JOB)
+5 ;
+6 SET ^TMP("AVAP24MS",$JOB,1)=" --- AVA v 93.2, Patch 24, has been installed into this namespace ---"
+7 ;
+8 IF $GET(XPDA)
Begin DoDot:1
+9 SET %=0
+10 FOR
SET %=$ORDER(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%))
IF '%
QUIT
Begin DoDot:2
+11 SET ^TMP("AVAP24MS",$JOB,(%+1))=" "_^(%,0)
End DoDot:2
End DoDot:1
+12 ;
+13 SET XMSUB=$PIECE($PIECE($TEXT(+1),";",2)," ",3,99)
+14 SET XMDUZ=$SELECT($GET(DUZ):DUZ,1:.5)
+15 SET XMTEXT="^TMP(""AVAP24MS"",$J,"
+16 SET XMY(1)=""
+17 SET XMY(DUZ)=""
+18 ;
+19 FOR %="XUMGR","XUPROG","XUPROGMODE"
DO SINGLE(%)
+20 ;
+21 DO ^XMD
+22 ;
+23 KILL ^TMP("AVAP24MS",$JOB)
+24 ;
+25 QUIT
+26 ;
SINGLE(K) ;----- GET HOLDERS OF A SINGLE KEY K.
+1 ;
+2 NEW Y
+3 ;
+4 IF '$DATA(^XUSEC(K))
QUIT
+5 ;
+6 SET Y=0
+7 FOR
SET Y=$ORDER(^XUSEC(K,Y))
IF 'Y
QUIT
SET XMY(Y)=""
+8 ;
+9 QUIT