source: Scheduling/trunk/m/BSDX2E.m@ 1142

Last change on this file since 1142 was 1142, checked in by Sam Habiel, 14 years ago

Updated version number to 1.5 Beta 1

File size: 4.7 KB
Line 
1BSDX2E ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [3/16/11 9:54am]
2 ;;1.5T1;BSDX;;Apr 06, 2011
3 ;
4 S LINE="",$P(LINE,"*",81)=""
5 S XPDNOQUE="NO QUE" ;NO QUEUING ALLOWED
6 S XPDABORT=0
7 I '$G(DUZ) D SORRY("DUZ UNDEFINED OR 0") Q
8 ;
9 I '$L($G(DUZ(0))) D SORRY("DUZ(0) UNDEFINED OR NULL") Q
10 ;
11 D HOME^%ZIS,DT^DICRW
12 S X=$P($G(^VA(200,DUZ,0)),U)
13 I $G(X)="" W !,$$C^XBFUNC("Who are you????") D SORRY("Unknown User") Q
14 ;
15VERSION ;
16 W !,$$C^XBFUNC("Hello, "_$P(X,",",2)_" "_$P(X,","))
17 W !!,$$C^XBFUNC("Checking Environment for Install of Version "_$P($T(+2),";",3)_" of "_$P($T(+2),";",4)_".")
18 ;
19 Q:'$$VERCHK("VA FILEMAN",22)
20 Q:'$$VERCHK("KERNEL",8)
21 Q:'$$VERCHK("XB",3)
22 ;Is the PIMS requirement present?
23 Q:'$$VERCHK("SD",5.3)
24 ; Q:'$$PATCHCK("PIMS*5.3*1003") D
25 Q:'$$VERCHK("BMX",2)
26 ;
27OTHER ;
28 ;Other checks
29 ;
30ENVOK ; If this is just an environ check, end here.
31 W !!,$$C^XBFUNC("ENVIRONMENT OK.")
32 ;
33 ; The following line prevents the "Disable Options..." and "Move
34 ; Routines..." questions from being asked during the install.
35 I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
36 ;
37 ;
38 ;VERIFY BACKUPS HAVE BEEN DONE
39 ;W !!
40 ;S DIR(0)="Y"
41 ;S DIR("B")="NO"
42 ;S DIR("A")="Has a SUCCESSFUL system backup been performed??"
43 ;D ^DIR
44 ;I $D(DIRUT)!($G(Y)=0) S XPDABORT=1 S XPX="BACKUP" D SORRY Q
45 ;S ^TMP("BPCPRE",$J,"BACKUPS CONFIRMED BY "_DUZ)=$H
46 ;
47 Q
48 ;
49VERCHK(XPXPKG,XVRMIN) ;
50 S X=$$VERSION^XPDUTL(XPXPKG)
51 W !!,$$C^XBFUNC("Need at least "_XPXPKG_" "_XVRMIN_"....."_XPXPKG_" "_$S(X'="":X,1:"Is Not")_" Present")
52 I X<XVRMIN D SORRY(XPXPKG_" "_XVRMIN_" Is Not Installed") Q 0
53 Q 1
54 ;
55PATCHCK(XPXPCH) ;
56 S X=$$PATCH^XPDUTL(XPXPCH)
57 W !!,$$C^XBFUNC("Need "_XPXPCH_"....."_XPXPCH_" "_$S(X:"Is",1:"Is Not")_" Present")
58 Q X
59 ;
60V0200 ;EP Version 1.5 PostInit
61 ;Add Protocol items to SDAM APPOINTMENT EVENTS protocol
62 ;Remove protocols known to cause problems from SDAM APPOINTMENT EVENTS
63 ;Set Default Values for Parameters
64 N BSDXDA,BSDXFDA,BSDXDA1,BSDXSEQ,BSDXDAT,BSDXNOD,BSDXIEN,BSDXMSG
65 ;
66 ; 1st, add the BSDX event protocols
67 ; Get SDAM APPOINTMENT EVENTS IEN in 101
68 S BSDXDA=$O(^ORD(101,"B","SDAM APPOINTMENT EVENTS",0))
69 Q:'+BSDXDA
70 ; Add each of those protocols unless they already exist.
71 S BSDXDAT="BSDX ADD APPOINTMENT;10.2^BSDX CANCEL APPOINTMENT;10.4^BSDX CHECKIN APPOINTMENT;10.6^BSDX NOSHOW APPOINTMENT;10.8"
72 ; For each
73 F J=1:1:$L(BSDXDAT,U) D
74 . K BSDXIEN,BSDXMSG,BSDXFDA
75 . ; Get Item
76 . S BSDXNOD=$P(BSDXDAT,U,J)
77 . ; Get Item Name (BSDX ADD APPOINTMENT)
78 . S BSDXDA1=$P(BSDXNOD,";")
79 . ; Get Item Sequence (10.2)
80 . S BSDXSEQ=$P(BSDXNOD,";",2)
81 . ; Get Item Reference (Item is already in the protocol file)
82 . S BSDXDA1=$O(^ORD(101,"B",BSDXDA1,0))
83 . ; Quit if not found
84 . Q:'+BSDXDA1
85 . ; Quit if already exists in the SDAM protocol
86 . Q:$D(^ORD(101,BSDXDA,10,"B",BSDXDA1))
87 . ; Go ahead and save it.
88 . S BSDXFDA(101.01,"+1,"_BSDXDA_",",".01")=BSDXDA1
89 . S BSDXFDA(101.01,"+1,"_BSDXDA_",","3")=BSDXSEQ
90 . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
91 . ; Error message
92 . I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1)
93 ;
94 ; Remove nassssty protocols ORU PATIENT MOVMT and DVBA C&P SCHD EVENT
95 ; SDAM APPOINTMENT EVENTS IENS for use in FIND1^DIC
96 N SDEVTIENS S SDEVTIENS=","_BSDXDA_","
97 ; Subfile entry for ORU...
98 N ORUIEN S ORUIEN=$$FIND1^DIC(101.01,SDEVTIENS,"","ORU PATIENT MOVMT")
99 ; Subfile entry for DVBA...
100 N DVBAIEN S DVBAIEN=$$FIND1^DIC(101.01,SDEVTIENS,"","DVBA C&P SCHD EVENT")
101 ; Deletion code
102 N BSDXFDA,BSDXMSG
103 S:ORUIEN>0 BSDXFDA(101.01,ORUIEN_SDEVTIENS,.01)="@"
104 S:DVBAIEN>0 BSDXFDA(101.01,DVBAIEN_SDEVTIENS,.01)="@"
105 D:$D(BSDXFDA) FILE^DIE("","BSDXFDA","BSDXMSG")
106 ; If error
107 I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1)
108 ;
109 ;
110 ; Now put in the default values for parameters
111 ; BSDX AUTO PRINT RS as false
112 ; BSDX AUTO PRINT AS as false
113 ;
114 N BSDXERR
115 D PUT^XPAR("PKG","BSDX AUTO PRINT RS",1,0,.BSDXERR)
116 I $G(BSDXERR) W $C(7),"Error: ",BSDXERR
117 D PUT^XPAR("PKG","BSDX AUTO PRINT AS",1,0,.BSDXERR)
118 I $G(BSDXERR) W $C(7),"Error: ",BSDXERR
119 QUIT
120 ;
121SORRY(XPX) ;
122 K DIFQ
123 S XPDABORT=1
124 W !,$$C^XBFUNC($P($T(+2),";",3)_" of "_$P($T(+2),";",4)_" Cannot Be Installed!")
125 W !,$$C^XBFUNC("Reason: "_XPX_".")
126 W *7,!!!,$$C^XBFUNC("Sorry....something is wrong with your environment")
127 W !,$$C^XBFUNC("Aborting "_XPDNM_" install!")
128 W !,$$C^XBFUNC("Correct error and reinstall otherwise")
129 W !,$$C^XBFUNC("please print/capture this screen and notify")
130 W !,$$C^XBFUNC("technical support")
131 W !!,LINE
132 D BMES^XPDUTL("Sorry....something is wrong with your environment")
133 D BMES^XPDUTL("Enviroment ERROR "_$G(XPX))
134 D BMES^XPDUTL("Aborting "_XPDNM_" install!")
135 D BMES^XPDUTL("Correct error and reinstall otherwise")
136 D BMES^XPDUTL("please print/capture this screen and notify")
137 D BMES^XPDUTL("technical support")
138 Q
139 ;
Note: See TracBrowser for help on using the repository browser.