BDMFJE.m

BDMFJE ; cmi/anch/maw - NEW PROGRAM ;

 ;;2.0;DIABETES MANAGEMENT SYSTEM;;AUG 11, 2006

 ;

 F BDM=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(^BDM(BDM,ACZ)) Q:+ACZ=0  D TWO

 Q

TWO ;

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

 S DIK="^BDM("_BDM_",",DA=ACZ D ^DIK

 K DIK Q

BDMFJE    ; cmi/anch/maw - NEW PROGRAM ;

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;;AUG 11, 2006

 +2       ;

 +3        FOR BDM=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(^BDM(BDM,ACZ))

               IF +ACZ=0

                   QUIT 

               DO TWO

 +2        QUIT 

TWO       ;

 +1        SET X=0

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

           IF X'=""

               QUIT 

 +2        SET DIK="^BDM("_BDM_","

           SET DA=ACZ

           DO ^DIK

 +3        KILL DIK

           QUIT