%AUPTFXT ;BRJ/IHS [ 03/09/87 7:32 AM ]
W !,*7,"%AUPTFXT cannot be executed at this entry point!!"
Q
EN ;ENTRY FROM %AUPTFX - RUN %AUFXPT THEN ASK FOR FILEMAN AND USER FILE NAMES
N AUPTPGM S AUPTPGM="<"_$T(+0)_">"
F AUPTLBL="INFO","ASKARRAY","ASKFILE","ASKDSPLY","GO" D @(AUPTLBL):'AUPTQUIT
K AUPTANS,AUPTI1,AUPTI2,AUPTPTFL,AUPTPTFD,AUPTDDFL
Q
INFO ;INFORM USER WHAT'S GOING TO HAPPEN AND CALL %AUFIXPT TO CLEAN UP "PT" NODE
W !!,AUPTPGM,?11,"This program will exchange old (BAD!) pointer values for new (GOOD?)",!,?11,"pointer values in all FM files that point to a given file."
W !!,?11,"The new pointer values should already be in a global array."
Q
ASKARRAY ;ASK FOR USER ARRAY GLOBAL NAME
W !!,AUPTPGM,?11,"Please enter the name of this global.",!!,?15,*7,"Global name = ^"
R AUPTANS:DTIME E D TIMEOUT Q
I $E(AUPTANS)="?" D HLPARRAY G ASKARRAY
I $E(AUPTANS=U&($L(AUPTANS)=1)) W !!,AUPTPGM,?11,"G o o d b y e !!" S AUPTQUIT=1 Q
I AUPTANS="" D NOARRAY Q:AUPTQUIT G ASKARRAY
I $E(AUPTANS)'=U S AUPTANS=U_AUPTANS
S AUPTUFLE=AUPTANS
I '$D(@AUPTUFLE) D NOARRAY Q:AUPTQUIT G ASKARRAY
S AUPTUFLE=AUPTUFLE_"(AUPTOLDX)"
Q
NOARRAY ;USER ARRAY DOES NOT EXIST OR WASN'T ENTERED BY OPERATOR
W !!,AUPTPGM,?11,"Your global name was not entered or does not exist!!",!,?15,"Do you want to continue?",!,?15,*7,"[Y]es or [N]o <N>// "
R AUPTANS:DTIME E D TIMEOUT Q
I $E(AUPTANS)'="Y" W !!,AUPTPGM,?11,"OK - I'm getting out now!!" S AUPTQUIT=1
Q
HLPARRAY ;HELP USER
W !!,AUPTPGM,?11,"This program requires the user to have created a global that contains",!,?11,"the old/new pointer values.",!!,?11,"The format for the global is ^gbl(""old"")=new where:"
W !,?15,"^gbl is the global name",!,?15,"""old"" is the old (BAD!) entry number",!,?21,"i.e. the value to be corrected",!,?15,"""new"" is the new (GOOD?) entry number",!,?21,"i.e. the correct value."
Q
ASKFILE ;ASK FILEMAN TO GET FILENAME
W !!,AUPTPGM,?11,"I'm going to have FileMan ask you to enter the FM name or number of",!,?11,"the 'pointed to' file to be processed.",!,*7
ASKFM S DIC="^DIC(",DIC(0)="MAEQ" D ^DIC S AUPTY=Y,AUPTFILE=+$P(Y,U,1) K DIC,DIC(0),Y
I AUPTFILE<0 D NOFILE Q:AUPTQUIT G ASKFM
S AUPTFSTK(1)=AUPTFILE
Q
NOFILE ;FILEMAN FILE WAS NOT ENTERED OR NOT FOUND
W !!,AUPTPGM,?11,"No file was selected."
W !!,AUPTPGM,?11,"Do you want to select another file?",!!,?15,*7,"[Y]es or [N]o <N>// "
R AUPTANS:DTIME E D TIMEOUT Q
I $E(AUPTANS)'="Y" W !!,AUPTPGM,?11,"OKIE DOKE - No action on this run. B Y E....." S AUPTQUIT=1
Q
ASKDSPLY ;ASK TO DISPLAY DATA NODES ARE THEY ARE EXCHANGED
W !!,AUPTPGM,?11,"Do you want me to display the 'before and after' of each global node",!,?11,"when an exchange occurs?",!!,?11,"Answering <Y>es may extend the run time substantially!!",!!,?15,*7,"[Y]es or [N]o? <N>// "
R AUPTANS:DTIME E D TIMEOUT Q
S:$E(AUPTANS)="Y" AUPTDSPY=1
Q
GO ;OFF AND RUNNING
W !!,AUPTPGM,?11,"O K - I'm set up to go.",!,?11,"Be prepared for this program to take some time."
W !,AUPTPGM,?11,"I will display which FM file/field is being processed."
W !!,?11,"Also, if you didn't want to display the 'before and after,",!,?11,"I will display the following characters accordingly:"
W !,?15,"a ""-"" indicates a data node was found",!,?15,"a ""X"" indicates an exchange occurred.",!,?15,"a ""|"" indicates setting cross references, triggers, etc.",!,?19,"occurred."
W !!,AUPTPGM,?11,"Press <RETURN> when ready!! W A I T I N G . . ."
R AUPTANS:DTIME E D TIMEOUT Q
W !!,AUPTPGM,?11,"I'm off and running......"
Q
TIMEOUT ;QUIT IF TIMEOUT ON READS OCCUR
S AUPTEC=9,AUPTQUIT=1 D ERR
Q
ERR ;DISPLAY ERROR MESSAGES FROM ^AUPTFIX
S AUPTSKIP=1
W !!,*7,AUPTPGM,?11,$P($T(ERRMSG+(AUPTEC)),";;",2)
Q:AUPTEC=9
I AUPTEC=1 W !,?15,"FILE= ",$P(AUPTY,U,1)," - ",$P(AUPTY,U,2)
E W !,?15,"FILE= ",AUPTPSFL," FIELD= ",AUPTPSFD,!!,AUPTPGM,?11,"Skipping to next ""PT"" node."
Q
ERRMSG ;;ERROR MESSAGE LIST
1 ;;File did not contain any "PT" nodes. No action.
2 ;;<SNAFU> Missing "0" node at ^DD(fl,fd,0)
3 ;;<SNAFU> Missing "NM" node at ^DD(fl,0,"NM",sflname)
4 ;;<SNAFU> Missing "B" node at ^DD(fl,"B",flname,upsflnbr)
5 ;;<SNAFU> Missing ^(1) or ^(2) node at ^DD(fl,fd,1,xridx,xrnbr)
6 ;;<SNAFU> Missing "GL" node at ^DIC(fl,0,"GL")
7 ;;<SNAFU> Missing "global name" at ^DD(fl,fd,0) for DINUM=X
8 ;;<SNAFU> Missing "0" node at ^DIC(fl,0)
9 ;;<TIME-OUT> Your took too long to respond. SO SORRY!! Bye bye!
%AUPTFXT ;BRJ/IHS [ 03/09/87 7:32 AM ]
+1 WRITE !,*7,"%AUPTFXT cannot be executed at this entry point!!"
+2 QUIT
EN ;ENTRY FROM %AUPTFX - RUN %AUFXPT THEN ASK FOR FILEMAN AND USER FILE NAMES
+1 NEW AUPTPGM
SET AUPTPGM="<"_$TEXT(+0)_">"
+2 FOR AUPTLBL="INFO","ASKARRAY","ASKFILE","ASKDSPLY","GO"
IF 'AUPTQUIT
DO @(AUPTLBL)
+3 KILL AUPTANS,AUPTI1,AUPTI2,AUPTPTFL,AUPTPTFD,AUPTDDFL
+4 QUIT
INFO ;INFORM USER WHAT'S GOING TO HAPPEN AND CALL %AUFIXPT TO CLEAN UP "PT" NODE
+1 WRITE !!,AUPTPGM,?11,"This program will exchange old (BAD!) pointer values for new (GOOD?)",!,?11,"pointer values in all FM files that point to a given file."
+2 WRITE !!,?11,"The new pointer values should already be in a global array."
+3 QUIT
ASKARRAY ;ASK FOR USER ARRAY GLOBAL NAME
+1 WRITE !!,AUPTPGM,?11,"Please enter the name of this global.",!!,?15,*7,"Global name = ^"
+2 READ AUPTANS:DTIME
IF '$TEST
DO TIMEOUT
QUIT
+3 IF $EXTRACT(AUPTANS)="?"
DO HLPARRAY
GOTO ASKARRAY
+4 IF $EXTRACT(AUPTANS=U&($LENGTH(AUPTANS)=1))
WRITE !!,AUPTPGM,?11,"G o o d b y e !!"
SET AUPTQUIT=1
QUIT
+5 IF AUPTANS=""
DO NOARRAY
IF AUPTQUIT
QUIT
GOTO ASKARRAY
+6 IF $EXTRACT(AUPTANS)'=U
SET AUPTANS=U_AUPTANS
+7 SET AUPTUFLE=AUPTANS
+8 IF '$DATA(@AUPTUFLE)
DO NOARRAY
IF AUPTQUIT
QUIT
GOTO ASKARRAY
+9 SET AUPTUFLE=AUPTUFLE_"(AUPTOLDX)"
+10 QUIT
NOARRAY ;USER ARRAY DOES NOT EXIST OR WASN'T ENTERED BY OPERATOR
+1 WRITE !!,AUPTPGM,?11,"Your global name was not entered or does not exist!!",!,?15,"Do you want to continue?",!,?15,*7,"[Y]es or [N]o <N>// "
+2 READ AUPTANS:DTIME
IF '$TEST
DO TIMEOUT
QUIT
+3 IF $EXTRACT(AUPTANS)'="Y"
WRITE !!,AUPTPGM,?11,"OK - I'm getting out now!!"
SET AUPTQUIT=1
+4 QUIT
HLPARRAY ;HELP USER
+1 WRITE !!,AUPTPGM,?11,"This program requires the user to have created a global that contains",!,?11,"the old/new pointer values.",!!,?11,"The format for the global is ^gbl(""old"")=new where:"
+2 WRITE !,?15,"^gbl is the global name",!,?15,"""old"" is the old (BAD!) entry number",!,?21,"i.e. the value to be corrected",!,?15,"""new"" is the new (GOOD?) entry number",!,?21,"i.e. the correct value."
+3 QUIT
ASKFILE ;ASK FILEMAN TO GET FILENAME
+1 WRITE !!,AUPTPGM,?11,"I'm going to have FileMan ask you to enter the FM name or number of",!,?11,"the 'pointed to' file to be processed.",!,*7
ASKFM SET DIC="^DIC("
SET DIC(0)="MAEQ"
DO ^DIC
SET AUPTY=Y
SET AUPTFILE=+$PIECE(Y,U,1)
KILL DIC,DIC(0),Y
+1 IF AUPTFILE<0
DO NOFILE
IF AUPTQUIT
QUIT
GOTO ASKFM
+2 SET AUPTFSTK(1)=AUPTFILE
+3 QUIT
NOFILE ;FILEMAN FILE WAS NOT ENTERED OR NOT FOUND
+1 WRITE !!,AUPTPGM,?11,"No file was selected."
+2 WRITE !!,AUPTPGM,?11,"Do you want to select another file?",!!,?15,*7,"[Y]es or [N]o <N>// "
+3 READ AUPTANS:DTIME
IF '$TEST
DO TIMEOUT
QUIT
+4 IF $EXTRACT(AUPTANS)'="Y"
WRITE !!,AUPTPGM,?11,"OKIE DOKE - No action on this run. B Y E....."
SET AUPTQUIT=1
+5 QUIT
ASKDSPLY ;ASK TO DISPLAY DATA NODES ARE THEY ARE EXCHANGED
+1 WRITE !!,AUPTPGM,?11,"Do you want me to display the 'before and after' of each global node",!,?11,"when an exchange occurs?",!!,?11,"Answering <Y>es may extend the run time substantially!!",!!,?15,*7,"[Y]es or [N]o? <N>// "
+2 READ AUPTANS:DTIME
IF '$TEST
DO TIMEOUT
QUIT
+3 IF $EXTRACT(AUPTANS)="Y"
SET AUPTDSPY=1
+4 QUIT
GO ;OFF AND RUNNING
+1 WRITE !!,AUPTPGM,?11,"O K - I'm set up to go.",!,?11,"Be prepared for this program to take some time."
+2 WRITE !,AUPTPGM,?11,"I will display which FM file/field is being processed."
+3 WRITE !!,?11,"Also, if you didn't want to display the 'before and after,",!,?11,"I will display the following characters accordingly:"
+4 WRITE !,?15,"a ""-"" indicates a data node was found",!,?15,"a ""X"" indicates an exchange occurred.",!,?15,"a ""|"" indicates setting cross references, triggers, etc.",!,?19,"occurred."
+5 WRITE !!,AUPTPGM,?11,"Press <RETURN> when ready!! W A I T I N G . . ."
+6 READ AUPTANS:DTIME
IF '$TEST
DO TIMEOUT
QUIT
+7 WRITE !!,AUPTPGM,?11,"I'm off and running......"
+8 QUIT
TIMEOUT ;QUIT IF TIMEOUT ON READS OCCUR
+1 SET AUPTEC=9
SET AUPTQUIT=1
DO ERR
+2 QUIT
ERR ;DISPLAY ERROR MESSAGES FROM ^AUPTFIX
+1 SET AUPTSKIP=1
+2 WRITE !!,*7,AUPTPGM,?11,$PIECE($TEXT(ERRMSG+(AUPTEC)),";;",2)
+3 IF AUPTEC=9
QUIT
+4 IF AUPTEC=1
WRITE !,?15,"FILE= ",$PIECE(AUPTY,U,1)," - ",$PIECE(AUPTY,U,2)
+5 IF '$TEST
WRITE !,?15,"FILE= ",AUPTPSFL," FIELD= ",AUPTPSFD,!!,AUPTPGM,?11,"Skipping to next ""PT"" node."
+6 QUIT
ERRMSG ;;ERROR MESSAGE LIST
1 ;;File did not contain any "PT" nodes. No action.
2 ;;<SNAFU> Missing "0" node at ^DD(fl,fd,0)
3 ;;<SNAFU> Missing "NM" node at ^DD(fl,0,"NM",sflname)
4 ;;<SNAFU> Missing "B" node at ^DD(fl,"B",flname,upsflnbr)
5 ;;<SNAFU> Missing ^(1) or ^(2) node at ^DD(fl,fd,1,xridx,xrnbr)
6 ;;<SNAFU> Missing "GL" node at ^DIC(fl,0,"GL")
7 ;;<SNAFU> Missing "global name" at ^DD(fl,fd,0) for DINUM=X
8 ;;<SNAFU> Missing "0" node at ^DIC(fl,0)
9 ;;<TIME-OUT> Your took too long to respond. SO SORRY!! Bye bye!
