XBFIXL1.m

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       ;