BQI24P1.m

BQI24P1 ;GDIT/HSCD/ALA-Version 2.4 Patch 1 ; 23 Oct 2015  10:57 AM

 ;;2.4;ICARE MANAGEMENT SYSTEM;**1**;Apr 01, 2015;Build 2

 ;

 ;

PRE ;EP

 Q

 ;

POS ;EP

 NEW TXN

 S TXN=$O(^ATXAX("B","BQI SUICIDE ATTEMPT DXS",""))

 I TXN'="" D

 . I '$D(^ATXAX(TXN,21,"B",300.9)) Q

 . K ^ATXAX(TXN,21)

 . S ^ATXAX(TXN,21,0)="^9002226.02101A^1^1"

 . S ^ATXAX(TXN,21,1,0)="T14.91 ^T14.91 ^30"

 . S ^ATXAX(TXN,21,"AA","T14.91 ","T14.91 ")=""

 . S ^ATXAX(TXN,21,"B","T14.91 ",3)=""

 ;

 ;Add new Measles Loinc taxonomy

 D ^BQIB

 ;

LTAX ;  Add Lab Taxonomies to ^ATXLAB

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

 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")

 ;

 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 MEASLES ALERT TAX

BQI24P1   ;GDIT/HSCD/ALA-Version 2.4 Patch 1 ; 23 Oct 2015  10:57 AM

 +1       ;;2.4;ICARE MANAGEMENT SYSTEM;**1**;Apr 01, 2015;Build 2

 +2       ;

 +3       ;

PRE       ;EP

 +1        QUIT 

 +2       ;

POS       ;EP

 +1        NEW TXN

 +2        SET TXN=$ORDER(^ATXAX("B","BQI SUICIDE ATTEMPT DXS",""))

 +3        IF TXN'=""

               Begin DoDot:1

 +4                IF '$DATA(^ATXAX(TXN,21,"B",300.9))

                       QUIT 

 +5                KILL ^ATXAX(TXN,21)

 +6                SET ^ATXAX(TXN,21,0)="^9002226.02101A^1^1"

 +7                SET ^ATXAX(TXN,21,1,0)="T14.91 ^T14.91 ^30"

 +8                SET ^ATXAX(TXN,21,"AA","T14.91 ","T14.91 ")=""

 +9                SET ^ATXAX(TXN,21,"B","T14.91 ",3)=""

               End DoDot:1

 +10      ;

 +11      ;Add new Measles Loinc taxonomy

 +12       DO ^BQIB

 +13      ;

LTAX      ;  Add Lab Taxonomies to ^ATXLAB

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

 +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       KILL DA,BJ,BQTXUP,DIC,DLAYGO,DINUM,D0,DR,X,Y

 +18       QUIT 

 +19      ;

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 MEASLES ALERT TAX