AUPTFXX.m

%AUPTFXX ;BRJ/IHS OHPD-TUCSON EXCHANGE OLD ENTRY NUMBER FOR NEW [ 03/20/87  9:22 AM ]

 ;CALLED FROM ^%AUPTFX

 W !,*7,"%AUPTFXX cannot be run stand-alone.  Bye Bye!"

 Q

SWAP ;POSITION DATA GLOBAL AND SWAP POINTER VALUES 

EN ;ENTRY FROM ^AUPTFX

 N AUPTPGM S AUPTPGM="<"_$T(+0)_">"

 W !!,*7,AUPTPGM,?11,"Beginning to exchange pointer values for:"

 S AUPTPO=""

 F L=0:0 S AUPTPO=$O(AUPTDAL(AUPTPO)) Q:AUPTPO=""  W !,?11,"File/Subfile // ",$P(AUPTDAL(AUPTPO),U,3),"   ",$P(AUPTDAL(AUPTPO),U,4) W:AUPTPO=(-1) !,?18,"Field // ",$P(AUPTDAL(-1),U,5),"    ",$P(AUPTDAL(-1),U,6),!,?18,"Piece // ",AUPTP

 W:'AUPTDSPY !

 F AUPTL=1:1:AUPTDACT X AUPTO(AUPTL,0)

 S AUPTI=1 F L=0:0 X AUPTO(AUPTI,1) Q:'+AUPTI  I +DA I $D(@AUPTPGL) D CKSWAP I AUPTSWAP D BLDGNDE,PUT^AUPTFXD:AUPTDIN,SWAPX:'AUPTDIN

 Q

CKSWAP ;DETERMINE IF SWAP AND SAVE OLD/NEW VALUES

 S AUPTSWAP=0,AUPTOLDX=$P(@AUPTPGL,U,AUPTP)

 I AUPTOLDX'="" I $D(@AUPTUFLE) S AUPTNEWX=@AUPTUFLE,AUPTSWAP=1

 Q

