BDGP15PS.m

BDGP15PS ;ihs/cmi/maw - PIMS Patch 1015 post init

 ;;5.3;PIMS;**1015**;MAY 28, 2004;Build 21

 ;

ENV ;-- environment check

 I '$$INSTALLD("PIMS*5.3*1014") D SORRY(2)

 I '$$INSTALLD("BJPC*2.0*9") D SORRY(2)

 Q

 ;

POST ;--patch 1015 post init

 D RCIT("SDAMXOE","SD ENCOUNTER ENTRY",15000)

 D RCIT("SDAMXLG","SD ENCOUNTER LOG",15000)

 D PAH

 Q

 ;

RCIT(X,IT,DMAX) ;-- recompile an input template

 S Y=$O(^DIE("B",IT,0))

 Q:'Y

 D EN^DIEZ

 Q

 ;

PAH ;-- update the Patch Application History

 N BDA,BDGDATA,BDGDG,BDGDGS,BDGSD,BDGSDS,BDG,BDG53,BSD,BSD53

 S BDG=$O(^DIC(9.4,"C","DG",0))

 Q:'BDG

 S BDG53=$O(^DIC(9.4,BDG,22,"B",5.3,0))

 Q:'BDG53

 S BSD=$O(^DIC(9.4,"C","SD",0))

 Q:'BSD

 S BSD53=$O(^DIC(9.4,BSD,22,"B",5.3,0))

 Q:'BSD53

 D NOW^%DTC

 S BDGNOW=$S(%:%,1:DT)

 W !,"Updating DG and SD Package file entries for Patch Application History"

 S BDA=0 F  S BDA=$O(^BDGPAH(BDA)) Q:'BDA  D

 . S BDGDATA=$G(^BDGPAH(BDA,0))

 . S BDGDGS=$P(BDGDATA,U)

 . S BDGDG=$P(BDGDATA,U,2)

 . W "."

 . D DGUP(BDG,BDG53,BDGDG,BDGDGS)

 . S BDGSDS=$P(BDGDATA,U,3)

 . S BDGSD=$P(BDGDATA,U,4)

 . Q:'BDGSD

 . W "."

 . D SDUP(BSD,BSD53,BDGSD,BDGSDS)

 K BDGNOW

 Q

 ;

DGUP(DG,DG53,DGDG,DGDGS) ;--update DG PAH node

 N CDA,MATCH,STR

 S MATCH=0

 S CDA=0 F  S CDA=$O(^DIC(9,4,DG,22,DG53,"PAH",CDA)) Q:'CDA  D

 . I $P(CDA," ")=DGDG S MATCH=1

 Q:$G(MATCH)

 N DDA,DIENS,DERR

 S DIENS(2)=DG

 S DIENS(1)=DG53

 S DIENS="+3,"_DG53_","_DG_","

 S STR=DGDG_" SEQ #"_DGDGS

 S DDA(9.4901,DIENS,.01)=STR

 S DDA(9.4901,DIENS,.02)=BDGNOW

 S DDA(9.4901,DIENS,.03)=DUZ

 D UPDATE^DIE("","DDA","DIENS","DERR(1)")

 Q

 ;

SDUP(SD,SD53,SDSD,SDSDS) ;update SD PAH node

 N CDA,MATCH,STR

 S MATCH=0

 S CDA=0 F  S CDA=$O(^DIC(9,4,SD,22,SD53,"PAH",CDA)) Q:'CDA  D

 . I $P(CDA," ")=SDSD S MATCH=1

 Q:$G(MATCH)

 N DDA,DIENS,DERR

 S DIENS(2)=SD

 S DIENS(1)=SD53

 S DIENS="+3,"_SD53_","_SD_","

 S STR=SDSD_" SEQ #"_SDSDS

 S DDA(9.4901,DIENS,.01)=STR

 S DDA(9.4901,DIENS,.02)=BDGNOW

 S DDA(9.4901,DIENS,.03)=DUZ

 D UPDATE^DIE("","DDA","DIENS","DERR(1)")

 Q

 ;

