[613] | 1 | SD132EN ;ALB/MJK - Patch SD*5.3*132 Environmental Check Routine ; 11/5/97
|
---|
| 2 | ;;5.3;Scheduling;**132**;Aug 13, 1993
|
---|
| 3 | ;
|
---|
| 4 | EN ; --- 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 | ;
|
---|
| 17 | EVT ; -- 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
|
---|
| 33 | EVTQ Q
|
---|
| 34 | ;
|
---|
| 35 | PKG ; -- 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 | ;
|
---|
| 53 | LINE(OK,REASON) ; -- print line of text
|
---|
| 54 | W !," -> ",SDPKG,"...",$S(OK:"Ok",1:"not Ok"),?30,"Reason: ",REASON
|
---|
| 55 | Q
|
---|
| 56 | ;
|
---|
| 57 | BUILD(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 | ;
|
---|
| 78 | REASON(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
|
---|
| 86 | REASONQ Q SDREASON
|
---|
| 87 | ;
|
---|
| 88 | DISPLAY(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 | ;
|
---|
| 105 | OK(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 | ;
|
---|
| 113 | PKGS ; -- 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 | ;
|
---|
| 125 | REASONS ; -- 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 | ;
|
---|
| 133 | QIK(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 | ;
|
---|
| 139 | VALID(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 | ;
|
---|
| 147 | PAUSE ; -- 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 | ;
|
---|
| 155 | SET(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 | ;
|
---|
| 162 | KILL(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 | ;
|
---|
| 169 | KILLALL ; -- kill overrides for all package namespaces
|
---|
| 170 | K ^XTMP("SD*5.3*132 OVERRIDE FLAGS")
|
---|
| 171 | W " ...killed",!
|
---|
| 172 | Q
|
---|
| 173 | ;
|
---|