BGP3POS2.m

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

 ;;13.0;IHS CLINICAL REPORTING;**1**;NOV 20, 2012;Build 7

 ;

 ;

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(^BGPPEIH(BGPX)) Q:BGPX'=+BGPX  S DA=BGPX,DIK="^BGPPEIH(" D ^DIK

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

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

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

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

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

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

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

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

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

 ;F BGPX=1:1:2000 K ^BGPTAXH(BGPX)

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

 ;F BGPX=1:1:2000 K ^BGPTAXHB(BGPX)

 ;S X=0 F  S X=$O(^BGPSITE(X)) Q:X'=+X  S $P(^BGPSITE(X,0),U,3)=""

 Q

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

 +1       ;;13.0;IHS CLINICAL REPORTING;**1**;NOV 20, 2012;Build 7

 +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       ;S BGPX=0 F  S BGPX=$O(^BGPPEIH(BGPX)) Q:BGPX'=+BGPX  S DA=BGPX,DIK="^BGPPEIH(" D ^DIK

 +4        SET BGPX=0

           FOR 

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

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPELIH("

               DO ^DIK

 +5        SET BGPX=0

           FOR 

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

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPELIIH("

               DO ^DIK

 +6        SET BGPX=0

           FOR 

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

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPNPLH("

               DO ^DIK

 +7        SET BGPX=0

           FOR 

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

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPINDHC("

               DO ^DIK

 +8        SET BGPX=0

           FOR 

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

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPINDH("

               DO ^DIK

 +9        SET BGPX=0

           FOR 

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

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPTAXH("

               DO ^DIK

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

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

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

 +13      ;F BGPX=1:1:2000 K ^BGPTAXH(BGPX)

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

 +15      ;F BGPX=1:1:2000 K ^BGPTAXHB(BGPX)

 +16      ;S X=0 F  S X=$O(^BGPSITE(X)) Q:X'=+X  S $P(^BGPSITE(X,0),U,3)=""

 +17       QUIT