BTPW11PS.m

BTPW11PS ;VNGT/HS/ALA-Installation for CMET Version 1.1 ; 24 Apr 2008  7:46 PM

 ;;1.1;CARE MANAGEMENT EVENT TRACKING;;Apr 01, 2015;Build 25

 ;

PRE ;EP

 NEW DA,DIK

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

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

 Q

 ;

POST ;EP

 D ^BTPWA

 D ^BTPWC

 ;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

BTPW11PS  ;VNGT/HS/ALA-Installation for CMET Version 1.1 ; 24 Apr 2008  7:46 PM

 +1       ;;1.1;CARE MANAGEMENT EVENT TRACKING;;Apr 01, 2015;Build 25

 +2       ;

PRE       ;EP

 +1        NEW DA,DIK

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

           SET DA=0

 +3        FOR 

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

               IF 'DA

                   QUIT 

               DO ^DIK

 +4        QUIT 

 +5       ;

POST      ;EP

 +1        DO ^BTPWA

 +2        DO ^BTPWC

 +3       ;Repoint taxonomies in 90621

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

 +5        SET EVT=0

 +6        FOR 

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

               IF 'EVT

                   QUIT 

               Begin DoDot:1

 +7                SET TXN=0

 +8                FOR 

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

                       IF 'TXN

                           QUIT 

                       Begin DoDot:2

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

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

 +10                       IF TYP'=3

                               Begin DoDot:3

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

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

                               End DoDot:3

 +13                       IF TYP=3

                               Begin DoDot:3

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

                                   SET GLOB=";ATXLAB("

 +15                               IF ATXN=""

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

                                       SET GLOB=";ATXAX("

                                       IF ATXN=""

                                           SET GLOB=""

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

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +17       QUIT