ACGSTMPI.m

ACGSTMPI ;IHS-OHPRD/THL,AEF - UTILITY TO UPDATE SORT CRITERION; [ 03/10/2000  3:09 PM ]

 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000

 ;;UTILITY TO CHANGE DFN'S FOR ASSOCIATED PRINT TEMPLATES FOR THE

 ;;ACGSRT SORTING UTILITY WHEN SORT TEMPLATES TRANSFERRED TO NEW SYSTEM

EN I '$D(U) S U="^"

 D WAIT^DICD

 S ACGY(1)=""

 F  S ACGY(1)=$O(^ACGSRT("B",ACGY(1))) Q:ACGY(1)=""  D SET

EXIT ;

 K ^ACGSRT("B")

 S DIK="^ACGSRT(" D IXALL^DIK

 K ACGTMP,ACGTMPN,ACGY

 W *7,*7,!!?5,"ASSOCIATED PRINT TEMPLATE POINTERS IN THE ACG SORT FILE HAVE BEEN RESET."

 Q

SET S ACGY(2)=0

 F  S ACGY(2)=$O(^ACGSRT("B",ACGY(1),ACGY(2))) Q:'ACGY(2)  K ^ACGSRT(ACGY(2),2,"B") S ACGY(3)=0 F  S ACGY(3)=$O(^ACGSRT(ACGY(2),2,ACGY(3))) Q:'ACGY(3)  S ACGTMP=$P(^ACGSRT(ACGY(2),2,ACGY(3),0),U,2) I ACGTMP'="" D

 .S ACGTMPN=0

 .F  S ACGTMPN=$O(^DIPT("B",ACGTMP,ACGTMPN)) Q:'ACGTMPN  S $P(^ACGSRT(ACGY(2),2,ACGY(3),0),U)=ACGTMPN

 Q

ACGSTMPI  ;IHS-OHPRD/THL,AEF - UTILITY TO UPDATE SORT CRITERION; [ 03/10/2000  3:09 PM ]

 +1       ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000

 +2       ;;UTILITY TO CHANGE DFN'S FOR ASSOCIATED PRINT TEMPLATES FOR THE

 +3       ;;ACGSRT SORTING UTILITY WHEN SORT TEMPLATES TRANSFERRED TO NEW SYSTEM

EN         IF '$DATA(U)

               SET U="^"

 +1        DO WAIT^DICD

 +2        SET ACGY(1)=""

 +3        FOR 

               SET ACGY(1)=$ORDER(^ACGSRT("B",ACGY(1)))

               IF ACGY(1)=""

                   QUIT 

               DO SET

EXIT      ;

 +1        KILL ^ACGSRT("B")

 +2        SET DIK="^ACGSRT("

           DO IXALL^DIK

 +3        KILL ACGTMP,ACGTMPN,ACGY

 +4        WRITE *7,*7,!!?5,"ASSOCIATED PRINT TEMPLATE POINTERS IN THE ACG SORT FILE HAVE BEEN RESET."

 +5        QUIT 

SET        SET ACGY(2)=0

 +1        FOR 

               SET ACGY(2)=$ORDER(^ACGSRT("B",ACGY(1),ACGY(2)))

               IF 'ACGY(2)

                   QUIT 

               KILL ^ACGSRT(ACGY(2),2,"B")

               SET ACGY(3)=0

               FOR 

                   SET ACGY(3)=$ORDER(^ACGSRT(ACGY(2),2,ACGY(3)))

                   IF 'ACGY(3)

                       QUIT 

                   SET ACGTMP=$PIECE(^ACGSRT(ACGY(2),2,ACGY(3),0),U,2)

                   IF ACGTMP'=""

                       Begin DoDot:1

 +2                        SET ACGTMPN=0

 +3                        FOR 

                               SET ACGTMPN=$ORDER(^DIPT("B",ACGTMP,ACGTMPN))

                               IF 'ACGTMPN

                                   QUIT 

                               SET $PIECE(^ACGSRT(ACGY(2),2,ACGY(3),0),U)=ACGTMPN

                       End DoDot:1

 +4        QUIT