- 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