BLDGNDE ;BUILD GLOBAL NODE OF FILE ENTRY

 S AUPTI1="",AUPTGNDE=AUPTORGG

 F L=0:0 S AUPTI1=$O(AUPTDAL(AUPTI1)) Q:AUPTI1=""  S AUPTGNDE=AUPTGNDE_@($P(AUPTDAL(AUPTI1),U,1))_","_$P($P(AUPTDAL(AUPTI1),";",1),U,2)_$S(AUPTI1'=(-1):",",1:")")

 Q

SWAPX ;EXCHANGE DATA VALUES - (DINUM=X) VALUES DONE IN ^AUPTFXDI

 I 'AUPTDSPY W "-"

 E  W !!,AUPTPGM,?11,"<OLD> ",AUPTGNDE,"=",@AUPTGNDE

 S $P(@AUPTGNDE,U,AUPTP)=AUPTNEWX

 I 'AUPTDSPY W "X"

 E  W !,?11,"<NEW> ",AUPTGNDE,"=",@AUPTGNDE

 D RESETXR:$D(^DD(AUPTPSFL,AUPTPSFD,1,0))

 Q

RESETXR ;RESET ANY TRIGGER,X-REF,ETC

 W:AUPTDSPY !,?11,"Executing cross references, triggers etc.",!,?11

 S AUPTXI1=0,AUPTEC=5

 F L=0:0 S AUPTXI1=$O(^DD(AUPTPSFL,AUPTPSFD,1,AUPTXI1)) Q:AUPTXI1=""  D ERR^AUPTFXT:'($D(^(AUPTXI1,1))&$D(^(2))) Q:AUPTSKIP  S X=AUPTOLDX X:'AUPTDIN ^(2) W "|" S X=AUPTNEWX X ^DD(AUPTPSFL,AUPTPSFD,1,AUPTXI1,1) W "|"

 S AUPTSKIP=0

 Q

%AUPTFXX  ;BRJ/IHS OHPD-TUCSON EXCHANGE OLD ENTRY NUMBER FOR NEW [ 03/20/87  9:22 AM ]

 +1       ;CALLED FROM ^%AUPTFX

 +2        WRITE !,*7,"%AUPTFXX cannot be run stand-alone.  Bye Bye!"

 +3        QUIT 

SWAP      ;POSITION DATA GLOBAL AND SWAP POINTER VALUES 

EN        ;ENTRY FROM ^AUPTFX

 +1        NEW AUPTPGM

           SET AUPTPGM="<"_$TEXT(+0)_">"

 +2        WRITE !!,*7,AUPTPGM,?11,"Beginning to exchange pointer values for:"

 +3        SET AUPTPO=""

 +4        FOR L=0:0

               SET AUPTPO=$ORDER(AUPTDAL(AUPTPO))

               IF AUPTPO=""

                   QUIT 

               WRITE !,?11,"File/Subfile // ",$PIECE(AUPTDAL(AUPTPO),U,3),"   ",$PIECE(AUPTDAL(AUPTPO),U,4)

               IF AUPTPO=(-1)

                   WRITE !,?18,"Field // ",$PIECE(AUPTDAL(-1),U,5),"    ",$PIECE(AUPTDAL(-1),U,6),!,?18,"Piece // ",AUPTP

 +5        IF 'AUPTDSPY

               WRITE !

 +6        FOR AUPTL=1:1:AUPTDACT

               XECUTE AUPTO(AUPTL,0)

 +7        SET AUPTI=1

           FOR L=0:0

               XECUTE AUPTO(AUPTI,1)

               IF '+AUPTI

                   QUIT 

               IF +DA

                   IF $DATA(@AUPTPGL)

                       DO CKSWAP

                       IF AUPTSWAP

                           DO BLDGNDE

                           IF AUPTDIN

                               DO PUT^AUPTFXD

                           IF 'AUPTDIN

                               DO SWAPX

 +8        QUIT 

CKSWAP    ;DETERMINE IF SWAP AND SAVE OLD/NEW VALUES

 +1        SET AUPTSWAP=0

           SET AUPTOLDX=$PIECE(@AUPTPGL,U,AUPTP)

 +2        IF AUPTOLDX'=""

               IF $DATA(@AUPTUFLE)

                   SET AUPTNEWX=@AUPTUFLE

                   SET AUPTSWAP=1

 +3        QUIT 

BLDGNDE   ;BUILD GLOBAL NODE OF FILE ENTRY

 +1        SET AUPTI1=""

           SET AUPTGNDE=AUPTORGG

 +2        FOR L=0:0

               SET AUPTI1=$ORDER(AUPTDAL(AUPTI1))

               IF AUPTI1=""

                   QUIT 

               SET AUPTGNDE=AUPTGNDE_@($PIECE(AUPTDAL(AUPTI1),U,1))_","_$PIECE($PIECE(AUPTDAL(AUPTI1),";",1),U,2)_$SELECT(AUPTI1'=(-1):",",1:")")

 +3        QUIT 

SWAPX     ;EXCHANGE DATA VALUES - (DINUM=X) VALUES DONE IN ^AUPTFXDI

 +1        IF 'AUPTDSPY

               WRITE "-"

 +2       IF '$TEST

               WRITE !!,AUPTPGM,?11,"<OLD> ",AUPTGNDE,"=",@AUPTGNDE

 +3        SET $PIECE(@AUPTGNDE,U,AUPTP)=AUPTNEWX

 +4        IF 'AUPTDSPY

               WRITE "X"

 +5       IF '$TEST

               WRITE !,?11,"<NEW> ",AUPTGNDE,"=",@AUPTGNDE

 +6        IF $DATA(^DD(AUPTPSFL,AUPTPSFD,1,0))

               DO RESETXR

 +7        QUIT 

RESETXR   ;RESET ANY TRIGGER,X-REF,ETC

 +1        IF AUPTDSPY

               WRITE !,?11,"Executing cross references, triggers etc.",!,?11

 +2        SET AUPTXI1=0

           SET AUPTEC=5

 +3        FOR L=0:0

               SET AUPTXI1=$ORDER(^DD(AUPTPSFL,AUPTPSFD,1,AUPTXI1))

               IF AUPTXI1=""

                   QUIT 

               IF '($DATA(^(AUPTXI1,1))&$DATA(^(2)))

                   DO ERR^AUPTFXT

               IF AUPTSKIP

                   QUIT 

               SET X=AUPTOLDX

               IF 'AUPTDIN

                   XECUTE ^(2)

               WRITE "|"

               SET X=AUPTNEWX

               XECUTE ^DD(AUPTPSFL,AUPTPSFD,1,AUPTXI1,1)

               WRITE "|"

 +4        SET AUPTSKIP=0

 +5        QUIT