- XB3P9 ;IHS/SET/GTH - XB 3 PATCH 9 ; [ 04/21/2003 9:21 AM ]
- ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
- ;
- ; IHS/SET/GTH XB*3*9 10/29/2002
- ;
- I '$G(IOM) D HOME^%ZIS
- ;
- NEW IORVON,IORVOFF
- S X="IORVON;IORVOFF"
- D ENDR^%ZISS
- ;
- 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)
- D BMES^XPDUTL($$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM))
- D BMES^XPDUTL($$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_" Patch "_$P($T(+2),";",5)_".",IOM))
- ;
- NEW XBQUIT
- S XBQUIT=0
- I '$$VCHK("XB","3.0",2,"'=") S XBQUIT=2
- ;
- NEW DA,DIC
- S X="XB",DIC="^DIC(9.4,",DIC(0)="",D="C"
- D IX^DIC
- I Y<0,$D(^DIC(9.4,"C","XB")) D S XBQUIT=2
- . D BMES^XPDUTL($$CJ^XLFSTR("You Have More Than One Entry In The",IOM)),MES^XPDUTL($$CJ^XLFSTR("PACKAGE File with an ""XB"" prefix.",IOM))
- . D MES^XPDUTL($$CJ^XLFSTR(IORVON_"One entry needs to be deleted."_IORVOFF,IOM))
- . D MES^XPDUTL($$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM))
- .Q
- ;
- I $G(XPDENV)=1 D
- . S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
- . Q:DUZ(0)["@"
- . D BMES^XPDUTL("I need ""@"" in your DUZ(0) for the install to work.")
- . D MES^XPDUTL("In programmer mode, D P^DI,^XUP, and select ""XPD MAIN"" when you're prompted")
- . D MES^XPDUTL("for OPTION NAME.")
- . S XBQUIT=2
- .Q
- ;
- I XBQUIT D SORRY(XBQUIT) Q
- ;
- D BMES^XPDUTL($$CJ^XLFSTR("ENVIRONMENT OK.",IOM))
- ;
- I '$$DIR^XBDIR("E","","","","","",2) D SORRY(2)
- Q
- ;
- SORRY(X) ;
- KILL DIFQ
- S XPDQUIT=X
- W:'$D(ZTQUEUED) *7,!,$$CJ^XLFSTR(IORVON_"Sorry...."_IORVOFF,IOM),$$DIR^XBDIR("E","Press RETURN")
- Q
- ;
- VCHK(XBPRE,XBVER,XBQUIT,XBCOMP) ; Check versions needed.
- ;
- NEW XBV
- S XBV=$$VERSION^XPDUTL(XBPRE)
- W !,$$CJ^XLFSTR("Need "_$S(XBCOMP="<":"at least ",1:"")_XBPRE_" v "_XBVER_"....."_XBPRE_" v "_XBV_" Present",IOM)
- I @(""""_XBV_""""_XBCOMP_""""_XBVER_"""") Q 0
- Q 1
- ;
- ;
- PRE ;EP - From KIDS.
- Q
- D BMES^XPDUTL("Begin 'PRE^XB3P9' at "_$$FMTE^XLFDT($$NOW^XLFDT)_".")
- D BMES^XPDUTL("End 'PRE^XB3P9' at "_$$FMTE^XLFDT($$NOW^XLFDT)_".")
- Q
- ;
- POST ;EP - From KIDS.
- D BMES^XPDUTL("Begin 'POST^XB3P9' at "_$$FMTE^XLFDT($$NOW^XLFDT)_".")
- ;
- D BMES^XPDUTL("Attaching ""XB PACKAGE TRACKING"" option to the Site Manager menu.")
- D ATTACH
- ;
- D BMES^XPDUTL("Setting up Q'ing of option 'XBTRK' for every 30 days.")
- D QUE
- ;
- I $$VERSION^%ZOSV(1)["Cache" D LOAD
- ;
- D BMES^XPDUTL("Delivering XB*3*9 install message to select users...")
- D MAIL
- ;
- D BMES^XPDUTL("Creating Task to delete old/unused XB/ZIB routines.")
- D DELR
- ;
- D BMES^XPDUTL("End 'POST^XB3P9' at "_$$FMTE^XLFDT($$NOW^XLFDT)_".")
- Q
- ;
- ATTACH ; Attach option for protection and interactive access.
- I $$ADD^XPDMENU("XUSITEMGR","XB PACKAGE TRACKING","PTRK",10) D BMES^XPDUTL("....successfully atch'd....allocating Security Keys...") D I 1
- . NEW XB,DA,DIC,DINUM
- . S XB=0,XB("PG")=$O(^DIC(19.1,"B","XUPROGMODE",0)),XB("TRK")=$O(^DIC(19.1,"B","XBZ PACKAGE TRACKING",0))
- . Q:'XB("PG")!'XB("TRK")
- . S DIC(0)="NMQ",DIC("P")=$P(^DD(200,51,0),U,2)
- . F S XB=$O(^XUSEC("XUPROGMODE",XB)) Q:'XB D
- .. Q:$D(^VA(200,XB,51,XB("TRK")))
- .. S DIC="^VA(200,XB,51,",DA(1)=XB,(DINUM,X)=XB("TRK")
- .. D FILE^DICN
- ..Q
- .Q
- E D BMES^XPDUTL("....Attachment *FAILED*.")
- Q
- ;
- QUE ; Add the option to the OPTION SCHEDULING file.
- NEW DA,DIC
- S DIC=19.2,DIC(0)="L",X="XB PACKAGE TRACKING",DIC("DR")="2////"_$$SCH^XLFDT("1D",DT)_".05;6///30D"
- D ^DIC
- I +Y<0 D BMES^XPDUTL("Entry of ""XB PACKAGE TRACKING"" into OPTION SCHEDULING file failed.") Q
- S DA(1)=+Y,DIC="^DIC(19.2,"_DA(1)_",2,",DIC(0)="",DIC("P")=$P(^DD(19.2,10,0),U,2),XBSYSID(1)="cmbsyb.hqw.DOMAIN.NAME",XBSYSID(2)=$P(^AUTTSITE(1,0),U,14)
- KILL DO,DD
- F X="XBSYSID(1)","XBSYSID(2)" S DIC("DR")="1///"""_(@X)_"""" D FILE^DICN
- D BMES^XPDUTL("""XB PACKAGE TRACKING"" has been entered into OPTION SCHEDULING file.")
- Q
- ;
- MAIL ; Send install mail message.
- NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
- KILL ^TMP("XB3P9MS",$J)
- S ^TMP("XB3P9MS",$J,1)=" --- XB v 3, Patch 9, has been installed ---"
- S %=0
- F S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'% S ^TMP("XB3P9MS",$J,(%+1))=" "_^(%,0)
- S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""XB3P9MS"",$J,",XMY(1)="",XMY(DUZ)=""
- F %="XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
- D ^XMD
- KILL ^TMP("XB3P9MS",$J)
- Q
- ;
- SINGLE(K) ; Get holders of a single key K.
- NEW Y
- S Y=0
- Q:'$D(^XUSEC(K))
- F S Y=$O(^XUSEC(K,Y)) Q:'Y S XMY(Y)=""
- Q
- ;
- DELR ; Create task to delete unnecessary routines.
- S ZTRTN="DEL^XBDELR(""XBP8"")",ZTDESC="Delete routines in the 'XBP8' namespace.",ZTDTH=$$HADD^XLFDT($H,0,0,30,0),ZTIO="",ZTPRI=1
- D ^%ZTLOAD
- Q
- ;
- LOAD ; If Cache', save %-routines into Namespace
- D BMES^XPDUTL("Saving 5 routines as % routines in current Namespace.")
- NEW DIE,DIF,X,XB,XBF,XBL,XBT,XCM,XCN,XCNP
- KILL ^TMP("XB3P9",$J)
- F XB=1:1 S XBL=$P($T(RTN+XB),";",3) Q:'$L(XBL) D
- . S XBF=$P(XBL,U,1),XBT=$P(XBL,U,2)
- . D MES^XPDUTL(" Saving '"_$$LJ^XLFSTR(XBF,8)_"' as '"_$$LJ^XLFSTR(XBT,8)_"'.")
- . S DIF="^TMP(""XB3P9"",$J,",XCNP=0,X=XBF
- . X ^%ZOSF("LOAD")
- . S DIE="^TMP(""XB3P9"",$J,",X=XBT,XCN=0
- . X ^%ZOSF("SAVE")
- . KILL ^TMP("XB3P9",$J)
- .Q
- Q
- ;
- RTN ; Routine ^ Rename As
- ;;XBCLS^%XBCLS
- ;;ZIBGD^%ZIBGD
- ;;ZIBRD^%ZIBRD
- ;;ZIBCLU0^%ZIBCLU0
- ;;ZIBZUCI^%ZUCI
- ;
- XB3P9 ;IHS/SET/GTH - XB 3 PATCH 9 ; [ 04/21/2003 9:21 AM ]
- +1 ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
- +2 ;
- +3 ; IHS/SET/GTH XB*3*9 10/29/2002
- +4 ;
- +5 IF '$GET(IOM)
- DO HOME^%ZIS
- +6 ;
- +7 NEW IORVON,IORVOFF
- +8 SET X="IORVON;IORVOFF"
- +9 DO ENDR^%ZISS
- +10 ;
- +11 IF '$GET(DUZ)
- WRITE !,"DUZ UNDEFINED OR 0."
- DO SORRY(2)
- QUIT
- +12 ;
- +13 IF '$LENGTH($GET(DUZ(0)))
- WRITE !,"DUZ(0) UNDEFINED OR NULL."
- DO SORRY(2)
- QUIT
- +14 ;
- +15 SET X=$PIECE(^VA(200,DUZ,0),U)
- +16 DO BMES^XPDUTL($$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM))
- +17 DO BMES^XPDUTL($$CJ^XLFSTR("Checking Environment for "_$PIECE($TEXT(+2),";",4)_" V "_$PIECE($TEXT(+2),";",3)_" Patch "_$PIECE($TEXT(+2),";",5)_".",IOM))
- +18 ;
- +19 NEW XBQUIT
- +20 SET XBQUIT=0
- +21 IF '$$VCHK("XB","3.0",2,"'=")
- SET XBQUIT=2
- +22 ;
- +23 NEW DA,DIC
- +24 SET X="XB"
- SET DIC="^DIC(9.4,"
- SET DIC(0)=""
- SET D="C"
- +25 DO IX^DIC
- +26 IF Y<0
- IF $DATA(^DIC(9.4,"C","XB"))
- Begin DoDot:1
- +27 DO BMES^XPDUTL($$CJ^XLFSTR("You Have More Than One Entry In The",IOM))
- DO MES^XPDUTL($$CJ^XLFSTR("PACKAGE File with an ""XB"" prefix.",IOM))
- +28 DO MES^XPDUTL($$CJ^XLFSTR(IORVON_"One entry needs to be deleted."_IORVOFF,IOM))
- +29 DO MES^XPDUTL($$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM))
- +30 QUIT
- End DoDot:1
- SET XBQUIT=2
- +31 ;
- +32 IF $GET(XPDENV)=1
- Begin DoDot:1
- +33 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
- +34 IF DUZ(0)["@"
- QUIT
- +35 DO BMES^XPDUTL("I need ""@"" in your DUZ(0) for the install to work.")
- +36 DO MES^XPDUTL("In programmer mode, D P^DI,^XUP, and select ""XPD MAIN"" when you're prompted")
- +37 DO MES^XPDUTL("for OPTION NAME.")
- +38 SET XBQUIT=2
- +39 QUIT
- End DoDot:1
- +40 ;
- +41 IF XBQUIT
- DO SORRY(XBQUIT)
- QUIT
- +42 ;
- +43 DO BMES^XPDUTL($$CJ^XLFSTR("ENVIRONMENT OK.",IOM))
- +44 ;
- +45 IF '$$DIR^XBDIR("E","","","","","",2)
- DO SORRY(2)
- +46 QUIT
- +47 ;
- SORRY(X) ;
- +1 KILL DIFQ
- +2 SET XPDQUIT=X
- +3 IF '$DATA(ZTQUEUED)
- WRITE *7,!,$$CJ^XLFSTR(IORVON_"Sorry...."_IORVOFF,IOM),$$DIR^XBDIR("E","Press RETURN")
- +4 QUIT
- +5 ;
- VCHK(XBPRE,XBVER,XBQUIT,XBCOMP) ; Check versions needed.
- +1 ;
- +2 NEW XBV
- +3 SET XBV=$$VERSION^XPDUTL(XBPRE)
- +4 WRITE !,$$CJ^XLFSTR("Need "_$SELECT(XBCOMP="<":"at least ",1:"")_XBPRE_" v "_XBVER_"....."_XBPRE_" v "_XBV_" Present",IOM)
- +5 IF @(""""_XBV_""""_XBCOMP_""""_XBVER_"""")
- QUIT 0
- +6 QUIT 1
- +7 ;
- +8 ;
- PRE ;EP - From KIDS.
- +1 QUIT
- +2 DO BMES^XPDUTL("Begin 'PRE^XB3P9' at "_$$FMTE^XLFDT($$NOW^XLFDT)_".")
- +3 DO BMES^XPDUTL("End 'PRE^XB3P9' at "_$$FMTE^XLFDT($$NOW^XLFDT)_".")
- +4 QUIT
- +5 ;
- POST ;EP - From KIDS.
- +1 DO BMES^XPDUTL("Begin 'POST^XB3P9' at "_$$FMTE^XLFDT($$NOW^XLFDT)_".")
- +2 ;
- +3 DO BMES^XPDUTL("Attaching ""XB PACKAGE TRACKING"" option to the Site Manager menu.")
- +4 DO ATTACH
- +5 ;
- +6 DO BMES^XPDUTL("Setting up Q'ing of option 'XBTRK' for every 30 days.")
- +7 DO QUE
- +8 ;
- +9 IF $$VERSION^%ZOSV(1)["Cache"
- DO LOAD
- +10 ;
- +11 DO BMES^XPDUTL("Delivering XB*3*9 install message to select users...")
- +12 DO MAIL
- +13 ;
- +14 DO BMES^XPDUTL("Creating Task to delete old/unused XB/ZIB routines.")
- +15 DO DELR
- +16 ;
- +17 DO BMES^XPDUTL("End 'POST^XB3P9' at "_$$FMTE^XLFDT($$NOW^XLFDT)_".")
- +18 QUIT
- +19 ;
- ATTACH ; Attach option for protection and interactive access.
- +1 IF $$ADD^XPDMENU("XUSITEMGR","XB PACKAGE TRACKING","PTRK",10)
- DO BMES^XPDUTL("....successfully atch'd....allocating Security Keys...")
- Begin DoDot:1
- +2 NEW XB,DA,DIC,DINUM
- +3 SET XB=0
- SET XB("PG")=$ORDER(^DIC(19.1,"B","XUPROGMODE",0))
- SET XB("TRK")=$ORDER(^DIC(19.1,"B","XBZ PACKAGE TRACKING",0))
- +4 IF 'XB("PG")!'XB("TRK")
- QUIT
- +5 SET DIC(0)="NMQ"
- SET DIC("P")=$PIECE(^DD(200,51,0),U,2)
- +6 FOR
- SET XB=$ORDER(^XUSEC("XUPROGMODE",XB))
- IF 'XB
- QUIT
- Begin DoDot:2
- +7 IF $DATA(^VA(200,XB,51,XB("TRK")))
- QUIT
- +8 SET DIC="^VA(200,XB,51,"
- SET DA(1)=XB
- SET (DINUM,X)=XB("TRK")
- +9 DO FILE^DICN
- +10 QUIT
- End DoDot:2
- +11 QUIT
- End DoDot:1
- IF 1
- +12 IF '$TEST
- DO BMES^XPDUTL("....Attachment *FAILED*.")
- +13 QUIT
- +14 ;
- QUE ; Add the option to the OPTION SCHEDULING file.
- +1 NEW DA,DIC
- +2 SET DIC=19.2
- SET DIC(0)="L"
- SET X="XB PACKAGE TRACKING"
- SET DIC("DR")="2////"_$$SCH^XLFDT("1D",DT)_".05;6///30D"
- +3 DO ^DIC
- +4 IF +Y<0
- DO BMES^XPDUTL("Entry of ""XB PACKAGE TRACKING"" into OPTION SCHEDULING file failed.")
- QUIT
- +5 SET DA(1)=+Y
- SET DIC="^DIC(19.2,"_DA(1)_",2,"
- SET DIC(0)=""
- SET DIC("P")=$PIECE(^DD(19.2,10,0),U,2)
- SET XBSYSID(1)="cmbsyb.hqw.DOMAIN.NAME"
- SET XBSYSID(2)=$PIECE(^AUTTSITE(1,0),U,14)
- +6 KILL DO,DD
- +7 FOR X="XBSYSID(1)","XBSYSID(2)"
- SET DIC("DR")="1///"""_(@X)_""""
- DO FILE^DICN
- +8 DO BMES^XPDUTL("""XB PACKAGE TRACKING"" has been entered into OPTION SCHEDULING file.")
- +9 QUIT
- +10 ;
- MAIL ; Send install mail message.
- +1 NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
- +2 KILL ^TMP("XB3P9MS",$JOB)
- +3 SET ^TMP("XB3P9MS",$JOB,1)=" --- XB v 3, Patch 9, has been installed ---"
- +4 SET %=0
- +5 FOR
- SET %=$ORDER(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%))
- IF '%
- QUIT
- SET ^TMP("XB3P9MS",$JOB,(%+1))=" "_^(%,0)
- +6 SET XMSUB=$PIECE($PIECE($TEXT(+1),";",2)," ",3,99)
- SET XMDUZ=$SELECT($GET(DUZ):DUZ,1:.5)
- SET XMTEXT="^TMP(""XB3P9MS"",$J,"
- SET XMY(1)=""
- SET XMY(DUZ)=""
- +7 FOR %="XUMGR","XUPROG","XUPROGMODE"
- DO SINGLE(%)
- +8 DO ^XMD
- +9 KILL ^TMP("XB3P9MS",$JOB)
- +10 QUIT
- +11 ;
- SINGLE(K) ; Get holders of a single key K.
- +1 NEW Y
- +2 SET Y=0
- +3 IF '$DATA(^XUSEC(K))
- QUIT
- +4 FOR
- SET Y=$ORDER(^XUSEC(K,Y))
- IF 'Y
- QUIT
- SET XMY(Y)=""
- +5 QUIT
- +6 ;
- DELR ; Create task to delete unnecessary routines.
- +1 SET ZTRTN="DEL^XBDELR(""XBP8"")"
- SET ZTDESC="Delete routines in the 'XBP8' namespace."
- SET ZTDTH=$$HADD^XLFDT($HOROLOG,0,0,30,0)
- SET ZTIO=""
- SET ZTPRI=1
- +2 DO ^%ZTLOAD
- +3 QUIT
- +4 ;
- LOAD ; If Cache', save %-routines into Namespace
- +1 DO BMES^XPDUTL("Saving 5 routines as % routines in current Namespace.")
- +2 NEW DIE,DIF,X,XB,XBF,XBL,XBT,XCM,XCN,XCNP
- +3 KILL ^TMP("XB3P9",$JOB)
- +4 FOR XB=1:1
- SET XBL=$PIECE($TEXT(RTN+XB),";",3)
- IF '$LENGTH(XBL)
- QUIT
- Begin DoDot:1
- +5 SET XBF=$PIECE(XBL,U,1)
- SET XBT=$PIECE(XBL,U,2)
- +6 DO MES^XPDUTL(" Saving '"_$$LJ^XLFSTR(XBF,8)_"' as '"_$$LJ^XLFSTR(XBT,8)_"'.")
- +7 SET DIF="^TMP(""XB3P9"",$J,"
- SET XCNP=0
- SET X=XBF
- +8 XECUTE ^%ZOSF("LOAD")
- +9 SET DIE="^TMP(""XB3P9"",$J,"
- SET X=XBT
- SET XCN=0
- +10 XECUTE ^%ZOSF("SAVE")
- +11 KILL ^TMP("XB3P9",$JOB)
- +12 QUIT
- End DoDot:1
- +13 QUIT
- +14 ;
- RTN ; Routine ^ Rename As
- +1 ;;XBCLS^%XBCLS
- +2 ;;ZIBGD^%ZIBGD
- +3 ;;ZIBRD^%ZIBRD
- +4 ;;ZIBCLU0^%ZIBCLU0
- +5 ;;ZIBZUCI^%ZUCI
- +6 ;
