BQI24POS.m

BQI24POS ;GDIT/HS/ALA-Post Installation program ; 20 Aug 2012  4:20 PM

 ;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41

 ;

 ;

EN ;

 ;Set the version number

 NEW DA

 S DA=$O(^BQI(90508,0))

 S BQIUPD(90508,DA_",",.08)="2.4.0.11"

 S BQIUPD(90508,DA_",",.09)="2.4.0.11"

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

 K BQIUPD

 ;

 ; Set BTPWRPC and BUSARPC into BQIRPC

 NEW IEN,DA,X,DIC,Y

 S DA(1)=$$FIND1^DIC(19,"","B","BQIRPC","","","ERROR"),DIC="^DIC(19,"_DA(1)_",10,",DIC(0)="LMNZ"

 I $G(^DIC(19,DA(1),10,0))="" S ^DIC(19,DA(1),10,0)="^19.01IP^^"

 S X="BTPWRPC"

 D ^DIC I +Y<1 K DO,DD D FILE^DICN

 NEW IEN,DA,X,DIC,Y

 S DA(1)=$$FIND1^DIC(19,"","B","BQIRPC","","","ERROR"),DIC="^DIC(19,"_DA(1)_",10,",DIC(0)="LMNZ"

 I $G(^DIC(19,DA(1),10,0))="" S ^DIC(19,DA(1),10,0)="^19.01IP^^"

 S X="BUSARPC"

 D ^DIC I +Y<1 K DO,DD D FILE^DICN

 ;

 ; Update treatment prompts in APCHSURV

 D ^BQITRUPD

 ;

 ; Update taxonomies

 D ^BQIY,^BQIXV,^BQIAX

 ;

 ; Update IPC

 D ^BQIIPC5

 ;

 ; Update layout items

 D ^BQILYUPD

 ;

 ; Update panel descriptions

 NEW NDZ,PN

 I $D(^BQICARE(.5)) K ^BQICARE(.5)

 S NDZ=0

 F  S NDZ=$O(^BQICARE(NDZ)) Q:'NDZ  D

 . S PN=0

 . F  S PN=$O(^BQICARE(NDZ,1,PN)) Q:'PN  D

 .. NEW OWNR,PLIEN

 .. S OWNR=NDZ,PLIEN=PN

 .. D DSC^BQIPLFL

 ;

GLS ;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)

 ;

 ;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 PRENATAL TAX

 ;;BQI C.TRACH DNA QUANT TAX

 ;;BQI C.TRACH NON-SPECIFIC TAX

 ;;BQI C.TRACH SPECIFIC TAX

 ;;BQI HEP A TESTS TAX

 ;;BQI HEP B CORE TESTS TAX

 ;;BQI HEP B QUAL TEST TAX

 ;;BQI HEP B QUANT TEST TAX

 ;;BQI HEP C QUAL TEST TAX

 ;;BQI HEP C QUANT TEST TAX

 ;;BQI HIB CULTURE TEST TAX

 ;;BQI HIB QUAL TEST TAX

 ;;BQI HIB QUANT TEST TAX

 ;;BQI HIV AB QUAL SCREEN TAX

 ;;BQI HIV AB QUANT SCREEN TAX

 ;;BQI HIV ID SPEC CONFIRM TAX

 ;;BQI HIV QUAL ANTIGEN TAX

 ;;BQI HIV QUAL CONFIRM TAX

 ;;BQI HIV QUAL NUC ACID TAX

 ;;BQI HIV QUANT ANTIGEN TAX

 ;;BQI HIV QUANT CONFIRM TAX

 ;;BQI HIV QUANT NUC ACID TAX

 ;;BQI HIV VIROLOGIC TEST TAX

 ;;BQI MEASLES ID SPEC TEST TAX

 ;;BQI MEASLES QUAL TEST TAX

 ;;BQI MEASLES QUAN TEST TAX

 ;;BQI MENINGITIS GRAM STAIN TAX

 ;;BQI MENINGITIS ID SPEC TAX

 ;;BQI MENINGITIS QUAL TEST TAX

 ;;BQI MENINGITIS QUAN TAX

 ;;BQI MYCOBACT TB CULT TAX

 ;;BQI PPD DIAMETER TAX

 ;;BQI S PNEUM CULTURE TEST TAX

 ;;BQI S PNEUM SUSCEPT TEST TAX

 ;;BQI SYPHILIS REAGIN TEST TAX

 ;;BQI SYPHILIS TP-AB TEST TAX

 ;;BQI TB GAMMA REL QUAL TEST TAX

 ;;BQI TB GAMMA REL QUANT TEST TX

 ;;BQI TB NONSPEC AFB TEST TAX

 ;;BQI TB RNA DNA QUAL TEST TAX

 ;;BQI TB RNA DNA QUANT TEST TAX

 ;;BQI TB SPECIFIC AFB TEST TAX

 ;;BGP GPRA ESTIMATED GFR TAX

 ;;BKM CMV TEST TAX

 ;;BKM COCCI ANTIBODY TAX

 ;;BKM FTA-ABS TEST TAX

 ;;BKM GONORRHEA TEST TAX

 ;;BKM HEP A TAX

 ;;BKM HEP B TAX

 ;;BKM HEP C CONFIRMATORY TAX

 ;;BKM HEP C SCREENING TAX

 ;;BKM HEPATITIS PANEL TAX

 ;;BKM PPD TAX

 ;;BKM RPR TAX

 ;;BKM TOXOPLASMOSIS TESTS TAX

 ;;BKMV CD4 ABS TESTS TAX

 ;;BKMV HIV GENOTYPE TESTS TAX

 ;;BKMV HIV PHENOTYPE TESTS TAX

 ;;BTPW HPV DNA SCREEN TAX

 ;;BTPW PREGNANCY TEST TAX

 ;

 Q

