BGP2POS2.m

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

 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66

 ;

 ;

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

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

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

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

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

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

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

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

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

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

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

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

 Q

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

 +1       ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66

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

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPPEIW("

               DO ^DIK

 +4        SET BGPX=0

           FOR 

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

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPELIW("

               DO ^DIK

 +5        SET BGPX=0

           FOR 

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

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPELIIW("

               DO ^DIK

 +6        SET BGPX=0

           FOR 

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

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPNPLW("

               DO ^DIK

 +7        SET BGPX=0

           FOR 

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

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPINDWC("

               DO ^DIK

 +8        SET BGPX=0

           FOR 

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

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPINDW("

               DO ^DIK

 +9        SET BGPX=0

           FOR 

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

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPTAXW("

               DO ^DIK

 +10       SET BGPX=0

           FOR 

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

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPSCAT("

               DO ^DIK

 +11       SET BGPX=0

           FOR 

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

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPICAGW("

               DO ^DIK

 +12       SET BGPX=0

           FOR 

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

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPICACW("

               DO ^DIK

 +13       FOR BGPX=1:1:2000

               KILL ^BGPTAXW(BGPX)

 +14       SET BGPX=0

           FOR 

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

               IF BGPX'=+BGPX

                   QUIT 

               SET DA=BGPX

               SET DIK="^BGPTAXWB("

               DO ^DIK

 +15       FOR BGPX=1:1:2000

               KILL ^BGPTAXWB(BGPX)

 +16       SET X=0

           FOR 

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

               IF X'=+X

                   QUIT 

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

 +17       QUIT