BQITAXXU.m

BQITAXXU ;GDHSD/HS/ALA-Update Taxonomies for pointers ; 17 Dec 2015  4:08 PM

 ;;2.7;ICARE MANAGEMENT SYSTEM;;Dec 19, 2017;Build 23

 ;

 ;Repoint taxonomies in 90507.8

 NEW ALRT,TXN,TAX,ATXN,TYP

 S ALRT=0

 F  S ALRT=$O(^BQI(90507.8,ALRT)) Q:'ALRT  D

 . S TXN=0

 . F  S TXN=$O(^BQI(90507.8,ALRT,11,TXN)) Q:'TXN  D

 .. S TAX=$P(^BQI(90507.8,ALRT,11,TXN,0),U,1),TYP=$P(^(0),U,5)

 .. I TYP'=5 D

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

 ... I ATXN'="" S $P(^BQI(90507.8,ALRT,11,TXN,0),U,2)=ATXN_";ATXAX("

 .. I TYP=5 D

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

 ... I ATXN'="" S $P(^BQI(90507.8,ALRT,11,TXN,0),U,2)=ATXN_";ATXLAB(" Q

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

 ... S $P(^BQI(90507.8,ALRT,11,TXN,0),U,2)=ATXN_";ATXAX("

 ;

 ;Repoint taxonomies in 90507

 NEW RGN,TXN,TAX,VALUE,ATXN,GLO,RPN

 S RGN=0

 F  S RGN=$O(^BQI(90507,RGN)) Q:'RGN  D

 . S TXN=0

 . F  S TXN=$O(^BQI(90507,RGN,10,TXN)) Q:'TXN  D

 .. S TAX=$P(^BQI(90507,RGN,10,TXN,0),U,1),VALUE=$P(^(0),U,2)

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

 .. I VALUE["ATXLAB" S ATXN=$O(^ATXLAB("B",TAX,"")),GLO=";ATXLAB("

 .. I ATXN="" Q

 .. S $P(^BQI(90507,RGN,10,TXN,0),U,2)=ATXN_GLO

 . S RPN=0

 . F  S RPN=$O(^BQI(90507,RGN,20,RPN)) Q:'RPN  D

 .. S TXN=0

 .. F  S TXN=$O(^BQI(90507,RGN,20,RPN,10,TXN)) Q:'TXN  D

 ... S TAX=$P(^BQI(90507,RGN,20,RPN,10,TXN,0),U,1),VALUE=$P(^(0),U,2)

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

 ... I VALUE["ATXLAB" S ATXN=$O(^ATXLAB("B",TAX,"")),GLO=";ATXLAB("

 ... I ATXN="" Q

 ... S $P(^BQI(90507,RGN,20,RPN,10,TXN,0),U,2)=ATXN_GLO

 ;

 ;Repoint taxonomies in 90508

 NEW BQIDA,TXN,TAX,VALUE,ATXN,GLO

 S BQIDA=1,TXN=0

 F  S TXN=$O(^BQI(90508,BQIDA,10,TXN)) Q:'TXN  D

 . S TAX=$P(^BQI(90508,BQIDA,10,TXN,0),U,1),TYP=$P(^(0),U,3)

 . I TYP'=5 D

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

 .. I ATXN'="" S $P(^BQI(90508,BQIDA,10,TXN,0),U,2)=ATXN_";ATXAX("

 . I TYP=5 D

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

 .. I ATXN'="" S $P(^BQI(90508,BQIDA,10,TXN,0),U,2)=ATXN_";ATXLAB(" Q

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

 .. S $P(^BQI(90508,BQIDA,10,TXN,0),U,2)=ATXN_";ATXAX("

 ;

LTAX ;EP  Add Lab Taxonomies to ^ATXLAB

 NEW X,DIC,DLAYGO,DA,DR,DIE,Y,LTAX,D0,DINUM,TAXX,ATXN

 S DIC="^ATXLAB(",DIC(0)="L",DLAYGO=9002228

 ; Loop through the Taxonomies

 D LDLAB(.LTAX)

 F BJ=1:1 Q:'$D(LTAX(BJ))  S X=LTAX(BJ) D

 . I $D(^ATXLAB("B",X)) Q  ; Skip pre-existing Lab taxonomies

 . D ^DIC S DA=+Y

 . I DA<1 Q

 . S BQTXUP(9002228,DA_",",.02)=$P(X," ",2,999)

 . S BQTXUP(9002228,DA_",",.05)=DUZ

 . S BQTXUP(9002228,DA_",",.06)=DT

 . S BQTXUP(9002228,DA_",",.09)=60

 . D FILE^DIE("I","BQTXUP")

 . S BQTXUP(9002228,DA_",",.08)="B"

 . D FILE^DIE("E","BQTXUP")

 ;

 F BJ=1:1 Q:'$D(LTAX(BJ))  S TAXX=LTAX(BJ) D

 . S TXN=$O(^BQI(90508,BQIDA,10,"B",TAXX,"")) I TXN'="" Q

 . NEW DA,DIC,DLAYGO,IENS

 . S DA(1)=BQIDA,DIC(0)="L",DLAYGO=90508.03,DIC="^BQI(90508,"_DA(1)_",10,",X=TAXX

 . D ^DIC

 . S DA=+Y I DA=-1 Q

 . S IENS=$$IENS^DILF(.DA)

 . S BQIUPD(90508.03,IENS,.03)=5,BQIUPD(90508.03,IENS,.04)="Y",BQIUPD(90508.03,IENS,.05)="T"

 . D FILE^DIE("","BQIUPD","ERROR")

 . S ATXN=$O(^ATXLAB("B",TAXX,""))

 . I ATXN'="" S $P(^BQI(90508,DA(1),10,DA,0),U,2)=ATXN_";ATXLAB(" Q

 K DA,BJ,BQTXUP,DIC,DLAYGO,DINUM,D0,DR,X,Y

 ;

 Q

 ;

LDLAB(ARRAY) ;EP;Load site-populated Lab tests

 NEW I,TEXT

 F I=1:1 S TEXT=$P($T(LAB+I),";;",2) Q:TEXT=""  S ARRAY(I)=TEXT

 Q

 ;

LAB ;EP;LAB TESTS (SITE-POPULATED)

 ;;BQI MMR TITER TAX

 ;;BQI HEP A TITER TAX

 ;;BQI HEP B TITER TAX

 ;;BQI VARICELLA TITER TAX

BQITAXXU  ;GDHSD/HS/ALA-Update Taxonomies for pointers ; 17 Dec 2015  4:08 PM

 +1       ;;2.7;ICARE MANAGEMENT SYSTEM;;Dec 19, 2017;Build 23

 +2       ;

 +3       ;Repoint taxonomies in 90507.8

 +4        NEW ALRT,TXN,TAX,ATXN,TYP

 +5        SET ALRT=0

 +6        FOR 

               SET ALRT=$ORDER(^BQI(90507.8,ALRT))

               IF 'ALRT

                   QUIT 

               Begin DoDot:1

 +7                SET TXN=0

 +8                FOR 

                       SET TXN=$ORDER(^BQI(90507.8,ALRT,11,TXN))

                       IF 'TXN

                           QUIT 

                       Begin DoDot:2

 +9                        SET TAX=$PIECE(^BQI(90507.8,ALRT,11,TXN,0),U,1)

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

 +10                       IF TYP'=5

                               Begin DoDot:3

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

 +12                               IF ATXN'=""

                                       SET $PIECE(^BQI(90507.8,ALRT,11,TXN,0),U,2)=ATXN_";ATXAX("

                               End DoDot:3

 +13                       IF TYP=5

                               Begin DoDot:3

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

 +15                               IF ATXN'=""

                                       SET $PIECE(^BQI(90507.8,ALRT,11,TXN,0),U,2)=ATXN_";ATXLAB("

                                       QUIT 

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

 +17                               SET $PIECE(^BQI(90507.8,ALRT,11,TXN,0),U,2)=ATXN_";ATXAX("

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +18      ;

 +19      ;Repoint taxonomies in 90507

 +20       NEW RGN,TXN,TAX,VALUE,ATXN,GLO,RPN

 +21       SET RGN=0

 +22       FOR 

               SET RGN=$ORDER(^BQI(90507,RGN))

               IF 'RGN

                   QUIT 

               Begin DoDot:1

 +23               SET TXN=0

 +24               FOR 

                       SET TXN=$ORDER(^BQI(90507,RGN,10,TXN))

                       IF 'TXN

                           QUIT 

                       Begin DoDot:2

 +25                       SET TAX=$PIECE(^BQI(90507,RGN,10,TXN,0),U,1)

                           SET VALUE=$PIECE(^(0),U,2)

 +26                       IF VALUE["ATXAX"

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

                               SET GLO=";ATXAX("

 +27                       IF VALUE["ATXLAB"

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

                               SET GLO=";ATXLAB("

 +28                       IF ATXN=""

                               QUIT 

 +29                       SET $PIECE(^BQI(90507,RGN,10,TXN,0),U,2)=ATXN_GLO

                       End DoDot:2

 +30               SET RPN=0

 +31               FOR 

                       SET RPN=$ORDER(^BQI(90507,RGN,20,RPN))

                       IF 'RPN

                           QUIT 

                       Begin DoDot:2

 +32                       SET TXN=0

 +33                       FOR 

                               SET TXN=$ORDER(^BQI(90507,RGN,20,RPN,10,TXN))

                               IF 'TXN

                                   QUIT 

                               Begin DoDot:3

 +34                               SET TAX=$PIECE(^BQI(90507,RGN,20,RPN,10,TXN,0),U,1)

                                   SET VALUE=$PIECE(^(0),U,2)

 +35                               IF VALUE["ATXAX"

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

                                       SET GLO=";ATXAX("

 +36                               IF VALUE["ATXLAB"

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

                                       SET GLO=";ATXLAB("

 +37                               IF ATXN=""

                                       QUIT 

 +38                               SET $PIECE(^BQI(90507,RGN,20,RPN,10,TXN,0),U,2)=ATXN_GLO

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +39      ;

 +40      ;Repoint taxonomies in 90508

 +41       NEW BQIDA,TXN,TAX,VALUE,ATXN,GLO

 +42       SET BQIDA=1

           SET TXN=0

 +43       FOR 

               SET TXN=$ORDER(^BQI(90508,BQIDA,10,TXN))

               IF 'TXN

                   QUIT 

               Begin DoDot:1

 +44               SET TAX=$PIECE(^BQI(90508,BQIDA,10,TXN,0),U,1)

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

 +45               IF TYP'=5

                       Begin DoDot:2

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

 +47                       IF ATXN'=""

                               SET $PIECE(^BQI(90508,BQIDA,10,TXN,0),U,2)=ATXN_";ATXAX("

                       End DoDot:2

 +48               IF TYP=5

                       Begin DoDot:2

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

 +50                       IF ATXN'=""

                               SET $PIECE(^BQI(90508,BQIDA,10,TXN,0),U,2)=ATXN_";ATXLAB("

                               QUIT 

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

 +52                       SET $PIECE(^BQI(90508,BQIDA,10,TXN,0),U,2)=ATXN_";ATXAX("

                       End DoDot:2

               End DoDot:1

 +53      ;

LTAX      ;EP  Add Lab Taxonomies to ^ATXLAB

 +1        NEW X,DIC,DLAYGO,DA,DR,DIE,Y,LTAX,D0,DINUM,TAXX,ATXN

 +2        SET DIC="^ATXLAB("

           SET DIC(0)="L"

           SET DLAYGO=9002228

 +3       ; Loop through the Taxonomies

 +4        DO LDLAB(.LTAX)

 +5        FOR BJ=1:1

               IF '$DATA(LTAX(BJ))

                   QUIT 

               SET X=LTAX(BJ)

               Begin DoDot:1

 +6       ; Skip pre-existing Lab taxonomies

                   IF $DATA(^ATXLAB("B",X))

                       QUIT 

 +7                DO ^DIC

                   SET DA=+Y

 +8                IF DA<1

                       QUIT 

 +9                SET BQTXUP(9002228,DA_",",.02)=$PIECE(X," ",2,999)

 +10               SET BQTXUP(9002228,DA_",",.05)=DUZ

 +11               SET BQTXUP(9002228,DA_",",.06)=DT

 +12               SET BQTXUP(9002228,DA_",",.09)=60

 +13               DO FILE^DIE("I","BQTXUP")

 +14               SET BQTXUP(9002228,DA_",",.08)="B"

 +15               DO FILE^DIE("E","BQTXUP")

               End DoDot:1

 +16      ;

 +17       FOR BJ=1:1

               IF '$DATA(LTAX(BJ))

                   QUIT 

               SET TAXX=LTAX(BJ)

               Begin DoDot:1

 +18               SET TXN=$ORDER(^BQI(90508,BQIDA,10,"B",TAXX,""))

                   IF TXN'=""

                       QUIT 

 +19               NEW DA,DIC,DLAYGO,IENS

 +20               SET DA(1)=BQIDA

                   SET DIC(0)="L"

                   SET DLAYGO=90508.03

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

                   SET X=TAXX

 +21               DO ^DIC

 +22               SET DA=+Y

                   IF DA=-1

                       QUIT 

 +23               SET IENS=$$IENS^DILF(.DA)

 +24               SET BQIUPD(90508.03,IENS,.03)=5

                   SET BQIUPD(90508.03,IENS,.04)="Y"

                   SET BQIUPD(90508.03,IENS,.05)="T"

 +25               DO FILE^DIE("","BQIUPD","ERROR")

 +26               SET ATXN=$ORDER(^ATXLAB("B",TAXX,""))

 +27               IF ATXN'=""

                       SET $PIECE(^BQI(90508,DA(1),10,DA,0),U,2)=ATXN_";ATXLAB("

                       QUIT 

               End DoDot:1

 +28       KILL DA,BJ,BQTXUP,DIC,DLAYGO,DINUM,D0,DR,X,Y

 +29      ;

 +30       QUIT 

 +31      ;

LDLAB(ARRAY) ;EP;Load site-populated Lab tests

 +1        NEW I,TEXT

 +2        FOR I=1:1

               SET TEXT=$PIECE($TEXT(LAB+I),";;",2)

               IF TEXT=""

                   QUIT 

               SET ARRAY(I)=TEXT

 +3        QUIT 

 +4       ;

LAB       ;EP;LAB TESTS (SITE-POPULATED)

 +1       ;;BQI MMR TITER TAX

 +2       ;;BQI HEP A TITER TAX

 +3       ;;BQI HEP B TITER TAX

 +4       ;;BQI VARICELLA TITER TAX