AUPTLAB.m

AUPTLAB ;BRJ-IHS OHPD-TUCSON FIX LAB POINTERS [ 03/19/87  10:29 AM ]

 W !,*7,"This program is a stand-alone one-timer to fix pointers in the ^LR global",!

 S DA=0,U="^"

 K ^AUPTLAB S ^AUPTLAB(0)="OLD/NEW STATUS OF ^LR(DA,0) AS MODIFIED BY AUPTLAB"

 F AUPTL=0:0 S DA=$O(^LR(DA)) Q:'+DA  W "." I $P(^LR(DA,0),U,2)=2 S X=$P(^(0),U,3) I $D(^ARGOTON(X)) D SWAP

 W !,*7,"Done!!"

 Q

SWAP ;

 W "*" S ^AUPTLAB(DA,0,1)=^LR(DA,0) X ^DD(63,.03,1,1,2) W "/" S X1=^ARGOTON(X),$P(^LR(DA,0),U,3)=X1 S ^AUPTLAB(DA,0,2)=^LR(DA,0) W "!" S X=X1 X ^DD(63,.03,1,1,1) W "\"

 Q

AUPTLAB   ;BRJ-IHS OHPD-TUCSON FIX LAB POINTERS [ 03/19/87  10:29 AM ]

 +1        WRITE !,*7,"This program is a stand-alone one-timer to fix pointers in the ^LR global",!

 +2        SET DA=0

           SET U="^"

 +3        KILL ^AUPTLAB

           SET ^AUPTLAB(0)="OLD/NEW STATUS OF ^LR(DA,0) AS MODIFIED BY AUPTLAB"

 +4        FOR AUPTL=0:0

               SET DA=$ORDER(^LR(DA))

               IF '+DA

                   QUIT 

               WRITE "."

               IF $PIECE(^LR(DA,0),U,2)=2

                   SET X=$PIECE(^(0),U,3)

                   IF $DATA(^ARGOTON(X))

                       DO SWAP

 +5        WRITE !,*7,"Done!!"

 +6        QUIT 

SWAP      ;

 +1        WRITE "*"

           SET ^AUPTLAB(DA,0,1)=^LR(DA,0)

           XECUTE ^DD(63,.03,1,1,2)

           WRITE "/"

           SET X1=^ARGOTON(X)

           SET $PIECE(^LR(DA,0),U,3)=X1

           SET ^AUPTLAB(DA,0,2)=^LR(DA,0)

           WRITE "!"

           SET X=X1

           XECUTE ^DD(63,.03,1,1,1)

           WRITE "\"

 +2        QUIT