XBFIXL1	; IHS/ADC/GTH - STANDARDIZE LINE 1 OF SELECTED ROUTINES ; [ 10/29/2002   7:42 AM ]
	;;4.0;XB;;Jul 20, 2009;Build 2
	; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
	;
	; This routine asks user to select a set of routines, asks
	; the user for the programmer information and standardizes
	; the format of the first line of each routine.
	;
	; The form of the first line will be as follows:
	;
	; label ; agency/site/developer - comment ; edit date    E.G.
	; XBFIXL1 ; IHS/ADC/GTH - FIX LINE 1 ; [ 11/08/90  10:41 AM ]
	;
START	;
	NEW ASK,QUIT,RTN
	S QUIT=0
	D ^XBKTMP,^XBKVAR
	X ^%ZOSF("RSEL")
	I $D(^UTILITY($J,"XBFIXL1")) W !,"^XBFIXL1 cannot modify itself.  Ignored." KILL ^UTILITY($J,"XBFIXL1")
	G:$O(^UTILITY($J,""))="" EOJ
	S XBPI=$$DIR^XBDIR("F^9:20","Enter agency/site/programmer","","","E.G IHS/OHPRD/ACC")
	G:$D(DIRUT) EOJ
	;S XBRTN="";IHS/SET/GTH XB*3*9 10/29/2002
	S XBRTN=0 ;IHS/SET/GTH XB*3*9 10/29/2002
	F  S XBRTN=$O(^UTILITY($J,XBRTN)) Q:XBRTN=""  D CHECK Q:QUIT
	G EOJ
	;
CHECK	;
	KILL ^TMP("XBFIXL1",$J)
	S DIF="^TMP(""XBFIXL1"",$J,",XCNP=0,X=XBRTN
	X ^%ZOSF("LOAD")
	S XBL1=^TMP("XBFIXL1",$J,1,0)
	I $E($P(XBL1," ",2))'=";" W !!,XBRTN," - line 1 contains code and must be changed manually.  Skipping" Q
	S XBSAVE=XBL1
	D MODIFY
REVER	;
	D VERIFY
	Q:QUIT
	D:Y="R" FIX
	I QUIT S XBL1=XBSAVE G REVER
	I XBL1]"" S ^TMP("XBFIXL1",$J,1,0)=XBL1,DIE=DIF,XCN=0,X=XBRTN X ^%ZOSF("SAVE")
	Q
	;
MODIFY	; Modify Line 1.
	S XBTAG=$P(XBL1," "),X=$P(XBL1,";",2,99)
	D EXTDATE
	F  Q:$E(X)'=" "  S X=$E(X,2,$L(X))
	S:$P(X,";")?." " $P(X,";")=XBPI_" - NO DESCRIPTION PROVIDED"
	S %=$P(X,";")
	I %'["-",$P(%," ")?1A.AN1"/"1A.AN.E S $P(%," ")=$P(%," ")_" - ",$P(X,";")=%
	F  S %=$F(X,";") Q:'%  S X=$E(X,1,%-2)_" "_$E(X,%,$L(X))
	F  S %=$F(X,"  ") Q:'%  S X=$E(X,1,%-3)_" "_$E(X,%,$L(X))
	S:$E(X)=" " X=$E(X,2,$L(X)) S:$E(X,$L(X))=" " X=$E(X,1,$L(X)-1)
	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
	I X'["-" S X=XBPI_" - "_X
	S XBL1=XBTAG_" ; "_X_" ;"_$S(XBDATE]"":" [ "_XBDATE_" ]",1:"")
	Q
	;
EXTDATE	; Extract date and remove from Line.
	S XBNP=$L(X,";"),XBLP=$P(X,";",XBNP)
	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]""
	I XBLDT="" S XBDATE="" Q
	S XBLTM=$$GETPATRN^XBFUNC($P(XBLP,XBLDT,2),"1.2N1"":""1.2N1"" ""2A")
	S:XBLTM]"" XBLDT=XBLDT_" "_XBLTM
	S XBLP=$P(XBLP,XBLDT)_$P(XBLP,XBLDT,2)
	S XBLDJ=$$FNDPATRN^XBFUNC(XBLP,"."" ""1""["".E1""]"".E")
	S:XBLDJ XBLP=$E(XBLP,1,XBLDJ-1)
	S $P(X,";",XBNP)=XBLP
	S XBDATE=XBLDT
	Q
	;
VERIFY	; Ask user to verify mod.
	W !!,XBRTN,!," from: ",XBSAVE,!,"   to: ",XBL1
	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")
	S:$D(DIRUT) QUIT=1
	S:Y="S" XBL1=""
	Q
	;
FIX	; Get comment from user.
	S X=$$DIR^XBDIR("F^5:40","Enter comment to follow agency/site/programmer ")
	S:$D(DIRUT) QUIT=1
	S $P(XBL1,";",2)=XBPI_" - "_X
	Q
	;
EOJ	;
	D ^XBKTMP
	KILL DIF,XCNP,DIE,XCN
	KILL %,X,Y,^UTILITY($J)
	KILL DTOUT,DUOUT,DIRUT,DIROUT
	KILL XBDATE,XBL1,XBLDJ,XBLDT,XBLP,XBLTM,XBNP,XBPAT,XBPI,XBRTN,XBSAVE,XBTAG
	Q
	;