source: IHS-VA_UTILITIES-XB/trunk/XBFIXL1.m@ 1239

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

Modified directory structure; moved routines.

File size: 3.2 KB
Line 
1XBFIXL1 ; IHS/ADC/GTH - STANDARDIZE LINE 1 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 programmer information and standardizes
7 ; the format of the first line of each routine.
8 ;
9 ; The form of the first line will be as follows:
10 ;
11 ; label ; agency/site/developer - comment ; edit date E.G.
12 ; XBFIXL1 ; IHS/ADC/GTH - FIX LINE 1 ; [ 11/08/90 10:41 AM ]
13 ;
14START ;
15 NEW ASK,QUIT,RTN
16 S QUIT=0
17 D ^XBKTMP,^XBKVAR
18 X ^%ZOSF("RSEL")
19 I $D(^UTILITY($J,"XBFIXL1")) W !,"^XBFIXL1 cannot modify itself. Ignored." KILL ^UTILITY($J,"XBFIXL1")
20 G:$O(^UTILITY($J,""))="" EOJ
21 S XBPI=$$DIR^XBDIR("F^9:20","Enter agency/site/programmer","","","E.G IHS/OHPRD/ACC")
22 G:$D(DIRUT) EOJ
23 ;S XBRTN="";IHS/SET/GTH XB*3*9 10/29/2002
24 S XBRTN=0 ;IHS/SET/GTH XB*3*9 10/29/2002
25 F S XBRTN=$O(^UTILITY($J,XBRTN)) Q:XBRTN="" D CHECK Q:QUIT
26 G EOJ
27 ;
28CHECK ;
29 KILL ^TMP("XBFIXL1",$J)
30 S DIF="^TMP(""XBFIXL1"",$J,",XCNP=0,X=XBRTN
31 X ^%ZOSF("LOAD")
32 S XBL1=^TMP("XBFIXL1",$J,1,0)
33 I $E($P(XBL1," ",2))'=";" W !!,XBRTN," - line 1 contains code and must be changed manually. Skipping" Q
34 S XBSAVE=XBL1
35 D MODIFY
36REVER ;
37 D VERIFY
38 Q:QUIT
39 D:Y="R" FIX
40 I QUIT S XBL1=XBSAVE G REVER
41 I XBL1]"" S ^TMP("XBFIXL1",$J,1,0)=XBL1,DIE=DIF,XCN=0,X=XBRTN X ^%ZOSF("SAVE")
42 Q
43 ;
44MODIFY ; Modify Line 1.
45 S XBTAG=$P(XBL1," "),X=$P(XBL1,";",2,99)
46 D EXTDATE
47 F Q:$E(X)'=" " S X=$E(X,2,$L(X))
48 S:$P(X,";")?." " $P(X,";")=XBPI_" - NO DESCRIPTION PROVIDED"
49 S %=$P(X,";")
50 I %'["-",$P(%," ")?1A.AN1"/"1A.AN.E S $P(%," ")=$P(%," ")_" - ",$P(X,";")=%
51 F S %=$F(X,";") Q:'% S X=$E(X,1,%-2)_" "_$E(X,%,$L(X))
52 F S %=$F(X," ") Q:'% S X=$E(X,1,%-3)_" "_$E(X,%,$L(X))
53 S:$E(X)=" " X=$E(X,2,$L(X)) S:$E(X,$L(X))=" " X=$E(X,1,$L(X)-1)
54 I X["-" S %=$P($P(X,"-")," ") S %=(%["/")*(1+($P($P(X,"-"),%,2)?." ")) S:%=1 $P(X," ")=XBPI_" -" S:%=2 $P(X,"-")=XBPI_" " S:'% X=XBPI_" - "_X
55 I X'["-" S X=XBPI_" - "_X
56 S XBL1=XBTAG_" ; "_X_" ;"_$S(XBDATE]"":" [ "_XBDATE_" ]",1:"")
57 Q
58 ;
59EXTDATE ; Extract date and remove from Line.
60 S XBNP=$L(X,";"),XBLP=$P(X,";",XBNP)
61 F XBPAT=("1.2N1""/""1.2N1""/""2.4N"),("1.2N1"" ""3A1"" ""2.4N"),("1.2N1""-""3A1""-""2.4N") S XBLDT=$$GETPATRN^XBFUNC(XBLP,XBPAT) Q:XBLDT]""
62 I XBLDT="" S XBDATE="" Q
63 S XBLTM=$$GETPATRN^XBFUNC($P(XBLP,XBLDT,2),"1.2N1"":""1.2N1"" ""2A")
64 S:XBLTM]"" XBLDT=XBLDT_" "_XBLTM
65 S XBLP=$P(XBLP,XBLDT)_$P(XBLP,XBLDT,2)
66 S XBLDJ=$$FNDPATRN^XBFUNC(XBLP,"."" ""1""["".E1""]"".E")
67 S:XBLDJ XBLP=$E(XBLP,1,XBLDJ-1)
68 S $P(X,";",XBNP)=XBLP
69 S XBDATE=XBLDT
70 Q
71 ;
72VERIFY ; Ask user to verify mod.
73 W !!,XBRTN,!," from: ",XBSAVE,!," to: ",XBL1
74 S Y=$$DIR^XBDIR("S^A:Accept;R:Replace;S:Skip","","A","","Accept the proposed modification; Replace the proposal with your own line; Skip the routine")
75 S:$D(DIRUT) QUIT=1
76 S:Y="S" XBL1=""
77 Q
78 ;
79FIX ; Get comment from user.
80 S X=$$DIR^XBDIR("F^5:40","Enter comment to follow agency/site/programmer ")
81 S:$D(DIRUT) QUIT=1
82 S $P(XBL1,";",2)=XBPI_" - "_X
83 Q
84 ;
85EOJ ;
86 D ^XBKTMP
87 KILL DIF,XCNP,DIE,XCN
88 KILL %,X,Y,^UTILITY($J)
89 KILL DTOUT,DUOUT,DIRUT,DIROUT
90 KILL XBDATE,XBL1,XBLDJ,XBLDT,XBLP,XBLTM,XBNP,XBPAT,XBPI,XBRTN,XBSAVE,XBTAG
91 Q
92 ;
Note: See TracBrowser for help on using the repository browser.