source: IHS-VA_UTILITIES-XB/trunk/XBKIDS.m@ 1799

Last change on this file since 1799 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 2.9 KB
Line 
1XBKIDS ; 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 ;
8VCHK(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 ;
20P(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 ;
57OPTSAV(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 ;
69OPTRES(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 ;
Note: See TracBrowser for help on using the repository browser.