SD132EN.m

SD132EN ;ALB/MJK - Patch SD*5.3*132 Environmental Check Routine ; 11/5/97

 ;;5.3;Scheduling;**132,1015**;Aug 13, 1993;Build 21

 ;

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

 ;

SD132EN   ;ALB/MJK - Patch SD*5.3*132 Environmental Check Routine ; 11/5/97

 +1       ;;5.3;Scheduling;**132,1015**;Aug 13, 1993;Build 21

 +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

 +3        QUIT 

 +4       ;

 +5       ;

 +6       ; <<<<<<<<<<<<<<< Entry points for Customer Service >>>>>>>>>>>>>>>

 +7       ;

SET(SDPKG) ; -- set override for package namespace

 +1        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)

               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       ;