BDGP16PS ;ihs/cmi/maw - PIMS Patch 1016 post init
;;5.3;PIMS;**1016**;MAY 28, 2004;Build 20
;
ENV ;-- environment check
I '$$INSTALLD("PIMS*5.3*1015") D SORRY(2)
I '$$INSTALLD("BJPC*2.0*9") D SORRY(2)
I '$$INSTALLD("TIU*1.0*1010") D SORRY(2)
Q
;
CLNPAH ;-- clean out existing entries before loading new
S DA=0 F S DA=$O(^BDGPAH(DA)) Q:'DA D
. S DIK="^BDGPAH("
. D ^DIK
K DIK,DA
Q
;
POST ;-- patch 1016 post init
D ENPF
D PAH
D MAIN^BSDSCDUP
Q
;
ENPF ;-- enable patient flags for sites already using
Q:+$P($G(^DGPF(26.13,0)),U,4)=0
N PDA
S PDA=0 F S PDA=$O(^DG(40.8,PDA)) Q:'PDA D
. N FDA,FIENS,FERR
. S FIENS=PDA_","
. S FDA(40.8,FIENS,26.01)=1
. S FDA(40.8,FIENS,26.02)=DT
. S FDA(40.8,FIENS,26.03)=$G(DUZ)
. D FILE^DIE("K","FDA","FERR(1)")
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
;
BDGP16PS ;ihs/cmi/maw - PIMS Patch 1016 post init
+1 ;;5.3;PIMS;**1016**;MAY 28, 2004;Build 20
+2 ;
ENV ;-- environment check
+1 IF '$$INSTALLD("PIMS*5.3*1015")
DO SORRY(2)
+2 IF '$$INSTALLD("BJPC*2.0*9")
DO SORRY(2)
+3 IF '$$INSTALLD("TIU*1.0*1010")
DO SORRY(2)
+4 QUIT
+5 ;
CLNPAH ;-- clean out existing entries before loading new
+1 SET DA=0
FOR
SET DA=$ORDER(^BDGPAH(DA))
IF 'DA
QUIT
Begin DoDot:1
+2 SET DIK="^BDGPAH("
+3 DO ^DIK
End DoDot:1
+4 KILL DIK,DA
+5 QUIT
+6 ;
POST ;-- patch 1016 post init
+1 DO ENPF
+2 DO PAH
+3 DO MAIN^BSDSCDUP
+4 QUIT
+5 ;
ENPF ;-- enable patient flags for sites already using
+1 IF +$PIECE($GET(^DGPF(26.13,0)),U,4)=0
QUIT
+2 NEW PDA
+3 SET PDA=0
FOR
SET PDA=$ORDER(^DG(40.8,PDA))
IF 'PDA
QUIT
Begin DoDot:1
+4 NEW FDA,FIENS,FERR
+5 SET FIENS=PDA_","
+6 SET FDA(40.8,FIENS,26.01)=1
+7 SET FDA(40.8,FIENS,26.02)=DT
+8 SET FDA(40.8,FIENS,26.03)=$GET(DUZ)
+9 DO FILE^DIE("K","FDA","FERR(1)")
End DoDot:1
+10 QUIT
+11 ;
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 ;
