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

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
        ;