INSTALLD(BDGSTAL) ;EP - Determine if patch BDGSTAL was installed, where

 ; BDGSTAL is the name of the INSTALL.  E.g "AG*6.0*11".

 ;

 NEW BDGY,DIC,X,Y

 S X=$P(BDGSTAL,"*",1)

 S DIC="^DIC(9.4,",DIC(0)="FM",D="C"

 D IX^DIC

 I Y<1 D IMES Q 0

 S DIC=DIC_+Y_",22,",X=$P(BDGSTAL,"*",2)

 D ^DIC

 I Y<1 D IMES Q 0

 S DIC=DIC_+Y_",""PAH"",",X=$P(BDGSTAL,"*",3)

 D ^DIC

 S BDGY=Y

 D IMES

 Q $S(BDGY<1:0,1:1)

IMES ;

 D MES^XPDUTL($$CJ^XLFSTR("Patch """_BDGSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" Present.",IOM))

 Q

SORRY(X) ;

 KILL DIFQ

 I X=3 S XPDQUIT=2 Q

 S XPDQUIT=X

 W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)

 Q

 ;

BDGP15PS  ;ihs/cmi/maw - PIMS Patch 1015 post init

 +1       ;;5.3;PIMS;**1015**;MAY 28, 2004;Build 21

 +2       ;

ENV       ;-- environment check

 +1        IF '$$INSTALLD("PIMS*5.3*1014")

               DO SORRY(2)

 +2        IF '$$INSTALLD("BJPC*2.0*9")

               DO SORRY(2)

 +3        QUIT 

 +4       ;

POST      ;--patch 1015 post init

 +1        DO RCIT("SDAMXOE","SD ENCOUNTER ENTRY",15000)

 +2        DO RCIT("SDAMXLG","SD ENCOUNTER LOG",15000)

 +3        DO PAH

 +4        QUIT 

 +5       ;

RCIT(X,IT,DMAX) ;-- recompile an input template

 +1        SET Y=$ORDER(^DIE("B",IT,0))

 +2        IF 'Y

               QUIT 

 +3        DO EN^DIEZ

 +4        QUIT 

 +5       ;

PAH       ;-- update the Patch Application History

 +1        NEW BDA,BDGDATA,BDGDG,BDGDGS,BDGSD,BDGSDS,BDG,BDG53,BSD,BSD53

 +2        SET BDG=$ORDER(^DIC(9.4,"C","DG",0))

 +3        IF 'BDG

               QUIT 

 +4        SET BDG53=$ORDER(^DIC(9.4,BDG,22,"B",5.3,0))

 +5        IF 'BDG53

               QUIT 

 +6        SET BSD=$ORDER(^DIC(9.4,"C","SD",0))

 +7        IF 'BSD

               QUIT 

 +8        SET BSD53=$ORDER(^DIC(9.4,BSD,22,"B",5.3,0))

 +9        IF 'BSD53

               QUIT 

 +10       DO NOW^%DTC

 +11       SET BDGNOW=$SELECT(%:%,1:DT)

 +12       WRITE !,"Updating DG and SD Package file entries for Patch Application History"

 +13       SET BDA=0

           FOR 

               SET BDA=$ORDER(^BDGPAH(BDA))

               IF 'BDA

                   QUIT 

               Begin DoDot:1

 +14               SET BDGDATA=$GET(^BDGPAH(BDA,0))

 +15               SET BDGDGS=$PIECE(BDGDATA,U)

 +16               SET BDGDG=$PIECE(BDGDATA,U,2)

 +17               WRITE "."

 +18               DO DGUP(BDG,BDG53,BDGDG,BDGDGS)

 +19               SET BDGSDS=$PIECE(BDGDATA,U,3)

 +20               SET BDGSD=$PIECE(BDGDATA,U,4)

 +21               IF 'BDGSD

                       QUIT 

 +22               WRITE "."

 +23               DO SDUP(BSD,BSD53,BDGSD,BDGSDS)

               End DoDot:1

 +24       KILL BDGNOW

 +25       QUIT 

 +26      ;

