SD132EN ;ALB/MJK - Patch SD*5.3*132 Environmental Check Routine ; 11/5/97
;;5.3;Scheduling;**132**;Aug 13, 1993
;
EN ; --- main entry point
S U="^"
D HOME^%ZIS
;
W !,"Environmental Checks Started..."
;
; -- main driver calls
D EVT,PKG
;
W !!,"Environmental Checks Completed."
W " [",$S($G(XPDQUIT):"Failed",1:"Passed"),"]",!
Q
;
EVT ; -- check SDAM APPOINTMENT EVENTS protocol for dangling pointers
N SDMAIN,SDITEM,SDIEN,SDBAD
S SDBAD=0
S SDMAIN=$O(^ORD(101,"B","SDAM APPOINTMENT EVENTS",0))
IF 'SDMAIN G EVTQ
S SDITEM=0
F S SDITEM=$O(^ORD(101,SDMAIN,10,SDITEM)) Q:'SDITEM D Q:SDBAD
. S SDIEN=+$G(^ORD(101,SDMAIN,10,SDITEM,0))
. IF '$D(^ORD(101,SDIEN,0)) D
. . S SDBAD=1
. . W !!?5,"Item #",SDITEM," on the 'SDAM APPOINTMENT EVENTS' protocol"
. . W !?5,"is a dangling pointer and must be corrected/removed"
. . W !?5,"before patch SD*5.3*132 can be installed."
. . W !!,?5,"Please contact the Customer Support Help Desk for assistance."
. . D PAUSE
IF SDBAD S XPDQUIT=2
EVTQ Q
;
PKG ; -- check if needed patches are installed
N SDLIST
;
; -- build patch list info
D BUILD(.SDLIST)
;
; -- display patch info
D DISPLAY(.SDLIST)
;
; -- have all patches passed check
IF '$$OK(.SDLIST) D
. S XPDQUIT=2
. W !!," -> At least one patch check failed."
ELSE D
. W !!," -> All patch checks passed."
D PAUSE
Q
;
LINE(OK,REASON) ; -- print line of text
W !," -> ",SDPKG,"...",$S(OK:"Ok",1:"not Ok"),?30,"Reason: ",REASON
Q
;
BUILD(SDLIST) ; -- scan patch list and build array
N SDI,SDX,SDPATCH,SDPKG,SDPKGN,SDOVER,SDREASON,SDTEXT,SDPKGV
F SDI=1:1 S SDX=$P($T(PKGS+SDI),";;",2) Q:SDX="$$END$$" D
. S SDPKGN=$P(SDX,U)
. S SDPKG=$P(SDX,U,2)
. S SDPATCH=$P(SDX,U,3)
. S SDPKGV=$P(SDX,U,4)
. S SDOVER=+$P($G(^XTMP("SD*5.3*132 OVERRIDE FLAGS",SDPKG)),U)
. ;
. S SDREASON=$$REASON(SDPATCH,SDPKG,SDPKGV,SDOVER)
. S SDTEXT=$P($T(REASONS+SDREASON),";;",2)
. ;
. S SDLIST(SDPKG,"PACKAGE NAME")=SDPKGN
. S SDLIST(SDPKG,"PATCH")=SDPATCH
. S SDLIST(SDPKG,"NEEDED VERSION")=SDPKGV
. S SDLIST(SDPKG,"PASSED")=+SDTEXT
. S SDLIST(SDPKG,"REASON TEXT")=$P(SDTEXT,U,2)
. S SDLIST(SDPKG,"REASON NUMBER")=SDREASON
. S SDLIST(SDPKG,"OVERRIDE")=SDOVER
Q
;
REASON(SDPATCH,SDPKG,SDPKGV,SDOVER) ; check if patch is loaded or not needed
N SDREASON,SDVERS
IF SDOVER S SDREASON=1 G REASONQ
S SDVERS=$$VERSION^XPDUTL(SDPKG)
IF SDVERS="" S SDREASON=2 G REASONQ
IF $$PATCH^XPDUTL(SDPATCH) S SDREASON=3 G REASONQ
IF SDPKGV]"",SDVERS=SDPKGV S SDREASON=5 G REASONQ
S SDREASON=4
REASONQ Q SDREASON
;
DISPLAY(SDLIST) ; -- display patch info
N SDPKGN,SDLINE
S $P(SDLINE,"-",IOM)="-"
;
W @IOF,!,"Information On Patches Needed For SD*5.3*132 Install",!,SDLINE
W !?33,"Patch or",?50,"Passed"
W !,"Package",?33,"Version",?50,"Check",?58,"Reason",!,SDLINE
S SDPKG=""
F S SDPKG=$O(SDLIST(SDPKG)) Q:SDPKG="" D
. W !,SDLIST(SDPKG,"PACKAGE NAME")
. W ?33,SDLIST(SDPKG,"PATCH")
. IF SDLIST(SDPKG,"NEEDED VERSION")]"" W " / ",SDLIST(SDPKG,"NEEDED VERSION")
. W ?50,$S($G(SDLIST(SDPKG,"PASSED")):"Yes",1:"No")
. W ?58,$E($G(SDLIST(SDPKG,"REASON TEXT")),1,25)
W !,SDLINE
Q
;
OK(SDLIST) ; -- have all patch checks passed
N SDPKGN,SDOK
S SDOK=1
S SDPKG=""
F S SDPKG=$O(SDLIST(SDPKG)) Q:SDPKG="" D Q:'SDOK
. S SDOK=+$G(SDLIST(SDPKG,"PASSED"))
Q SDOK
;
PKGS ; -- packages to check [ package name ^ package namespace ^ patch designation ^ package version ]
;;AUTOMATED MED INFO EXCHANGE^DVBA^DVBA*2.7*14^
;;ADVERSE REACTION TRACKING^GMRA^GMRA*4.0*9^
;;HOSPITAL BASED HOME CARE^HBH^HBH*1.0*10^
;;INTEGRATED BILLING^IB^IB*2.0*91^
;;AUTOMATED INFO COLLECTION SYS^IBD^IBD*3.0*17^
;;ICR - IMMUNOLOGY CASE REGISTRY^IMR^IMR*2.0*25^2.1
;;INCOME VERIFICATION MATCH^IVM^IVM*2.0*11^
;;RECORD TRACKING^RT^RT*2.0*30^
;;$$END$$
;;REGISTRATION^DG^DG*5.3*151^
;
REASONS ; -- reason list [ 0:failed ; 1:passed ^ reason text ]
;;1^Override Flag Set
;;1^Package Not Installed
;;1^Patch Installed
;;0^Patch Not Installed
;;1^New Version Installed
;;$$END$$
;
QIK(SDQIK) ; -- create quick list
N SDI,SDX
F SDI=1:1 S SDX=$P($T(PKGS+SDI),";;",2) Q:SDX="$$END$$" D
. S SDQIK($P(SDX,U,2))=""
Q
;
VALID(SDPKG) ; -- was a valid namespace pasted
N SDQIK,SDOK
S SDOK=0
D QIK(.SDQIK)
IF $G(SDPKG)]"",$D(SDQIK(SDPKG)) S SDOK=1
IF 'SDOK W "...invalid namespace passed!",!
Q SDOK
;
PAUSE ; -- pause for return
N Y
R !!,"Press return to continue: ",Y:$G(DTIME,300)
Q
;
;
; <<<<<<<<<<<<<<< Entry points for Customer Service >>>>>>>>>>>>>>>
;
SET(SDPKG) ; -- set override for package namespace
Q:'$$VALID($G(SDPKG))
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"
S ^XTMP("SD*5.3*132 OVERRIDE FLAGS",SDPKG)=1
W " ...override set for '",SDPKG,"'",!
Q
;
KILL(SDPKG) ; -- kill override for package namespace
Q:'$$VALID($G(SDPKG))
K ^XTMP("SD*5.3*132 OVERRIDE FLAGS",SDPKG)
IF $O(^XTMP("SD*5.3*132 OVERRIDE FLAGS",0))="" K ^XTMP("SD*5.3*132 OVERRIDE FLAGS")
W " ...override killed for '",SDPKG,"'",!
Q
;
KILLALL ; -- kill overrides for all package namespaces
K ^XTMP("SD*5.3*132 OVERRIDE FLAGS")
W " ...killed",!
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD132EN 5348 printed Apr 09, 2024@21:57 Page 2
SD132EN ;ALB/MJK - Patch SD*5.3*132 Environmental Check Routine ; 11/5/97
+1 ;;5.3;Scheduling;**132**;Aug 13, 1993
+2 ;
EN ; --- main entry point
+1 SET U="^"
+2 DO HOME^%ZIS
+3 ;
+4 WRITE !,"Environmental Checks Started..."
+5 ;
+6 ; -- main driver calls
+7 DO EVT
DO PKG
+8 ;
+9 WRITE !!,"Environmental Checks Completed."
+10 WRITE " [",$SELECT($GET(XPDQUIT):"Failed",1:"Passed"),"]",!
+11 QUIT
+12 ;
EVT ; -- check SDAM APPOINTMENT EVENTS protocol for dangling pointers
+1 NEW SDMAIN,SDITEM,SDIEN,SDBAD
+2 SET SDBAD=0
+3 SET SDMAIN=$ORDER(^ORD(101,"B","SDAM APPOINTMENT EVENTS",0))
+4 IF 'SDMAIN
GOTO EVTQ
+5 SET SDITEM=0
+6 FOR
SET SDITEM=$ORDER(^ORD(101,SDMAIN,10,SDITEM))
if 'SDITEM
QUIT
Begin DoDot:1
+7 SET SDIEN=+$GET(^ORD(101,SDMAIN,10,SDITEM,0))
+8 IF '$DATA(^ORD(101,SDIEN,0))
Begin DoDot:2
+9 SET SDBAD=1
+10 WRITE !!?5,"Item #",SDITEM," on the 'SDAM APPOINTMENT EVENTS' protocol"
+11 WRITE !?5,"is a dangling pointer and must be corrected/removed"
+12 WRITE !?5,"before patch SD*5.3*132 can be installed."
+13 WRITE !!,?5,"Please contact the Customer Support Help Desk for assistance."
+14 DO PAUSE
End DoDot:2
End DoDot:1
if SDBAD
QUIT
+15 IF SDBAD
SET XPDQUIT=2
EVTQ QUIT
+1 ;
PKG ; -- check if needed patches are installed
+1 NEW SDLIST
+2 ;
+3 ; -- build patch list info
+4 DO BUILD(.SDLIST)
+5 ;
+6 ; -- display patch info
+7 DO DISPLAY(.SDLIST)
+8 ;
+9 ; -- have all patches passed check
+10 IF '$$OK(.SDLIST)
Begin DoDot:1
+11 SET XPDQUIT=2
+12 WRITE !!," -> At least one patch check failed."
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 WRITE !!," -> All patch checks passed."
End DoDot:1
+15 DO PAUSE
+16 QUIT
+17 ;
LINE(OK,REASON) ; -- print line of text
+1 WRITE !," -> ",SDPKG,"...",$SELECT(OK:"Ok",1:"not Ok"),?30,"Reason: ",REASON
+2 QUIT
+3 ;
BUILD(SDLIST) ; -- scan patch list and build array
+1 NEW SDI,SDX,SDPATCH,SDPKG,SDPKGN,SDOVER,SDREASON,SDTEXT,SDPKGV
+2 FOR SDI=1:1
SET SDX=$PIECE($TEXT(PKGS+SDI),";;",2)
if SDX="$$END$$"
QUIT
Begin DoDot:1
+3 SET SDPKGN=$PIECE(SDX,U)
+4 SET SDPKG=$PIECE(SDX,U,2)
+5 SET SDPATCH=$PIECE(SDX,U,3)
+6 SET SDPKGV=$PIECE(SDX,U,4)
+7 SET SDOVER=+$PIECE($GET(^XTMP("SD*5.3*132 OVERRIDE FLAGS",SDPKG)),U)
+8 ;
+9 SET SDREASON=$$REASON(SDPATCH,SDPKG,SDPKGV,SDOVER)
+10 SET SDTEXT=$PIECE($TEXT(REASONS+SDREASON),";;",2)
+11 ;
+12 SET SDLIST(SDPKG,"PACKAGE NAME")=SDPKGN
+13 SET SDLIST(SDPKG,"PATCH")=SDPATCH
+14 SET SDLIST(SDPKG,"NEEDED VERSION")=SDPKGV
+15 SET SDLIST(SDPKG,"PASSED")=+SDTEXT
+16 SET SDLIST(SDPKG,"REASON TEXT")=$PIECE(SDTEXT,U,2)
+17 SET SDLIST(SDPKG,"REASON NUMBER")=SDREASON
+18 SET SDLIST(SDPKG,"OVERRIDE")=SDOVER
End DoDot:1
+19 QUIT
+20 ;
REASON(SDPATCH,SDPKG,SDPKGV,SDOVER) ; check if patch is loaded or not needed
+1 NEW SDREASON,SDVERS
+2 IF SDOVER
SET SDREASON=1
GOTO REASONQ
+3 SET SDVERS=$$VERSION^XPDUTL(SDPKG)
+4 IF SDVERS=""
SET SDREASON=2
GOTO REASONQ
+5 IF $$PATCH^XPDUTL(SDPATCH)
SET SDREASON=3
GOTO REASONQ
+6 IF SDPKGV]""
IF SDVERS=SDPKGV
SET SDREASON=5
GOTO REASONQ
+7 SET SDREASON=4
REASONQ QUIT SDREASON
+1 ;
DISPLAY(SDLIST) ; -- display patch info
+1 NEW SDPKGN,SDLINE
+2 SET $PIECE(SDLINE,"-",IOM)="-"
+3 ;
+4 WRITE @IOF,!,"Information On Patches Needed For SD*5.3*132 Install",!,SDLINE
+5 WRITE !?33,"Patch or",?50,"Passed"
+6 WRITE !,"Package",?33,"Version",?50,"Check",?58,"Reason",!,SDLINE
+7 SET SDPKG=""
+8 FOR
SET SDPKG=$ORDER(SDLIST(SDPKG))
if SDPKG=""
QUIT
Begin DoDot:1
+9 WRITE !,SDLIST(SDPKG,"PACKAGE NAME")
+10 WRITE ?33,SDLIST(SDPKG,"PATCH")
+11 IF SDLIST(SDPKG,"NEEDED VERSION")]""
WRITE " / ",SDLIST(SDPKG,"NEEDED VERSION")
+12 WRITE ?50,$SELECT($GET(SDLIST(SDPKG,"PASSED")):"Yes",1:"No")
+13 WRITE ?58,$EXTRACT($GET(SDLIST(SDPKG,"REASON TEXT")),1,25)
End DoDot:1
+14 WRITE !,SDLINE
+15 QUIT
+16 ;
OK(SDLIST) ; -- have all patch checks passed
+1 NEW SDPKGN,SDOK
+2 SET SDOK=1
+3 SET SDPKG=""
+4 FOR
SET SDPKG=$ORDER(SDLIST(SDPKG))
if SDPKG=""
QUIT
Begin DoDot:1
+5 SET SDOK=+$GET(SDLIST(SDPKG,"PASSED"))
End DoDot:1
if 'SDOK
QUIT
+6 QUIT SDOK
+7 ;
PKGS ; -- packages to check [ package name ^ package namespace ^ patch designation ^ package version ]
+1 ;;AUTOMATED MED INFO EXCHANGE^DVBA^DVBA*2.7*14^
+2 ;;ADVERSE REACTION TRACKING^GMRA^GMRA*4.0*9^
+3 ;;HOSPITAL BASED HOME CARE^HBH^HBH*1.0*10^
+4 ;;INTEGRATED BILLING^IB^IB*2.0*91^
+5 ;;AUTOMATED INFO COLLECTION SYS^IBD^IBD*3.0*17^
+6 ;;ICR - IMMUNOLOGY CASE REGISTRY^IMR^IMR*2.0*25^2.1
+7 ;;INCOME VERIFICATION MATCH^IVM^IVM*2.0*11^
+8 ;;RECORD TRACKING^RT^RT*2.0*30^
+9 ;;$$END$$
+10 ;;REGISTRATION^DG^DG*5.3*151^
+11 ;
REASONS ; -- reason list [ 0:failed ; 1:passed ^ reason text ]
+1 ;;1^Override Flag Set
+2 ;;1^Package Not Installed
+3 ;;1^Patch Installed
+4 ;;0^Patch Not Installed
+5 ;;1^New Version Installed
+6 ;;$$END$$
+7 ;
QIK(SDQIK) ; -- create quick list
+1 NEW SDI,SDX
+2 FOR SDI=1:1
SET SDX=$PIECE($TEXT(PKGS+SDI),";;",2)
if SDX="$$END$$"
QUIT
Begin DoDot:1
+3 SET SDQIK($PIECE(SDX,U,2))=""
End DoDot:1
+4 QUIT
+5 ;
VALID(SDPKG) ; -- was a valid namespace pasted
+1 NEW SDQIK,SDOK
+2 SET SDOK=0
+3 DO QIK(.SDQIK)
+4 IF $GET(SDPKG)]""
IF $DATA(SDQIK(SDPKG))
SET SDOK=1
+5 IF 'SDOK
WRITE "...invalid namespace passed!",!
+6 QUIT SDOK
+7 ;
PAUSE ; -- pause for return
+1 NEW Y
+2 READ !!,"Press return to continue: ",Y:$GET(DTIME,300)
+3 QUIT
+4 ;
+5 ;
+6 ; <<<<<<<<<<<<<<< Entry points for Customer Service >>>>>>>>>>>>>>>
+7 ;
SET(SDPKG) ; -- set override for package namespace
+1 Press return to continue: if '$$VALID($GET(SDPKG))
QUIT
+2 IF '$DATA(^XTMP("SD*5.3*132 OVERRIDE FLAGS",0))
SET ^XTMP("SD*5.3*132 OVERRIDE FLAGS",0)="2991231^"_DT_"^Patch SD*5.3*132 Package Override Flags"
+3 SET ^XTMP("SD*5.3*132 OVERRIDE FLAGS",SDPKG)=1
+4 WRITE " ...override set for '",SDPKG,"'",!
+5 QUIT
+6 ;
KILL(SDPKG) ; -- kill override for package namespace
+1 if '$$VALID($GET(SDPKG))
QUIT
+2 KILL ^XTMP("SD*5.3*132 OVERRIDE FLAGS",SDPKG)
+3 IF $ORDER(^XTMP("SD*5.3*132 OVERRIDE FLAGS",0))=""
KILL ^XTMP("SD*5.3*132 OVERRIDE FLAGS")
+4 WRITE " ...override killed for '",SDPKG,"'",!
+5 QUIT
+6 ;
KILLALL ; -- kill overrides for all package namespaces
+1 KILL ^XTMP("SD*5.3*132 OVERRIDE FLAGS")
+2 WRITE " ...killed",!
+3 QUIT
+4 ;
