source: IHS-VA_UTILITIES-XB/XBVLINE.m@ 641

Last change on this file since 641 was 641, checked in by Sam Habiel, 14 years ago

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.

File size: 2.4 KB
Line 
1XBVLINE ; IHS/ADC/GTH - SET LINE TWO OF SELECTED ROUTINES ; [ 10/29/2002 7:42 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
4 ;
5 ; This routine asks user to select a set of routines, asks
6 ; the user for the version number, package, and the date,
7 ; and sets the second line of each routine.
8 ;
9 ; The form of the version line will be as follows:
10 ;
11 ;;n;package name;patch level;date E.G.
12 ;;1.1;PCC DATA ENTRY;**1,2**;Sep 9, 1989
13 ;
14START ;
15 NEW ASK,QUIT,RTN
16 KILL ^UTILITY($J)
17 D ^XBKVAR
18 X ^%ZOSF("RSEL")
19 I $D(^UTILITY($J,"XBVLINE")) W !,"Can't do ^XBVLINE. Deleting." KILL ^UTILITY($J,"XBVLINE")
20 I $D(^UTILITY($J,"XB")) W !,"Can't do ^XB. Deleting." KILL ^UTILITY($J,"XB")
21 I $O(^UTILITY($J,""))="" D EOJ Q
22 S XBVLINE=" ;;"_$$DIR^XBDIR("F^1:5^K:'(X?1.3N!(X?1.3N.1""."".2N.1A.2N)) X","Enter version number","","","Must be n or n.n or n.nAn where the length of n is 1-3 and A is an alpha character")
23 I $D(DIRUT) D EOJ Q
24 S XBVLINE=XBVLINE_";"_$$DIR^XBDIR("FO^2:30","Enter package name")
25 I $D(DIRUT) D EOJ Q
26 S X=$$DIR^XBDIR("FO^0:20","Enter patch level")
27 I $D(DUOUT)!$D(DTOUT) D EOJ Q
28 S XBVLINE=XBVLINE_$S(X="":";",1:";**"_X_"**")
29 ;begin Y2K fix block
30 ;S Y=$$DIR^XBDIR("D","Enter date","TODAY")
31 S Y=$$DIR^XBDIR("D^::E","Enter date","TODAY")
32 ; end Y2K fix block
33 I $D(DIRUT) D EOJ Q
34 D DD^%DT
35 S XBVLINE=XBVLINE_";"_Y
36 S ASK=$$DIR^XBDIR("YO","Do you want to be asked ok for each routine","NO","","If you say 'YES' you will be asked if it is ok before each routine is modified.")
37 I $D(DIRUT) D EOJ Q
38 F %=1:1:6 S X=$P($T(@("LINE"_%)),";;",2),@("XBVLINE("_%_")=X")
39 KILL %,X,Y
40 X XBVLINE(1)
41 Q
42 ;
43EOJ ;
44 KILL %,X,Y,XBVLINE,^UTILITY($J),DTOUT,DUOUT,DIRUT,DIROUT
45 Q
46 ;IHS/SET/GTH XB*3*9 10/29/2002 Mod'd LINE2 to seed RTN with 0 vs "".
47LINE1 ;;X XBVLINE(2),XBVLINE(5)
48LINE2 ;;S QUIT=0,RTN=0 F S RTN=$O(^UTILITY($J,RTN)) Q:RTN="" W !,RTN ZL @RTN X XBVLINE(6) ZR @Y ZI X S X=$T(+2),Z=$P(X," ")_XBVLINE X XBVLINE(3):'ASK,XBVLINE(4):ASK Q:QUIT I X ZI Z:+1 ZS
49LINE3 ;;S X=$P(X," ",2,99),X=X?1.2";".1"V"1.N.E ZR:X +2 S X=1
50LINE4 ;;W !,X S DIR(0)="S^R:Replace;I:Insert;S:Skip",DIR("B")="R",DIR("?")="Replace the line; Insert before the line; Skip the routine" D ^DIR K DIR ZL @RTN ZR:Y="R" +2 S:$D(DIRUT) Y="S",QUIT=1 S X=Y'="S"
51LINE5 ;;K %,XBVLINE,DTOUT,DUOUT,DIRUT,DIROUT,X,Y,Z,^UTILITY($J)
52LINE6 ;;S X=$T(+1),X=$P(X,"["),Y=$L(X,";") S Y=$P(X,$S(X?1.8U1"(".E:"(",1:" "),1)
Note: See TracBrowser for help on using the repository browser.