Routine: BQI25P2

BQI25P2 ;GDHS/HCS/ALA-Version 2.5 Patch 2 ; 03 Aug 2016  3:32 PM

 ;;2.5;ICARE MANAGEMENT SYSTEM;**2**;May 24, 2016;Build 14

PRE ;EP

 S DIK="^BQI(90509.9,",DA=0

 F  S DA=$O(^BQI(90509.9,DA)) Q:'DA  D ^DIK

POS ;EP

 ;Update glossary

 NEW GN,GNM,GSN,BQIUPD

 S GN=0

 F  S GN=$O(^BQI(90509.9,GN)) Q:'GN  D

 . S GNM=$P(^BQI(90509.9,GN,0),U,1)

 . S GSN=$O(^BQI(90508.2,"B",GNM,"")) Q:GSN=""

 . S BQIUPD(90508.2,GSN_",",1)="@"

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

 . M ^BQI(90508.2,GSN,1)=^BQI(90509.9,GN,1)

 D ^BQIULAY

 D ^BQIATX

 S BQIDA=1 D LTAX^BQITAXXU

 ; Update Care Mgmt

 S ^BQI(90506.5,24,10,14,0)="EY_14^3^TB Quantiferon^^D^O^^A^1"

 S ^BQI(90506.5,24,10,14,2)="D TB^BQICMUTL"

 S ^BQI(90506.5,24,10,14,4,0)="^^2^2^3160913^"

 S ^BQI(90506.5,24,10,14,4,1,0)="Most recent TB Quantiferon lab test or refusal from taxonomy BQI TB "

 S ^BQI(90506.5,24,10,14,4,2,0)="QUANTIFERON LOINC or BQI TB QUANTIFERON TEST."

 S ^BQI(90506.5,24,10,"B","EY_14",14)=""

 S ^BQI(90506.5,24,10,"C","TB Quantiferon",14)=""

 S ^BQI(90506.5,24,10,11,1)="D SER^BQICMUTL(""BKM HEP A IZ CVX CODES"",.RESULT)"

 S ^BQI(90506.5,24,10,12,1)="D SER^BQICMUTL(""BKM HEP B IZ CVX CODES"",.RESULT)"

 S ^BQI(90506.5,24,10,13,1)="D SER^BQICMUTL(""BQI MMR IZ CVX CODES"",.RESULT)"

WGT ; fix Weight Management

 I $P($G(^BQI(90508,1,"GPRA")),U,1)=2017 D

 . S $P(^BQI(90508,1,22,2,1,53,0),"^",1)="2017_2720"

 . K ^BQI(90508,1,22,2,1,"B","2016_2720",53)

 . S ^BQI(90508,1,22,2,1,"B","2017_2720",53)=""

 . S $P(^BQI(90508,1,22,2,1,54,0),"^",1)="2017_2721"

 . K ^BQI(90508,1,22,2,1,"B","2016_2721",54)

 . S ^BQI(90508,1,22,2,1,"B","2017_2721",54)=""

 . S $P(^BQI(90508,1,22,2,1,55,0),"^",1)="2017_2722"

 . K ^BQI(90508,1,22,2,1,"B","2016_2722",55)

 . S ^BQI(90508,1,22,2,1,"B","2017_2722",55)=""

 . S ^BQI(90508,1,22,2,1,56,2,1,0)="2017_2720"

 . S ^BQI(90508,1,22,2,1,56,2,2,0)="2017_2721"

 . S ^BQI(90508,1,22,2,1,56,2,3,0)="2017_2722"

 . K ^BQI(90508,1,22,2,1,56,2,"B","2016_2720",1)

 . S ^BQI(90508,1,22,2,1,56,2,"B","2017_2720",1)=""

 . K ^BQI(90508,1,22,2,1,56,2,"B","2016_2721",2)

 . S ^BQI(90508,1,22,2,1,56,2,"B","2017_2721",2)=""

 . S ^BQI(90508,1,22,2,1,56,2,"B","2017_2722",3)=""

 . S ^BQI(90508,1,22,2,1,56,2,0)="^90508.2212^3^3"

BQI25P2   ;GDHS/HCS/ALA-Version 2.5 Patch 2 ; 03 Aug 2016  3:32 PM

 +1       ;;2.5;ICARE MANAGEMENT SYSTEM;**2**;May 24, 2016;Build 14

 +2       ;

 +3       ;

