BGP4POS2.m

BGP4POS2 ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED 28 Jan 2005 1:34 PM ;

 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114

 ;

 ;

PRE ;EP

 ;CHANGE PACKAGE FILE NAME

 S BGPX=0 F  S BGPX=$O(^BGPCTRL(BGPX)) Q:BGPX'=+BGPX  S DA=BGPX,DIK="^BGPCTRL(" D ^DIK

 S BGPX=0 F  S BGPX=$O(^BGPPEIJ(BGPX)) Q:BGPX'=+BGPX  S DA=BGPX,DIK="^BGPPEIJ(" D ^DIK

 S BGPX=0 F  S BGPX=$O(^BGPELIJ(BGPX)) Q:BGPX'=+BGPX  S DA=BGPX,DIK="^BGPELIJ(" D ^DIK

 S BGPX=0 F  S BGPX=$O(^BGPELIIJ(BGPX)) Q:BGPX'=+BGPX  S DA=BGPX,DIK="^BGPELIIJ(" D ^DIK

 S BGPX=0 F  S BGPX=$O(^BGPNPLJ(BGPX)) Q:BGPX'=+BGPX  S DA=BGPX,DIK="^BGPNPLJ(" D ^DIK

 S BGPX=0 F  S BGPX=$O(^BGPINDJC(BGPX)) Q:BGPX'=+BGPX  S DA=BGPX,DIK="^BGPINDJC(" D ^DIK

 S BGPX=0 F  S BGPX=$O(^BGPINDJ(BGPX)) Q:BGPX'=+BGPX  S DA=BGPX,DIK="^BGPINDJ(" D ^DIK

 S BGPX=0 F  S BGPX=$O(^BGPTAXJ(BGPX)) Q:BGPX'=+BGPX  S DA=BGPX,DIK="^BGPTAXJ(" D ^DIK

 Q

BGP4POS2  ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED 28 Jan 2005 1:34 PM ;

 +1       ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114

 +2       ;

 +3       ;

PRE       ;EP

 +1       ;CHANGE PACKAGE FILE NAME

 +2        SET BGPX=0

           FOR 

               SET BGPX=$ORDER(^BGPCTRL(BGPX))

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPCTRL("

               DO ^DIK

 +3        SET BGPX=0

           FOR 

               SET BGPX=$ORDER(^BGPPEIJ(BGPX))

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPPEIJ("

               DO ^DIK

 +4        SET BGPX=0

           FOR 

               SET BGPX=$ORDER(^BGPELIJ(BGPX))

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPELIJ("

               DO ^DIK

 +5        SET BGPX=0

           FOR 

               SET BGPX=$ORDER(^BGPELIIJ(BGPX))

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPELIIJ("

               DO ^DIK

 +6        SET BGPX=0

           FOR 

               SET BGPX=$ORDER(^BGPNPLJ(BGPX))

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPNPLJ("

               DO ^DIK

 +7        SET BGPX=0

           FOR 

               SET BGPX=$ORDER(^BGPINDJC(BGPX))

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPINDJC("

               DO ^DIK

 +8        SET BGPX=0

           FOR 

               SET BGPX=$ORDER(^BGPINDJ(BGPX))

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPINDJ("

               DO ^DIK

 +9        SET BGPX=0

           FOR 

               SET BGPX=$ORDER(^BGPTAXJ(BGPX))

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPTAXJ("

               DO ^DIK

 +10       QUIT