Routine: ACMTMPCL

ACMTMPCL  ;IHS/TUCSON/TMJ - recompile all CMS Print templates;

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

 S ACMRECM("QFLG")=0,ACMRECM("X")="ACM" F  S ACMRECM("X")=$O(^DIPT("B",ACMRECM("X"))) Q:ACMRECM("X")=""  Q:$E(ACMRECM("X"),1,4)]"ACM"  D

 .S ACMRECM("Y")=0 F  S ACMRECM("Y")=$O(^DIPT("B",ACMRECM("X"),ACMRECM("Y"))) Q:ACMRECM("Y")=""  D

 ..S DMAX=$G(^DD("ROU")) S:DMAX="" DMAX=4000

 ..S X=$S($G(^DIPT(ACMRECM("Y"),"ROU"))]"":^DIPT(ACMRECM("Y"),"ROU"),$G(^DIPT(ACMRECM("Y"),"ROUOLD"))]"":^DIPT(ACMRECM("Y"),"ROUOLD"),1:"")

 ..Q:X=""

 ..I $E(X)="^" S X=$P(X,"^",2)

 ..S Y=ACMRECM("Y")

 ..D EN^DIPZ

..Q

.Q

 K ACMRECM,X,Y

ACMTMPCL  ;IHS/TUCSON/TMJ - recompile all CMS Print templates;

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

 +2        SET ACMRECM("QFLG")=0

           SET ACMRECM("X")="ACM"

FOR

               SET ACMRECM("X")=$ORDER(^DIPT("B",ACMRECM("X")))

               IF ACMRECM("X")=""

                   QUIT

               IF $EXTRACT(ACMRECM("X"),1,4)]"ACM"

                   QUIT

               Begin DoDot:1

 +3                SET ACMRECM("Y")=0

FOR

                       SET ACMRECM("Y")=$ORDER(^DIPT("B",ACMRECM("X"),ACMRECM("Y")))

                       IF ACMRECM("Y")=""

                           QUIT

                       Begin DoDot:2

 +4                        SET DMAX=$GET(^DD("ROU"))

                           IF DMAX=""

                               SET DMAX=4000

 +5                        SET X=$SELECT($GET(^DIPT(ACMRECM("Y"),"ROU"))]"":^DIPT(ACMRECM("Y"),"ROU"),$GET(^DIPT(ACMRECM("Y"),"ROUOLD"))]"":^DIPT(ACMRECM("Y"),"ROUOLD"),1:"")

 +6                        IF X=""

                               QUIT

 +7                        IF $EXTRACT(X)="^"

                               SET X=$PIECE(X,"^",2)

 +8                        SET Y=ACMRECM("Y")

 +9                        DO EN^DIPZ

 +10                       QUIT

                       End DoDot:2

 +11               QUIT

               End DoDot:1

 +12       KILL ACMRECM,X,Y

 +13       QUIT

ACMTMPCL.m