BQI24POS  ;GDIT/HS/ALA-Post Installation program ; 20 Aug 2012  4:20 PM

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

 +2       ;

 +3       ;

EN        ;

 +1       ;Set the version number

 +2        NEW DA

 +3        SET DA=$ORDER(^BQI(90508,0))

 +4        SET BQIUPD(90508,DA_",",.08)="2.4.0.11"

 +5        SET BQIUPD(90508,DA_",",.09)="2.4.0.11"

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

 +7        KILL BQIUPD

 +8       ;

 +9       ; Set BTPWRPC and BUSARPC into BQIRPC

 +10       NEW IEN,DA,X,DIC,Y

 +11       SET DA(1)=$$FIND1^DIC(19,"","B","BQIRPC","","","ERROR")

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

           SET DIC(0)="LMNZ"

 +12       IF $GET(^DIC(19,DA(1),10,0))=""

               SET ^DIC(19,DA(1),10,0)="^19.01IP^^"

 +13       SET X="BTPWRPC"

 +14       DO ^DIC

           IF +Y<1

               KILL DO,DD

               DO FILE^DICN

 +15       NEW IEN,DA,X,DIC,Y

 +16       SET DA(1)=$$FIND1^DIC(19,"","B","BQIRPC","","","ERROR")

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

           SET DIC(0)="LMNZ"

 +17       IF $GET(^DIC(19,DA(1),10,0))=""

               SET ^DIC(19,DA(1),10,0)="^19.01IP^^"

 +18       SET X="BUSARPC"

 +19       DO ^DIC

           IF +Y<1

               KILL DO,DD

               DO FILE^DICN

 +20      ;

 +21      ; Update treatment prompts in APCHSURV

 +22       DO ^BQITRUPD

 +23      ;

 +24      ; Update taxonomies

 +25       DO ^BQIY

           DO ^BQIXV

           DO ^BQIAX

 +26      ;

 +27      ; Update IPC

 +28       DO ^BQIIPC5

 +29      ;

 +30      ; Update layout items

 +31       DO ^BQILYUPD

 +32      ;

 +33      ; Update panel descriptions

 +34       NEW NDZ,PN

 +35       IF $DATA(^BQICARE(.5))

               KILL ^BQICARE(.5)

 +36       SET NDZ=0

 +37       FOR 

               SET NDZ=$ORDER(^BQICARE(NDZ))

               IF 'NDZ

                   QUIT 

               Begin DoDot:1

 +38               SET PN=0

 +39               FOR 

                       SET PN=$ORDER(^BQICARE(NDZ,1,PN))

                       IF 'PN

                           QUIT 

                       Begin DoDot:2

 +40                       NEW OWNR,PLIEN

 +41                       SET OWNR=NDZ

                           SET PLIEN=PN

 +42                       DO DSC^BQIPLFL

                       End DoDot:2

               End DoDot:1

 +43      ;

