| [641] | 1 | XBKIDS ; IHS/ASDST/GTH - KIDS UTILITIES ; [ 10/29/2002 7:42 AM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;
|
|---|
| 4 | ; IHS/SET/GTH XB*3*9 10/29/2002
|
|---|
| 5 | ;
|
|---|
| 6 | ; --------------------
|
|---|
| 7 | ;
|
|---|
| 8 | VCHK(XBPRE,XBVER,XBQUIT) ;PEP - For environment check routines.
|
|---|
| 9 | ; Pass "PREFIX","Version","XPDQUIT_value".
|
|---|
| 10 | ; E.g.: Q:'$$VCHK^XBKIDS("AG",5.4,2)
|
|---|
| 11 | ;
|
|---|
| 12 | NEW XBV
|
|---|
| 13 | S XBV=$$VERSION^XPDUTL(XBPRE)
|
|---|
| 14 | W !,$$CJ^XLFSTR("Need at least "_XBPRE_" v "_XBVER_"....."_XBPRE_" v "_XBV_" Present",IOM)
|
|---|
| 15 | I XBV<XBVER KILL DIFQ S XPDQUIT=XBQUIT W *7,!,$$CJ^XLFSTR("Sorry....",IOM) S XBV=$$DIR^XBDIR("E","Press RETURN") Q 0
|
|---|
| 16 | Q 1
|
|---|
| 17 | ;
|
|---|
| 18 | ; --------------------
|
|---|
| 19 | ;
|
|---|
| 20 | P(XBP) ;PEP - Determine if patch XBP was installed.
|
|---|
| 21 | ; XBP must be in standard patch naming format. E.g. "AG*6.0*13"
|
|---|
| 22 | ; ^DIC(9.4,D0,22,D1,PAH,D2,0)=
|
|---|
| 23 | ; (#.01) PATCH APPLICATION HISTORY [1F] ^ (#.02)DATE APPLIED [2D] ^ (#.03) APPLIED BY [3P] ^
|
|---|
| 24 | ;
|
|---|
| 25 | NEW D,DIC,X,XB,Y
|
|---|
| 26 | S X=$P(XBP,"*",1),DIC="^DIC(9.4,",DIC(0)="F",D="C"
|
|---|
| 27 | D IX^DIC
|
|---|
| 28 | I Y<1 Q "PREFIX '"_$P(XBP,"*",1)_"' NOT FOUND IN PACKAGE FILE."
|
|---|
| 29 | S XB="^DIC(9.4,"_(+Y)_","
|
|---|
| 30 | ;
|
|---|
| 31 | KILL D
|
|---|
| 32 | S DIC=DIC_+Y_",22,",X=$P(XBP,"*",2)
|
|---|
| 33 | D ^DIC
|
|---|
| 34 | I Y<1 Q "VERSION '"_$P(XBP,"*",2)_"' NOT FOUND IN PACKAGE FILE."
|
|---|
| 35 | S XB=XB_"22,"_(+Y)_","
|
|---|
| 36 | ;
|
|---|
| 37 | S DIC=DIC_+Y_",""PAH"",",X=$P(XBP,"*",3)
|
|---|
| 38 | D ^DIC
|
|---|
| 39 | Q $S(Y>0:XB_"""PAH"","_(+Y)_",",1:"PATCH NUMBER '"_$P(XBP,"*",3)_"' NOT FOUND IN PACKAGE FILE.")
|
|---|
| 40 | ;
|
|---|
| 41 | ; --------------------
|
|---|
| 42 | ;
|
|---|
| 43 | ; OPTSAV() and OPTRES() are provided b/c if an option of type "menu"
|
|---|
| 44 | ; is included in a KIDS transport and install, the existing option
|
|---|
| 45 | ; is overwritten, thereby destroying any local modifications.
|
|---|
| 46 | ;
|
|---|
| 47 | ; Further, if an option of type "menu" is included in a KIDS transport
|
|---|
| 48 | ; and install, -all- the options on that option of type "menu" -must-
|
|---|
| 49 | ; be included in the KIDS transport, whether they are changed, or not.
|
|---|
| 50 | ;
|
|---|
| 51 | ; The value of XB2SUB is provided by the calling routine, and has no
|
|---|
| 52 | ; particular meaning.
|
|---|
| 53 | ;
|
|---|
| 54 | ; E.g.: D OPTSAV^XBKIDS("AGMENU","Cochise")
|
|---|
| 55 | ; D OPTRES^XBKIDS("AGMENU","Cochise")
|
|---|
| 56 | ;
|
|---|
| 57 | OPTSAV(XBM,XB2SUB) ;PEP - Save the menu portion of an option.
|
|---|
| 58 | I $D(^XTMP("XBKIDS",XB2SUB,"OPTSAV",XBM)) D BMES^XPDUTL("NOT SAVED. Option '"_XBM_"' has previously been saved.") Q
|
|---|
| 59 | I '$D(^XTMP("XBKIDS")) S ^XTMP("XBKIDS",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"XBKIDS - SAVE OPTION CONFIGURATIONS."
|
|---|
| 60 | NEW I,A
|
|---|
| 61 | S I=$O(^DIC(19,"B",XBM,0))
|
|---|
| 62 | I 'I D BMES^XPDUTL("NOT SAVED. Option '"_XBM_"' not found in OPTION file.") Q
|
|---|
| 63 | S A=0
|
|---|
| 64 | 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)
|
|---|
| 65 | Q
|
|---|
| 66 | ;
|
|---|
| 67 | ; --------------------
|
|---|
| 68 | ;
|
|---|
| 69 | OPTRES(XBM,XB2SUB) ; PEP - Restore the menu portion of an option.
|
|---|
| 70 | NEW XB,XBI
|
|---|
| 71 | I '$D(^XTMP("XBKIDS",XB2SUB,"OPTSAV",XBM)) D BMES^XPDUTL("FAILED. Option '"_XBM_"' was not previously saved.") Q
|
|---|
| 72 | S XB=0
|
|---|
| 73 | 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_".")
|
|---|
| 74 | Q
|
|---|
| 75 | ;
|
|---|
