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

Last change on this file since 1568 was 1563, checked in by Tariq Hamkari, 12 years ago

updated the BSDX version to 1.7

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