GLS       ;EP Update glossary

 +1        NEW GN,GNM,GSN,BQIUPD

 +2        SET GN=0

 +3        FOR 

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

               IF 'GN

                   QUIT 

               Begin DoDot:1

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

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

                   IF GSN=""

                       QUIT 

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

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

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

               End DoDot:1

 +9       ;

 +10      ;Repoint taxonomies in 90507.8

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

 +12       SET ALRT=0

 +13       FOR 

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

               IF 'ALRT

                   QUIT 

               Begin DoDot:1

 +14               SET TXN=0

 +15               FOR 

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

                       IF 'TXN

                           QUIT 

                       Begin DoDot:2

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

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

 +17                       IF TYP'=5

                               Begin DoDot:3

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

 +19                               IF ATXN'=""

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

                               End DoDot:3

 +20                       IF TYP=5

                               Begin DoDot:3

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

 +22                               IF ATXN'=""

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

                                       QUIT 

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

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

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +25      ;

 +26      ;Repoint taxonomies in 90507

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

 +28       SET RGN=0

 +29       FOR 

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

               IF 'RGN

                   QUIT 

               Begin DoDot:1

 +30               SET TXN=0

 +31               FOR 

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

                       IF 'TXN

                           QUIT 

                       Begin DoDot:2

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

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

 +33                       IF VALUE["ATXAX"

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

                               SET GLO=";ATXAX("

 +34                       IF VALUE["ATXLAB"

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

                               SET GLO=";ATXLAB("

 +35                       IF ATXN=""

                               QUIT 

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

                       End DoDot:2

 +37               SET RPN=0

 +38               FOR 

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

                       IF 'RPN

                           QUIT 

                       Begin DoDot:2

 +39                       SET TXN=0

 +40                       FOR 

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

                               IF 'TXN

                                   QUIT 

                               Begin DoDot:3

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

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

 +42                               IF VALUE["ATXAX"

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

                                       SET GLO=";ATXAX("

 +43                               IF VALUE["ATXLAB"

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

                                       SET GLO=";ATXLAB("

 +44                               IF ATXN=""

                                       QUIT 

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

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +46      ;

 +47      ;Repoint taxonomies in 90508

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

 +49       SET BQIDA=1

           SET TXN=0

 +50       FOR 

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

               IF 'TXN

                   QUIT 

               Begin DoDot:1

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

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

 +52               IF TYP'=5

                       Begin DoDot:2

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

 +54                       IF ATXN'=""

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

                       End DoDot:2

 +55               IF TYP=5

                       Begin DoDot:2

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

 +57                       IF ATXN'=""

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

                               QUIT 

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

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

                       End DoDot:2

               End DoDot:1

 +60      ;

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 PRENATAL TAX

 +2       ;;BQI C.TRACH DNA QUANT TAX

 +3       ;;BQI C.TRACH NON-SPECIFIC TAX

 +4       ;;BQI C.TRACH SPECIFIC TAX

 +5       ;;BQI HEP A TESTS TAX

 +6       ;;BQI HEP B CORE TESTS TAX

 +7       ;;BQI HEP B QUAL TEST TAX

 +8       ;;BQI HEP B QUANT TEST TAX

 +9       ;;BQI HEP C QUAL TEST TAX

 +10      ;;BQI HEP C QUANT TEST TAX

 +11      ;;BQI HIB CULTURE TEST TAX

 +12      ;;BQI HIB QUAL TEST TAX

 +13      ;;BQI HIB QUANT TEST TAX

 +14      ;;BQI HIV AB QUAL SCREEN TAX

 +15      ;;BQI HIV AB QUANT SCREEN TAX

 +16      ;;BQI HIV ID SPEC CONFIRM TAX

 +17      ;;BQI HIV QUAL ANTIGEN TAX

 +18      ;;BQI HIV QUAL CONFIRM TAX

 +19      ;;BQI HIV QUAL NUC ACID TAX

 +20      ;;BQI HIV QUANT ANTIGEN TAX

 +21      ;;BQI HIV QUANT CONFIRM TAX

 +22      ;;BQI HIV QUANT NUC ACID TAX

 +23      ;;BQI HIV VIROLOGIC TEST TAX

 +24      ;;BQI MEASLES ID SPEC TEST TAX

 +25      ;;BQI MEASLES QUAL TEST TAX

 +26      ;;BQI MEASLES QUAN TEST TAX

 +27      ;;BQI MENINGITIS GRAM STAIN TAX

 +28      ;;BQI MENINGITIS ID SPEC TAX

 +29      ;;BQI MENINGITIS QUAL TEST TAX

 +30      ;;BQI MENINGITIS QUAN TAX

 +31      ;;BQI MYCOBACT TB CULT TAX

 +32      ;;BQI PPD DIAMETER TAX

 +33      ;;BQI S PNEUM CULTURE TEST TAX

 +34      ;;BQI S PNEUM SUSCEPT TEST TAX

 +35      ;;BQI SYPHILIS REAGIN TEST TAX

 +36      ;;BQI SYPHILIS TP-AB TEST TAX

 +37      ;;BQI TB GAMMA REL QUAL TEST TAX

 +38      ;;BQI TB GAMMA REL QUANT TEST TX

 +39      ;;BQI TB NONSPEC AFB TEST TAX

 +40      ;;BQI TB RNA DNA QUAL TEST TAX

 +41      ;;BQI TB RNA DNA QUANT TEST TAX

 +42      ;;BQI TB SPECIFIC AFB TEST TAX

 +43      ;;BGP GPRA ESTIMATED GFR TAX

 +44      ;;BKM CMV TEST TAX

 +45      ;;BKM COCCI ANTIBODY TAX

 +46      ;;BKM FTA-ABS TEST TAX

 +47      ;;BKM GONORRHEA TEST TAX

 +48      ;;BKM HEP A TAX

 +49      ;;BKM HEP B TAX

 +50      ;;BKM HEP C CONFIRMATORY TAX

 +51      ;;BKM HEP C SCREENING TAX

 +52      ;;BKM HEPATITIS PANEL TAX

 +53      ;;BKM PPD TAX

 +54      ;;BKM RPR TAX

 +55      ;;BKM TOXOPLASMOSIS TESTS TAX

 +56      ;;BKMV CD4 ABS TESTS TAX

 +57      ;;BKMV HIV GENOTYPE TESTS TAX

 +58      ;;BKMV HIV PHENOTYPE TESTS TAX

 +59      ;;BTPW HPV DNA SCREEN TAX

 +60      ;;BTPW PREGNANCY TEST TAX

 +61      ;

 +62       QUIT