PRE       ;EP

 +1        SET DIK="^BQI(90509.9,"

           SET DA=0

 +2        FOR

               SET DA=$ORDER(^BQI(90509.9,DA))

               IF 'DA

                   QUIT

               DO ^DIK

 +3        QUIT

 +4       ;

POS       ;EP

 +1       ;Update glossary

 +2        NEW GN,GNM,GSN,BQIUPD

 +3        SET GN=0

 +4        FOR

               SET GN=$ORDER(^BQI(90509.9,GN))

               IF 'GN

                   QUIT

               Begin DoDot:1

 +5                SET GNM=$PIECE(^BQI(90509.9,GN,0),U,1)

 +6                SET GSN=$ORDER(^BQI(90508.2,"B",GNM,""))

                   IF GSN=""

                       QUIT

 +7                SET BQIUPD(90508.2,GSN_",",1)="@"

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

 +9                MERGE ^BQI(90508.2,GSN,1)=^BQI(90509.9,GN,1)

               End DoDot:1

 +10      ;

 +11       DO ^BQIULAY

 +12       DO ^BQIATX

 +13       SET BQIDA=1

           DO LTAX^BQITAXXU

 +14      ;

 +15      ; Update Care Mgmt

 +16       SET ^BQI(90506.5,24,10,14,0)="EY_14^3^TB Quantiferon^^D^O^^A^1"

 +17       SET ^BQI(90506.5,24,10,14,2)="D TB^BQICMUTL"

 +18       SET ^BQI(90506.5,24,10,14,4,0)="^^2^2^3160913^"

 +19       SET ^BQI(90506.5,24,10,14,4,1,0)="Most recent TB Quantiferon lab test or refusal from taxonomy BQI TB "

 +20       SET ^BQI(90506.5,24,10,14,4,2,0)="QUANTIFERON LOINC or BQI TB QUANTIFERON TEST."

 +21       SET ^BQI(90506.5,24,10,"B","EY_14",14)=""

 +22       SET ^BQI(90506.5,24,10,"C","TB Quantiferon",14)=""

 +23       SET ^BQI(90506.5,24,10,11,1)="D SER^BQICMUTL(""BKM HEP A IZ CVX CODES"",.RESULT)"

 +24       SET ^BQI(90506.5,24,10,12,1)="D SER^BQICMUTL(""BKM HEP B IZ CVX CODES"",.RESULT)"

 +25       SET ^BQI(90506.5,24,10,13,1)="D SER^BQICMUTL(""BQI MMR IZ CVX CODES"",.RESULT)"

 +26      ;

WGT       ; fix Weight Management

 +1        IF $PIECE($GET(^BQI(90508,1,"GPRA")),U,1)=2017

               Begin DoDot:1

 +2                SET $PIECE(^BQI(90508,1,22,2,1,53,0),"^",1)="2017_2720"

 +3                KILL ^BQI(90508,1,22,2,1,"B","2016_2720",53)

 +4                SET ^BQI(90508,1,22,2,1,"B","2017_2720",53)=""

 +5                SET $PIECE(^BQI(90508,1,22,2,1,54,0),"^",1)="2017_2721"

 +6                KILL ^BQI(90508,1,22,2,1,"B","2016_2721",54)

 +7                SET ^BQI(90508,1,22,2,1,"B","2017_2721",54)=""

 +8                SET $PIECE(^BQI(90508,1,22,2,1,55,0),"^",1)="2017_2722"

 +9                KILL ^BQI(90508,1,22,2,1,"B","2016_2722",55)

 +10               SET ^BQI(90508,1,22,2,1,"B","2017_2722",55)=""

 +11               SET ^BQI(90508,1,22,2,1,56,2,1,0)="2017_2720"

 +12               SET ^BQI(90508,1,22,2,1,56,2,2,0)="2017_2721"

 +13               SET ^BQI(90508,1,22,2,1,56,2,3,0)="2017_2722"

 +14               KILL ^BQI(90508,1,22,2,1,56,2,"B","2016_2720",1)

 +15               SET ^BQI(90508,1,22,2,1,56,2,"B","2017_2720",1)=""

 +16               KILL ^BQI(90508,1,22,2,1,56,2,"B","2016_2721",2)

 +17               SET ^BQI(90508,1,22,2,1,56,2,"B","2017_2721",2)=""

 +18               SET ^BQI(90508,1,22,2,1,56,2,"B","2017_2722",3)=""

 +19               SET ^BQI(90508,1,22,2,1,56,2,0)="^90508.2212^3^3"

               End DoDot:1

 +20      ;

 +21       QUIT

BQI25P2.m