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