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

XBKIDS.m

Go to the documentation of this file. 
  1. XBKIDS ; IHS/ASDST/GTH - KIDS UTILITIES ; [ 10/29/2002   7:42 AM ]
  1.  ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
  1.  ;
  1.  ; IHS/SET/GTH XB*3*9 10/29/2002
  1.  ;
  1.  ; --------------------
  1.  ;
  1. VCHK(XBPRE,XBVER,XBQUIT) ;PEP - For environment check routines.
  1.  ; Pass "PREFIX","Version","XPDQUIT_value".
  1.  ; E.g.:  Q:'$$VCHK^XBKIDS("AG",5.4,2)
  1.  ;  
  1.  NEW XBV
  1.  S XBV=$$VERSION^XPDUTL(XBPRE)
  1.  W !,$$CJ^XLFSTR("Need at least "_XBPRE_" v "_XBVER_"....."_XBPRE_" v "_XBV_" Present",IOM)
  1.  I XBV<XBVER KILL DIFQ S XPDQUIT=XBQUIT W *7,!,$$CJ^XLFSTR("Sorry....",IOM) S XBV=$$DIR^XBDIR("E","Press RETURN") Q 0
  1.  Q 1
  1.  ;
  1.  ; --------------------
  1.  ;
  1. P(XBP) ;PEP - Determine if patch XBP was installed.
  1.  ; XBP must be in standard patch naming format.  E.g. "AG*6.0*13"
  1.  ; ^DIC(9.4,D0,22,D1,PAH,D2,0)=
  1.  ; (#.01) PATCH APPLICATION HISTORY [1F] ^ (#.02)DATE APPLIED [2D] ^ (#.03) APPLIED BY [3P] ^ 
  1.  ;
  1.  NEW D,DIC,X,XB,Y
  1.  S X=$P(XBP,"*",1),DIC="^DIC(9.4,",DIC(0)="F",D="C"
  1.  D IX^DIC
  1.  I Y<1 Q "PREFIX '"_$P(XBP,"*",1)_"' NOT FOUND IN PACKAGE FILE."
  1.  S XB="^DIC(9.4,"_(+Y)_","
  1.  ;
  1.  KILL D
  1.  S DIC=DIC_+Y_",22,",X=$P(XBP,"*",2)
  1.  D ^DIC
  1.  I Y<1 Q "VERSION '"_$P(XBP,"*",2)_"' NOT FOUND IN PACKAGE FILE."
  1.  S XB=XB_"22,"_(+Y)_","
  1.  ;
  1.  S DIC=DIC_+Y_",""PAH"",",X=$P(XBP,"*",3)
  1.  D ^DIC
  1.  Q $S(Y>0:XB_"""PAH"","_(+Y)_",",1:"PATCH NUMBER '"_$P(XBP,"*",3)_"' NOT FOUND IN PACKAGE FILE.")
  1.  ;
  1.  ; --------------------
  1.  ;
  1.  ; OPTSAV() and OPTRES() are provided b/c if an option of type "menu"
  1.  ; is included in a KIDS transport and install, the existing option
  1.  ; is overwritten, thereby destroying any local modifications.
  1.  ;
  1.  ; Further, if an option of type "menu" is included in a KIDS transport
  1.  ; and install, -all- the options on that option of type "menu" -must-
  1.  ; be included in the KIDS transport, whether they are changed, or not.
  1.  ;
  1.  ; The value of XB2SUB is provided by the calling routine, and has no
  1.  ; particular meaning.
  1.  ;
  1.  ; E.g.:  D OPTSAV^XBKIDS("AGMENU","Cochise")
  1.  ;        D OPTRES^XBKIDS("AGMENU","Cochise")
  1.  ;
  1. OPTSAV(XBM,XB2SUB) ;PEP - Save the menu portion of an option.
  1.  I $D(^XTMP("XBKIDS",XB2SUB,"OPTSAV",XBM)) D BMES^XPDUTL("NOT SAVED.  Option '"_XBM_"' has previously been saved.") Q
  1.  I '$D(^XTMP("XBKIDS")) S ^XTMP("XBKIDS",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"XBKIDS - SAVE OPTION CONFIGURATIONS."
  1.  NEW I,A
  1.  S I=$O(^DIC(19,"B",XBM,0))
  1.  I 'I D BMES^XPDUTL("NOT SAVED.  Option '"_XBM_"' not found in OPTION file.") Q
  1.  S A=0
  1.  F  S A=$O(^DIC(19,I,10,A)) Q:'A  S ^XTMP("XBKIDS",XB2SUB,"OPTSAV",XBM,A)=$P(^DIC(19,+^DIC(19,I,10,A,0),0),U,1)_U_$P(^DIC(19,I,10,A,0),U,2,3)
  1.  Q
  1.  ;
  1.  ; --------------------
  1.  ;
  1. OPTRES(XBM,XB2SUB) ; PEP - Restore the menu portion of an option.
  1.  NEW XB,XBI
  1.  I '$D(^XTMP("XBKIDS",XB2SUB,"OPTSAV",XBM)) D BMES^XPDUTL("FAILED.  Option '"_XBM_"' was not previously saved.") Q
  1.  S XB=0
  1.  F  S XB=$O(^XTMP("XBKIDS",XB2SUB,"OPTSAV",XBM,XB)) Q:'XB  S XBI=^(XB) I '$$ADD^XPDMENU(XBM,$P(XBI,U,1),$P(XBI,U,2),$P(XBI,U,3)) D BMES^XPDUTL("....FAILED to re-atch "_$P(XBI,U,1)_" to "_XBM_".")
  1.  Q
  1.  ;