source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SD132EN.m@ 1596

Last change on this file since 1596 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1SD132EN ;ALB/MJK - Patch SD*5.3*132 Environmental Check Routine ; 11/5/97
2 ;;5.3;Scheduling;**132**;Aug 13, 1993
3 ;
4EN ; --- main entry point
5 S U="^"
6 D HOME^%ZIS
7 ;
8 W !,"Environmental Checks Started..."
9 ;
10 ; -- main driver calls
11 D EVT,PKG
12 ;
13 W !!,"Environmental Checks Completed."
14 W " [",$S($G(XPDQUIT):"Failed",1:"Passed"),"]",!
15 Q
16 ;
17EVT ; -- check SDAM APPOINTMENT EVENTS protocol for dangling pointers
18 N SDMAIN,SDITEM,SDIEN,SDBAD
19 S SDBAD=0
20 S SDMAIN=$O(^ORD(101,"B","SDAM APPOINTMENT EVENTS",0))
21 IF 'SDMAIN G EVTQ
22 S SDITEM=0
23 F S SDITEM=$O(^ORD(101,SDMAIN,10,SDITEM)) Q:'SDITEM D Q:SDBAD
24 . S SDIEN=+$G(^ORD(101,SDMAIN,10,SDITEM,0))
25 . IF '$D(^ORD(101,SDIEN,0)) D
26 . . S SDBAD=1
27 . . W !!?5,"Item #",SDITEM," on the 'SDAM APPOINTMENT EVENTS' protocol"
28 . . W !?5,"is a dangling pointer and must be corrected/removed"
29 . . W !?5,"before patch SD*5.3*132 can be installed."
30 . . W !!,?5,"Please contact the Customer Support Help Desk for assistance."
31 . . D PAUSE
32 IF SDBAD S XPDQUIT=2
33EVTQ Q
34 ;
35PKG ; -- check if needed patches are installed
36 N SDLIST
37 ;
38 ; -- build patch list info
39 D BUILD(.SDLIST)
40 ;
41 ; -- display patch info
42 D DISPLAY(.SDLIST)
43 ;
44 ; -- have all patches passed check
45 IF '$$OK(.SDLIST) D
46 . S XPDQUIT=2
47 . W !!," -> At least one patch check failed."
48 ELSE D
49 . W !!," -> All patch checks passed."
50 D PAUSE
51 Q
52 ;
53LINE(OK,REASON) ; -- print line of text
54 W !," -> ",SDPKG,"...",$S(OK:"Ok",1:"not Ok"),?30,"Reason: ",REASON
55 Q
56 ;
57BUILD(SDLIST) ; -- scan patch list and build array
58 N SDI,SDX,SDPATCH,SDPKG,SDPKGN,SDOVER,SDREASON,SDTEXT,SDPKGV
59 F SDI=1:1 S SDX=$P($T(PKGS+SDI),";;",2) Q:SDX="$$END$$" D
60 . S SDPKGN=$P(SDX,U)
61 . S SDPKG=$P(SDX,U,2)
62 . S SDPATCH=$P(SDX,U,3)
63 . S SDPKGV=$P(SDX,U,4)
64 . S SDOVER=+$P($G(^XTMP("SD*5.3*132 OVERRIDE FLAGS",SDPKG)),U)
65 . ;
66 . S SDREASON=$$REASON(SDPATCH,SDPKG,SDPKGV,SDOVER)
67 . S SDTEXT=$P($T(REASONS+SDREASON),";;",2)
68 . ;
69 . S SDLIST(SDPKG,"PACKAGE NAME")=SDPKGN
70 . S SDLIST(SDPKG,"PATCH")=SDPATCH
71 . S SDLIST(SDPKG,"NEEDED VERSION")=SDPKGV
72 . S SDLIST(SDPKG,"PASSED")=+SDTEXT
73 . S SDLIST(SDPKG,"REASON TEXT")=$P(SDTEXT,U,2)
74 . S SDLIST(SDPKG,"REASON NUMBER")=SDREASON
75 . S SDLIST(SDPKG,"OVERRIDE")=SDOVER
76 Q
77 ;
78REASON(SDPATCH,SDPKG,SDPKGV,SDOVER) ; check if patch is loaded or not needed
79 N SDREASON,SDVERS
80 IF SDOVER S SDREASON=1 G REASONQ
81 S SDVERS=$$VERSION^XPDUTL(SDPKG)
82 IF SDVERS="" S SDREASON=2 G REASONQ
83 IF $$PATCH^XPDUTL(SDPATCH) S SDREASON=3 G REASONQ
84 IF SDPKGV]"",SDVERS=SDPKGV S SDREASON=5 G REASONQ
85 S SDREASON=4
86REASONQ Q SDREASON
87 ;
88DISPLAY(SDLIST) ; -- display patch info
89 N SDPKGN,SDLINE
90 S $P(SDLINE,"-",IOM)="-"
91 ;
92 W @IOF,!,"Information On Patches Needed For SD*5.3*132 Install",!,SDLINE
93 W !?33,"Patch or",?50,"Passed"
94 W !,"Package",?33,"Version",?50,"Check",?58,"Reason",!,SDLINE
95 S SDPKG=""
96 F S SDPKG=$O(SDLIST(SDPKG)) Q:SDPKG="" D
97 . W !,SDLIST(SDPKG,"PACKAGE NAME")
98 . W ?33,SDLIST(SDPKG,"PATCH")
99 . IF SDLIST(SDPKG,"NEEDED VERSION")]"" W " / ",SDLIST(SDPKG,"NEEDED VERSION")
100 . W ?50,$S($G(SDLIST(SDPKG,"PASSED")):"Yes",1:"No")
101 . W ?58,$E($G(SDLIST(SDPKG,"REASON TEXT")),1,25)
102 W !,SDLINE
103 Q
104 ;
105OK(SDLIST) ; -- have all patch checks passed
106 N SDPKGN,SDOK
107 S SDOK=1
108 S SDPKG=""
109 F S SDPKG=$O(SDLIST(SDPKG)) Q:SDPKG="" D Q:'SDOK
110 . S SDOK=+$G(SDLIST(SDPKG,"PASSED"))
111 Q SDOK
112 ;
113PKGS ; -- packages to check [ package name ^ package namespace ^ patch designation ^ package version ]
114 ;;AUTOMATED MED INFO EXCHANGE^DVBA^DVBA*2.7*14^
115 ;;ADVERSE REACTION TRACKING^GMRA^GMRA*4.0*9^
116 ;;HOSPITAL BASED HOME CARE^HBH^HBH*1.0*10^
117 ;;INTEGRATED BILLING^IB^IB*2.0*91^
118 ;;AUTOMATED INFO COLLECTION SYS^IBD^IBD*3.0*17^
119 ;;ICR - IMMUNOLOGY CASE REGISTRY^IMR^IMR*2.0*25^2.1
120 ;;INCOME VERIFICATION MATCH^IVM^IVM*2.0*11^
121 ;;RECORD TRACKING^RT^RT*2.0*30^
122 ;;$$END$$
123 ;;REGISTRATION^DG^DG*5.3*151^
124 ;
125REASONS ; -- reason list [ 0:failed ; 1:passed ^ reason text ]
126 ;;1^Override Flag Set
127 ;;1^Package Not Installed
128 ;;1^Patch Installed
129 ;;0^Patch Not Installed
130 ;;1^New Version Installed
131 ;;$$END$$
132 ;
133QIK(SDQIK) ; -- create quick list
134 N SDI,SDX
135 F SDI=1:1 S SDX=$P($T(PKGS+SDI),";;",2) Q:SDX="$$END$$" D
136 . S SDQIK($P(SDX,U,2))=""
137 Q
138 ;
139VALID(SDPKG) ; -- was a valid namespace pasted
140 N SDQIK,SDOK
141 S SDOK=0
142 D QIK(.SDQIK)
143 IF $G(SDPKG)]"",$D(SDQIK(SDPKG)) S SDOK=1
144 IF 'SDOK W "...invalid namespace passed!",!
145 Q SDOK
146 ;
147PAUSE ; -- pause for return
148 N Y
149 R !!,"Press return to continue: ",Y:$G(DTIME,300)
150 Q
151 ;
152 ;
153 ; <<<<<<<<<<<<<<< Entry points for Customer Service >>>>>>>>>>>>>>>
154 ;
155SET(SDPKG) ; -- set override for package namespace
156 Q:'$$VALID($G(SDPKG))
157 IF '$D(^XTMP("SD*5.3*132 OVERRIDE FLAGS",0)) S ^XTMP("SD*5.3*132 OVERRIDE FLAGS",0)="2991231^"_DT_"^Patch SD*5.3*132 Package Override Flags"
158 S ^XTMP("SD*5.3*132 OVERRIDE FLAGS",SDPKG)=1
159 W " ...override set for '",SDPKG,"'",!
160 Q
161 ;
162KILL(SDPKG) ; -- kill override for package namespace
163 Q:'$$VALID($G(SDPKG))
164 K ^XTMP("SD*5.3*132 OVERRIDE FLAGS",SDPKG)
165 IF $O(^XTMP("SD*5.3*132 OVERRIDE FLAGS",0))="" K ^XTMP("SD*5.3*132 OVERRIDE FLAGS")
166 W " ...override killed for '",SDPKG,"'",!
167 Q
168 ;
169KILLALL ; -- kill overrides for all package namespaces
170 K ^XTMP("SD*5.3*132 OVERRIDE FLAGS")
171 W " ...killed",!
172 Q
173 ;
Note: See TracBrowser for help on using the repository browser.