DGUP(DG,DG53,DGDG,DGDGS) ;--update DG PAH node

 +1        NEW CDA,MATCH,STR

 +2        SET MATCH=0

 +3        SET CDA=0

           FOR 

               SET CDA=$ORDER(^DIC(9,4,DG,22,DG53,"PAH",CDA))

               IF 'CDA

                   QUIT 

               Begin DoDot:1

 +4                IF $PIECE(CDA," ")=DGDG

                       SET MATCH=1

               End DoDot:1

 +5        IF $GET(MATCH)

               QUIT 

 +6        NEW DDA,DIENS,DERR

 +7        SET DIENS(2)=DG

 +8        SET DIENS(1)=DG53

 +9        SET DIENS="+3,"_DG53_","_DG_","

 +10       SET STR=DGDG_" SEQ #"_DGDGS

 +11       SET DDA(9.4901,DIENS,.01)=STR

 +12       SET DDA(9.4901,DIENS,.02)=BDGNOW

 +13       SET DDA(9.4901,DIENS,.03)=DUZ

 +14       DO UPDATE^DIE("","DDA","DIENS","DERR(1)")

 +15       QUIT 

 +16      ;

SDUP(SD,SD53,SDSD,SDSDS) ;update SD PAH node

 +1        NEW CDA,MATCH,STR

 +2        SET MATCH=0

 +3        SET CDA=0

           FOR 

               SET CDA=$ORDER(^DIC(9,4,SD,22,SD53,"PAH",CDA))

               IF 'CDA

                   QUIT 

               Begin DoDot:1

 +4                IF $PIECE(CDA," ")=SDSD

                       SET MATCH=1

               End DoDot:1

 +5        IF $GET(MATCH)

               QUIT 

 +6        NEW DDA,DIENS,DERR

 +7        SET DIENS(2)=SD

 +8        SET DIENS(1)=SD53

 +9        SET DIENS="+3,"_SD53_","_SD_","

 +10       SET STR=SDSD_" SEQ #"_SDSDS

 +11       SET DDA(9.4901,DIENS,.01)=STR

 +12       SET DDA(9.4901,DIENS,.02)=BDGNOW

 +13       SET DDA(9.4901,DIENS,.03)=DUZ

 +14       DO UPDATE^DIE("","DDA","DIENS","DERR(1)")

 +15       QUIT 

 +16      ;

INSTALLD(BDGSTAL) ;EP - Determine if patch BDGSTAL was installed, where

 +1       ; BDGSTAL is the name of the INSTALL.  E.g "AG*6.0*11".

 +2       ;

 +3        NEW BDGY,DIC,X,Y

 +4        SET X=$PIECE(BDGSTAL,"*",1)

 +5        SET DIC="^DIC(9.4,"

           SET DIC(0)="FM"

           SET D="C"

 +6        DO IX^DIC

 +7        IF Y<1

               DO IMES

               QUIT 0

 +8        SET DIC=DIC_+Y_",22,"

           SET X=$PIECE(BDGSTAL,"*",2)

 +9        DO ^DIC

 +10       IF Y<1

               DO IMES

               QUIT 0

 +11       SET DIC=DIC_+Y_",""PAH"","

           SET X=$PIECE(BDGSTAL,"*",3)

 +12       DO ^DIC

 +13       SET BDGY=Y

 +14       DO IMES

 +15       QUIT $SELECT(BDGY<1:0,1:1)

IMES      ;

 +1        DO MES^XPDUTL($$CJ^XLFSTR("Patch """_BDGSTAL_""" is"_$SELECT(Y<1:" *NOT*",1:"")_" Present.",IOM))

 +2        QUIT 

SORRY(X)  ;

 +1        KILL DIFQ

 +2        IF X=3

               SET XPDQUIT=2

               QUIT 

 +3        SET XPDQUIT=X

 +4        WRITE *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)

 +5        QUIT 

 +6       ;