Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BTPW11PS

BTPW11PS.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. PRE ;EP
  1. NEW DA,DIK
  1. S DIK="^BTPW(90621,",DA=0
  1. F S DA=$O(^BTPW(90621,DA)) Q:'DA D ^DIK
  1. Q
  1. ;
  1. POST ;EP
  1. D ^BTPWA
  1. D ^BTPWC
  1. ;Repoint taxonomies in 90621
  1. NEW EVT,TXN,TYP,ATXN,GLOB
  1. S EVT=0
  1. F S EVT=$O(^BTPW(90621,EVT)) Q:'EVT D
  1. . S TXN=0
  1. . F S TXN=$O(^BTPW(90621,EVT,1,TXN)) Q:'TXN D
  1. .. S TAX=$P(^BTPW(90621,EVT,1,TXN,0),U,1),TYP=$P(^(0),U,3)
  1. .. I TYP'=3 D
  1. ... S ATXN=$O(^ATXAX("B",TAX,""))
  1. ... S $P(^BTPW(90621,EVT,1,TXN,0),U,2)=ATXN_";ATXAX("
  1. .. I TYP=3 D
  1. ... S ATXN=$O(^ATXLAB("B",TAX,"")),GLOB=";ATXLAB("
  1. ... I ATXN="" S ATXN=$O(^ATXAX("B",TAX,"")),GLOB=";ATXAX(" I ATXN="" S GLOB=""
  1. ... S $P(^BTPW(90621,EVT,1,TXN,0),U,2)=ATXN_GLOB
  1. Q