source: IHS-VA_UTILITIES-XB/XBFIXL1.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: 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.