ACMFJE.m

ACMFJE ; IHS/TUCSON/TMJ - NEW PROGRAM ;

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

 ;

 F ACM=42.1,43.1,44.1,45.1,47.1,48,50,51.1,53.1,54.1 D ONE

 Q

ONE ;

 S ACZ=0 F  S ACZ=$O(^ACM(ACM,ACZ)) Q:+ACZ=0  D TWO

 Q

TWO ;

 S X=0,X=$O(^ACM(ACM,ACZ,"RG",X)) Q:X'=""

 S DIK="^ACM("_ACM_",",DA=ACZ D ^DIK

 K DIK Q

ACMFJE    ; IHS/TUCSON/TMJ - NEW PROGRAM ;

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

 +2       ;

 +3        FOR ACM=42.1,43.1,44.1,45.1,47.1,48,50,51.1,53.1,54.1

               DO ONE

 +4        QUIT 

ONE       ;

 +1        SET ACZ=0

           FOR 

               SET ACZ=$ORDER(^ACM(ACM,ACZ))

               IF +ACZ=0

                   QUIT 

               DO TWO

 +2        QUIT 

TWO       ;

 +1        SET X=0

           SET X=$ORDER(^ACM(ACM,ACZ,"RG",X))

           IF X'=""

               QUIT 

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

           SET DA=ACZ

           DO ^DIK

 +3        KILL DIK

           QUIT