ACMTMPI.m

ACMTMPI ; IHS/TUCSON/TMJ - UTILITY TO CHANGE PRINT TEMPLATE DFN'S ;

 ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996

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

 ;ACMSRT SORTING UTILITY WHEN SORT TEMPLATES TRANSFERRED TO NEW SYSTEM

 ;EP;ENTRY POINT

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

 D WAIT^DICD

 S ACMY(1)=""

 F  S ACMY(1)=$O(^ACM(48.5,"B",ACMY(1))) Q:ACMY(1)=""  D SET

EXIT ;

 K ^ACM(48.5,"B")

 S DIK="^ACM(48.5," D IXALL^DIK

 K ACMTMP,ACMTMPN,ACMY

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

 W !?5,"INITIALIZATION OF THE CASE MANAGEMENT SYSTEM IS COMPLETE."

 Q

SET S ACMY(2)=0

 F  S ACMY(2)=$O(^ACM(48.5,"B",ACMY(1),ACMY(2))) Q:'ACMY(2)  K ^ACM(48.5,ACMY(2),2,"B") S ACMY(3)=0 F  S ACMY(3)=$O(^ACM(48.5,ACMY(2),2,ACMY(3))) Q:'ACMY(3)  S ACMTMP=$P(^ACM(48.5,ACMY(2),2,ACMY(3),0),U,2) I ACMTMP'="" D

 .S ACMTMPN=0

 .F  S ACMTMPN=$O(^DIPT("B",ACMTMP,ACMTMPN)) Q:'ACMTMPN  S $P(^ACM(48.5,ACMY(2),2,ACMY(3),0),U)=ACMTMPN

 Q

ACMTMPI   ; IHS/TUCSON/TMJ - UTILITY TO CHANGE PRINT TEMPLATE DFN'S ;

 +1       ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996

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

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

 +4       ;EP;ENTRY POINT

EN         IF '$DATA(U)

               SET U="^"

 +1        DO WAIT^DICD

 +2        SET ACMY(1)=""

 +3        FOR 

               SET ACMY(1)=$ORDER(^ACM(48.5,"B",ACMY(1)))

               IF ACMY(1)=""

                   QUIT 

               DO SET

EXIT      ;

 +1        KILL ^ACM(48.5,"B")

 +2        SET DIK="^ACM(48.5,"

           DO IXALL^DIK

 +3        KILL ACMTMP,ACMTMPN,ACMY

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

 +5        WRITE !?5,"INITIALIZATION OF THE CASE MANAGEMENT SYSTEM IS COMPLETE."

 +6        QUIT 

SET        SET ACMY(2)=0

 +1        FOR 

               SET ACMY(2)=$ORDER(^ACM(48.5,"B",ACMY(1),ACMY(2)))

               IF 'ACMY(2)

                   QUIT 

               KILL ^ACM(48.5,ACMY(2),2,"B")

               SET ACMY(3)=0

               FOR 

                   SET ACMY(3)=$ORDER(^ACM(48.5,ACMY(2),2,ACMY(3)))

                   IF 'ACMY(3)

                       QUIT 

                   SET ACMTMP=$PIECE(^ACM(48.5,ACMY(2),2,ACMY(3),0),U,2)

                   IF ACMTMP'=""

                       Begin DoDot:1

 +2                        SET ACMTMPN=0

 +3                        FOR 

                               SET ACMTMPN=$ORDER(^DIPT("B",ACMTMP,ACMTMPN))

                               IF 'ACMTMPN

                                   QUIT 

                               SET $PIECE(^ACM(48.5,ACMY(2),2,ACMY(3),0),U)=ACMTMPN

                       End DoDot:1

 +4        QUIT