BTPW11P1.m

BTPW11P1 ;GDHS/HS/ALA-Patch 4 pre/post install program ; 29 Dec 2015  7:28 AM

 ;;1.1;CARE MANAGEMENT EVENT TRACKING;**1**;APR 1,2015;Build 5

 ;

PRE ;EP

 NEW DA,DIK

 ; Pre-delete all the events

 S DIK="^BTPW(90621,",DA=0

 F  S DA=$O(^BTPW(90621,DA)) Q:'DA  D ^DIK

 ; Pre-delete all the result types

 S DIK="^BTPW(90620.9,",DA=0

 F  S DA=$O(^BTPW(90620.9,DA)) Q:'DA  D ^DIK

 ; Pre-delete all the categories

 S DIK="^BTPW(90621.2,",DA=0

 F  S DA=$O(^BTPW(90621.2,DA)) Q:'DA  D ^DIK

 Q

 ;

POS ;EP

 ;Repoint taxonomies in 90621

 NEW EVT,TXN,TYP,ATXN,GLOB

 S EVT=0

 F  S EVT=$O(^BTPW(90621,EVT)) Q:'EVT  D

 . S TXN=0

 . F  S TXN=$O(^BTPW(90621,EVT,1,TXN)) Q:'TXN  D

 .. S TAX=$P(^BTPW(90621,EVT,1,TXN,0),U,1),TYP=$P(^(0),U,3)

 .. I TYP'=3 D

 ... S ATXN=$O(^ATXAX("B",TAX,""))

 ... S $P(^BTPW(90621,EVT,1,TXN,0),U,2)=ATXN_";ATXAX("

 .. I TYP=3 D

 ... S ATXN=$O(^ATXLAB("B",TAX,"")),GLOB=";ATXLAB("

 ... I ATXN="" S ATXN=$O(^ATXAX("B",TAX,"")),GLOB=";ATXAX(" I ATXN="" S GLOB=""

 ... S $P(^BTPW(90621,EVT,1,TXN,0),U,2)=ATXN_GLOB

 Q

 ;

EN ;EP

 ; Set BTPWRPC into BQIRPC

 NEW IEN,DA,X,DIC,Y

 S DA(1)=$$FIND1^DIC(19,"","B","BQIRPC","","","ERROR"),DIC="^DIC(19,"_DA(1)_",10,",DIC(0)="LMNZ"

 I $G(^DIC(19,DA(1),10,0))="" S ^DIC(19,DA(1),10,0)="^19.01IP^^"

 S X="BTPWRPC"

 D ^DIC I +Y<1 K DO,DD D FILE^DICN

 Q

BTPW11P1  ;GDHS/HS/ALA-Patch 4 pre/post install program ; 29 Dec 2015  7:28 AM

 +1       ;;1.1;CARE MANAGEMENT EVENT TRACKING;**1**;APR 1,2015;Build 5

 +2       ;

PRE       ;EP

 +1        NEW DA,DIK

 +2       ; Pre-delete all the events

 +3        SET DIK="^BTPW(90621,"

           SET DA=0

 +4        FOR 

               SET DA=$ORDER(^BTPW(90621,DA))

               IF 'DA

                   QUIT 

               DO ^DIK

 +5       ; Pre-delete all the result types

 +6        SET DIK="^BTPW(90620.9,"

           SET DA=0

 +7        FOR 

               SET DA=$ORDER(^BTPW(90620.9,DA))

               IF 'DA

                   QUIT 

               DO ^DIK

 +8       ; Pre-delete all the categories

 +9        SET DIK="^BTPW(90621.2,"

           SET DA=0

 +10       FOR 

               SET DA=$ORDER(^BTPW(90621.2,DA))

               IF 'DA

                   QUIT 

               DO ^DIK

 +11       QUIT 

 +12      ;

POS       ;EP

 +1       ;Repoint taxonomies in 90621

 +2        NEW EVT,TXN,TYP,ATXN,GLOB

 +3        SET EVT=0

 +4        FOR 

               SET EVT=$ORDER(^BTPW(90621,EVT))

               IF 'EVT

                   QUIT 

               Begin DoDot:1

 +5                SET TXN=0

 +6                FOR 

                       SET TXN=$ORDER(^BTPW(90621,EVT,1,TXN))

                       IF 'TXN

                           QUIT 

                       Begin DoDot:2

 +7                        SET TAX=$PIECE(^BTPW(90621,EVT,1,TXN,0),U,1)

                           SET TYP=$PIECE(^(0),U,3)

 +8                        IF TYP'=3

                               Begin DoDot:3

 +9                                SET ATXN=$ORDER(^ATXAX("B",TAX,""))

 +10                               SET $PIECE(^BTPW(90621,EVT,1,TXN,0),U,2)=ATXN_";ATXAX("

                               End DoDot:3

 +11                       IF TYP=3

                               Begin DoDot:3

 +12                               SET ATXN=$ORDER(^ATXLAB("B",TAX,""))

                                   SET GLOB=";ATXLAB("

 +13                               IF ATXN=""

                                       SET ATXN=$ORDER(^ATXAX("B",TAX,""))

                                       SET GLOB=";ATXAX("

                                       IF ATXN=""

                                           SET GLOB=""

 +14                               SET $PIECE(^BTPW(90621,EVT,1,TXN,0),U,2)=ATXN_GLOB

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +15       QUIT 

 +16      ;

EN        ;EP

 +1       ; Set BTPWRPC into BQIRPC

 +2        NEW IEN,DA,X,DIC,Y

 +3        SET DA(1)=$$FIND1^DIC(19,"","B","BQIRPC","","","ERROR")

           SET DIC="^DIC(19,"_DA(1)_",10,"

           SET DIC(0)="LMNZ"

 +4        IF $GET(^DIC(19,DA(1),10,0))=""

               SET ^DIC(19,DA(1),10,0)="^19.01IP^^"

 +5        SET X="BTPWRPC"

 +6        DO ^DIC

           IF +Y<1

               KILL DO,DD

               DO FILE^DICN

 +7        QUIT