Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BDGP16PS

BDGP16PS.m

Go to the documentation of this file. 
  1. BDGP16PS ;ihs/cmi/maw - PIMS Patch 1016 post init
  1.  ;;5.3;PIMS;**1016**;MAY 28, 2004;Build 20
  1.  ;
  1. ENV ;-- environment check
  1.  I '$$INSTALLD("PIMS*5.3*1015") D SORRY(2)
  1.  I '$$INSTALLD("BJPC*2.0*9") D SORRY(2)
  1.  I '$$INSTALLD("TIU*1.0*1010") D SORRY(2)
  1.  Q
  1.  ;
  1. CLNPAH ;-- clean out existing entries before loading new
  1.  S DA=0 F  S DA=$O(^BDGPAH(DA)) Q:'DA  D
  1.  . S DIK="^BDGPAH("
  1.  . D ^DIK
  1.  K DIK,DA
  1.  Q
  1.  ;
  1. POST ;-- patch 1016 post init
  1.  D ENPF
  1.  D PAH
  1.  D MAIN^BSDSCDUP
  1.  Q
  1.  ;
  1. ENPF ;-- enable patient flags for sites already using
  1.  Q:+$P($G(^DGPF(26.13,0)),U,4)=0
  1.  N PDA
  1.  S PDA=0 F  S PDA=$O(^DG(40.8,PDA)) Q:'PDA  D
  1.  . N FDA,FIENS,FERR
  1.  . S FIENS=PDA_","
  1.  . S FDA(40.8,FIENS,26.01)=1
  1.  . S FDA(40.8,FIENS,26.02)=DT
  1.  . S FDA(40.8,FIENS,26.03)=$G(DUZ)
  1.  . D FILE^DIE("K","FDA","FERR(1)")
  1.  Q
  1.  ;
  1. PAH ;-- update the Patch Application History
  1.  N BDA,BDGDATA,BDGDG,BDGDGS,BDGSD,BDGSDS,BDG,BDG53,BSD,BSD53
  1.  S BDG=$O(^DIC(9.4,"C","DG",0))
  1.  Q:'BDG
  1.  S BDG53=$O(^DIC(9.4,BDG,22,"B",5.3,0))
  1.  Q:'BDG53
  1.  S BSD=$O(^DIC(9.4,"C","SD",0))
  1.  Q:'BSD
  1.  S BSD53=$O(^DIC(9.4,BSD,22,"B",5.3,0))
  1.  Q:'BSD53
  1.  D NOW^%DTC
  1.  S BDGNOW=$S(%:%,1:DT)
  1.  W !,"Updating DG and SD Package file entries for Patch Application History"
  1.  S BDA=0 F  S BDA=$O(^BDGPAH(BDA)) Q:'BDA  D
  1.  . S BDGDATA=$G(^BDGPAH(BDA,0))
  1.  . S BDGDGS=$P(BDGDATA,U)
  1.  . S BDGDG=$P(BDGDATA,U,2)
  1.  . W "."
  1.  . D DGUP(BDG,BDG53,BDGDG,BDGDGS)
  1.  . S BDGSDS=$P(BDGDATA,U,3)
  1.  . S BDGSD=$P(BDGDATA,U,4)
  1.  . Q:'BDGSD
  1.  . W "."
  1.  . D SDUP(BSD,BSD53,BDGSD,BDGSDS)
  1.  K BDGNOW
  1.  Q
  1.  ;
  1. DGUP(DG,DG53,DGDG,DGDGS) ;--update DG PAH node
  1.  N CDA,MATCH,STR
  1.  S MATCH=0
  1.  S CDA=0 F  S CDA=$O(^DIC(9,4,DG,22,DG53,"PAH",CDA)) Q:'CDA  D
  1.  . I $P(CDA," ")=DGDG S MATCH=1
  1.  Q:$G(MATCH)
  1.  N DDA,DIENS,DERR
  1.  S DIENS(2)=DG
  1.  S DIENS(1)=DG53
  1.  S DIENS="+3,"_DG53_","_DG_","
  1.  S STR=DGDG_" SEQ #"_DGDGS
  1.  S DDA(9.4901,DIENS,.01)=STR
  1.  S DDA(9.4901,DIENS,.02)=BDGNOW
  1.  S DDA(9.4901,DIENS,.03)=DUZ
  1.  D UPDATE^DIE("","DDA","DIENS","DERR(1)")
  1.  Q
  1.  ;
  1. SDUP(SD,SD53,SDSD,SDSDS) ;update SD PAH node
  1.  N CDA,MATCH,STR
  1.  S MATCH=0
  1.  S CDA=0 F  S CDA=$O(^DIC(9,4,SD,22,SD53,"PAH",CDA)) Q:'CDA  D
  1.  . I $P(CDA," ")=SDSD S MATCH=1
  1.  Q:$G(MATCH)
  1.  N DDA,DIENS,DERR
  1.  S DIENS(2)=SD
  1.  S DIENS(1)=SD53
  1.  S DIENS="+3,"_SD53_","_SD_","
  1.  S STR=SDSD_" SEQ #"_SDSDS
  1.  S DDA(9.4901,DIENS,.01)=STR
  1.  S DDA(9.4901,DIENS,.02)=BDGNOW
  1.  S DDA(9.4901,DIENS,.03)=DUZ
  1.  D UPDATE^DIE("","DDA","DIENS","DERR(1)")
  1.  Q
  1.  ;
  1. INSTALLD(BDGSTAL) ;EP - Determine if patch BDGSTAL was installed, where
  1.  ; BDGSTAL is the name of the INSTALL.  E.g "AG*6.0*11".
  1.  ;
  1.  NEW BDGY,DIC,X,Y
  1.  S X=$P(BDGSTAL,"*",1)
  1.  S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
  1.  D IX^DIC
  1.  I Y<1 D IMES Q 0
  1.  S DIC=DIC_+Y_",22,",X=$P(BDGSTAL,"*",2)
  1.  D ^DIC
  1.  I Y<1 D IMES Q 0
  1.  S DIC=DIC_+Y_",""PAH"",",X=$P(BDGSTAL,"*",3)
  1.  D ^DIC
  1.  S BDGY=Y
  1.  D IMES
  1.  Q $S(BDGY<1:0,1:1)
  1. IMES ;
  1.  D MES^XPDUTL($$CJ^XLFSTR("Patch """_BDGSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" Present.",IOM))
  1.  Q
  1. SORRY(X) ;
  1.  KILL DIFQ
  1.  I X=3 S XPDQUIT=2 Q
  1.  S XPDQUIT=X
  1.  W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
  1.  Q
  1.  ;