| [641] | 1 | XBVLINE ; 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 | ;
|
|---|
| 14 | START ;
|
|---|
| 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 | ;
|
|---|
| 43 | EOJ ;
|
|---|
| 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 "".
|
|---|
| 47 | LINE1 ;;X XBVLINE(2),XBVLINE(5)
|
|---|
| 48 | LINE2 ;;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
|
|---|
| 49 | LINE3 ;;S X=$P(X," ",2,99),X=X?1.2";".1"V"1.N.E ZR:X +2 S X=1
|
|---|
| 50 | LINE4 ;;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"
|
|---|
| 51 | LINE5 ;;K %,XBVLINE,DTOUT,DUOUT,DIRUT,DIROUT,X,Y,Z,^UTILITY($J)
|
|---|
| 52 | LINE6 ;;S X=$T(+1),X=$P(X,"["),Y=$L(X,";") S Y=$P(X,$S(X?1.8U1"(".E:"(",1:" "),1)
|
|---|
