BTPW12P1.m

BTPW12P1 ;GDIT/HCSD/ALA-CMET Version 2.1 Patch 1 ; 29 Mar 2018  1:14 PM

 ;;1.2;CARE MANAGEMENT EVENT TRACKING;**1**;JUL 07,2017;Build 5

 ;

PRE ;

 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

 Q

 ;

POS ;

 ; Set cross-reference

 NEW DIK

 S DIK="^BTPWQ(" D IXALL^DIK

 ; Update taxonomies

 D ^BTPWC

 ; Update Chlamydia event

 ;S $P(^BTPW(90621,2,1,1,0),"^",1)="BTPW CHLAMYDIA CPTS"

 ;S TXX=$O(^ATXAX("B","BTPW CHLAMYDIA CPTS","")) I TXX="" Q

 ;S $P(^BTPW(90621,2,1,1,0),"^",2)=TXX_";ATXAX("

 D UTX

 Q

 ;

UTX ;

 ;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

BTPW12P1  ;GDIT/HCSD/ALA-CMET Version 2.1 Patch 1 ; 29 Mar 2018  1:14 PM

 +1       ;;1.2;CARE MANAGEMENT EVENT TRACKING;**1**;JUL 07,2017;Build 5

 +2       ;

PRE       ;

 +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        QUIT 

 +6       ;

POS       ;

 +1       ; Set cross-reference

 +2        NEW DIK

 +3        SET DIK="^BTPWQ("

           DO IXALL^DIK

 +4       ; Update taxonomies

 +5        DO ^BTPWC

 +6       ; Update Chlamydia event

 +7       ;S $P(^BTPW(90621,2,1,1,0),"^",1)="BTPW CHLAMYDIA CPTS"

 +8       ;S TXX=$O(^ATXAX("B","BTPW CHLAMYDIA CPTS","")) I TXX="" Q

 +9       ;S $P(^BTPW(90621,2,1,1,0),"^",2)=TXX_";ATXAX("

 +10       DO UTX

 +11       QUIT 

 +12      ;

UTX       ;

 +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