Routine: BGP1POS2

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

 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

 F BGPX=1:1:2000 K ^BGPTAXB(BGPX)

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

 F BGPX=1:1:2000 K ^BGPTAXBB(BGPX)

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

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

 +1       ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33

 +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(^BGPPEIB(BGPX))

               IF BGPX'=+BGPX

                   QUIT

               SET DA=BGPX

               SET DIK="^BGPPEIB("

               DO ^DIK

 +4        SET BGPX=0

FOR

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

               IF BGPX'=+BGPX

                   QUIT

               SET DA=BGPX

               SET DIK="^BGPELIB("

               DO ^DIK

 +5        SET BGPX=0

FOR

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

               IF BGPX'=+BGPX

                   QUIT

               SET DA=BGPX

               SET DIK="^BGPELIIB("

               DO ^DIK

 +6        SET BGPX=0

FOR

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

               IF BGPX'=+BGPX

                   QUIT

               SET DA=BGPX

               SET DIK="^BGPCMSIB("

               DO ^DIK

 +7        SET BGPX=0

FOR

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

               IF BGPX'=+BGPX

                   QUIT

               SET DA=BGPX

               SET DIK="^BGPNPLB("

               DO ^DIK

 +8        SET BGPX=0

FOR

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

               IF BGPX'=+BGPX

                   QUIT

               SET DA=BGPX

               SET DIK="^BGPHEIB("

               DO ^DIK

 +9        SET BGPX=0

FOR

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

               IF BGPX'=+BGPX

                   QUIT

               SET DA=BGPX

               SET DIK="^BGPHEIIB("

               DO ^DIK

 +10       SET BGPX=0

FOR

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

               IF BGPX'=+BGPX

                   QUIT

               SET DA=BGPX

               SET DIK="^BGPINDBC("

               DO ^DIK

 +11       SET BGPX=0

FOR

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

               IF BGPX'=+BGPX

                   QUIT

               SET DA=BGPX

               SET DIK="^BGPINDB("

               DO ^DIK

 +12       SET BGPX=0

FOR

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

               IF BGPX'=+BGPX

                   QUIT

               SET DA=BGPX

               SET DIK="^BGPTAXB("

               DO ^DIK

 +13       SET BGPX=0

FOR

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

               IF BGPX'=+BGPX

                   QUIT

               SET DA=BGPX

               SET DIK="^BGPCMSMB("

               DO ^DIK

 +14       SET BGPX=0

FOR

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

               IF BGPX'=+BGPX

                   QUIT

               SET DA=BGPX

               SET DIK="^BGPSCAT("

               DO ^DIK

 +15       SET BGPX=0

FOR

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

               IF BGPX'=+BGPX

                   QUIT

               SET DA=BGPX

               SET DIK="^BGPICAGB("

               DO ^DIK

 +16       SET BGPX=0

FOR

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

               IF BGPX'=+BGPX

                   QUIT

               SET DA=BGPX

               SET DIK="^BGPICACB("

               DO ^DIK

 +17       FOR BGPX=0

FOR

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

                   IF BGPX'=+BGPX

                       QUIT

                   SET DA=BGPX

                   SET DIK="^BGPEOMB("

                   DO ^DIK

 +18       SET BGPX=0

FOR

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

               IF BGPX'=+BGPX

                   QUIT

               SET DA=BGPX

               SET DIK="^BGPEOMIB("

               DO ^DIK

 +19       SET BGPX=0

FOR

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

               IF BGPX'=+BGPX

                   QUIT

               SET DA=BGPX

               SET DIK="^BGPINDTC("

               DO ^DIK

 +20       SET BGPX=0

FOR

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

               IF BGPX'=+BGPX

                   QUIT

               SET DA=BGPX

               SET DIK="^BGPTAXT("

               DO ^DIK

 +21       FOR BGPX=1:1:2000

               KILL ^BGPTAXB(BGPX)

 +22       SET BGPX=0

FOR

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

               IF BGPX'=+BGPX

                   QUIT

               SET DA=BGPX

               SET DIK="^BGPTAXBB("

               DO ^DIK

 +23       FOR BGPX=1:1:2000

               KILL ^BGPTAXBB(BGPX)

 +24       SET X=0

FOR

               SET X=$ORDER(^BGPSITE(X))

               IF X'=+X

                   QUIT

               SET $PIECE(^BGPSITE(X,0),U,3)=""

 +25       QUIT

BGP1POS2.m