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

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

Change version to 1.4 on all routines
BSDX08 has fix for drag and drop because it referenced a non existent cancellation reason

File size: 4.4 KB
Line 
1BSDX2E ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [7/18/10 4:30pm]
2 ;;1.4;BSDX;;Sep 07, 2010
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.3 PostInit
61 ;Add Protocol items to SDAM APPOINTMENT EVENTS protocol
62 ;Remove protocols known to cause problems from SDAM APPOINTMENT EVENTS
63 ;
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 QUIT
109 ;
110SORRY(XPX) ;
111 K DIFQ
112 S XPDABORT=1
113 W !,$$C^XBFUNC($P($T(+2),";",3)_" of "_$P($T(+2),";",4)_" Cannot Be Installed!")
114 W !,$$C^XBFUNC("Reason: "_XPX_".")
115 W *7,!!!,$$C^XBFUNC("Sorry....something is wrong with your environment")
116 W !,$$C^XBFUNC("Aborting "_XPDNM_" install!")
117 W !,$$C^XBFUNC("Correct error and reinstall otherwise")
118 W !,$$C^XBFUNC("please print/capture this screen and notify")
119 W !,$$C^XBFUNC("technical support")
120 W !!,LINE
121 D BMES^XPDUTL("Sorry....something is wrong with your environment")
122 D BMES^XPDUTL("Enviroment ERROR "_$G(XPX))
123 D BMES^XPDUTL("Aborting "_XPDNM_" install!")
124 D BMES^XPDUTL("Correct error and reinstall otherwise")
125 D BMES^XPDUTL("please print/capture this screen and notify")
126 D BMES^XPDUTL("technical support")
127 Q
128 ;
Note: See TracBrowser for help on using the repository browser.