BDMGPRPC.m

BDMGPRPC ; cmi/anch/maw - BDMG Populate RPC field of Option file 1/10/2005 1:31:25 PM ; 

 ;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**1**;JAN 17, 2008

 ;

 ;

 ;

 ;

MAIN ;EP - this is the main routine driver

 D POP

 Q

 ;

POP ;-- populate the RPC field of the option file

 N BDMGDA,BDMGIEN

 S BDMGDA=0 F  S BDMGDA=$O(^XWB(8994,"B",BDMGDA)) Q:BDMGDA=""  D

 . Q:$E(BDMGDA,1,4)'="BDMG"

 . S BDMGIEN=0 F  S BDMGIEN=$O(^XWB(8994,"B",BDMGDA,BDMGIEN)) Q:'BDMGIEN  D

 .. K DD,DO

 .. S DA(1)=$O(^DIC(19,"B","BMXRPC",0))

 .. S DIC(0)="L"

 .. S DIC="^DIC(19,"_DA(1)_","_"""RPC"""_","

 .. S X=BDMGIEN

 .. D FILE^DICN

 Q

 ;

BDMGPRPC  ; cmi/anch/maw - BDMG Populate RPC field of Option file 1/10/2005 1:31:25 PM ; 

 +1       ;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**1**;JAN 17, 2008

 +2       ;

 +3       ;

 +4       ;

 +5       ;

MAIN      ;EP - this is the main routine driver

 +1        DO POP

 +2        QUIT 

 +3       ;

POP       ;-- populate the RPC field of the option file

 +1        NEW BDMGDA,BDMGIEN

 +2        SET BDMGDA=0

           FOR 

               SET BDMGDA=$ORDER(^XWB(8994,"B",BDMGDA))

               IF BDMGDA=""

                   QUIT 

               Begin DoDot:1

 +3                IF $EXTRACT(BDMGDA,1,4)'="BDMG"

                       QUIT 

 +4                SET BDMGIEN=0

                   FOR 

                       SET BDMGIEN=$ORDER(^XWB(8994,"B",BDMGDA,BDMGIEN))

                       IF 'BDMGIEN

                           QUIT 

                       Begin DoDot:2

 +5                        KILL DD,DO

 +6                        SET DA(1)=$ORDER(^DIC(19,"B","BMXRPC",0))

 +7                        SET DIC(0)="L"

 +8                        SET DIC="^DIC(19,"_DA(1)_","_"""RPC"""_","

 +9                        SET X=BDMGIEN

 +10                       DO FILE^DICN

                       End DoDot:2

               End DoDot:1

 +11       QUIT 

 +12      ;