BGP8XTS.m

BGP8XTS ; IHS/CMI/LAB - DISPLAY IND LISTS ;

 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66

 ;; ;

EP ;EP - CALLED FROM OPTION

 D EN

 Q

EOJ ;EP

 D EN^XBVK("BGP")

 Q

 ;; ;

EN ;EP -- main entry point for 

 D EN^VALM("BGP 18 TAXONOMY UPDATE")

 D CLEAR^VALM1

 D FULL^VALM1

 W:$D(IOF) @IOF

 D EOJ

 Q

 ;

HDR ; -- header code

 S VALMHDR(1)="TAXONOMIES TO SUPPORT CRS REPORTING"

 S VALMHDR(2)="* Update Taxonomies"

 Q

 ;

INIT ; -- init variables and list array

 K BGPTAX S BGPHIGH="",C=0

 S T="LAB" F J=1:1 S Z=$T(@T+J),BGPX=$P(Z,";;",2),Y=$P(Z,";;",3) Q:BGPX=""  D

 .S BGPTAX(J,0)=J_")  "_BGPX,$E(BGPTAX(J,0),40)=Y

 .S I=$O(^ATXLAB("B",BGPX,0))

 .S BGPTAX("IDX",J,J)=I

 .S C=C+1

 .Q

 S (VALMCNT,BGPHIGH)=C

 Q

 ;

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 Q

 ;

EXPND ; -- expand code

 Q

 ;

BACK ;go back to listman

 D TERM^VALM0

 S VALMBCK="R"

 D INIT

 D HDR

 K DIR

 K X,Y,Z,I

 Q

 ;

ADD ;EP - add an item to the selected list - called from a protocol

 D FULL^VALM1

 W !

 I '$D(^XUSEC("BGPZ TAXONOMY EDIT",DUZ)) W !!,"You do not have the security access to edit taxonomies.",!,"Please see your supervisor or program manager if you feel you should have",!,"the BGPZ TAXONOMY EDIT security key.",! D  Q

 .K DIR S DIR(0)="E",DIR("A")="Press enter to continue" D ^DIR K DIR

 S DIR(0)="NO^1:"_BGPHIGH,DIR("A")="Which Taxonomy"

 D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" W !,"No taxonomy selected." G ADDX

 I $D(DIRUT) W !,"No taxonomy selected." G ADDX

 D FULL^VALM1 W:$D(IOF) @IOF

 S BGPTAXI=BGPTAX("IDX",Y,Y)

 D EP^BGP8XTL(BGPTAXI)

ADDX ;

 D BACK

 Q

DISP ;EP - add an item to the selected list - called from a protocol

 W !

 S DIR(0)="NO^1:"_BGPHIGH,DIR("A")="Which Taxonomy"

 D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" W !,"No taxonomy selected." G ADDX

 I $D(DIRUT) W !,"No taxonomy selected." G ADDX

 D FULL^VALM1 W:$D(IOF) @IOF

 S BGPTAXI=BGPTAX("IDX",Y,Y)

 W !!!,$P(^ATXLAB(BGPTAXI,0),U)

 W !!,"Tests currently defined in this taxonomy:"

 S X=0 F  S X=$O(^ATXLAB(BGPTAXI,21,"B",X)) Q:X'=+X  D

 .S Y=$P($G(^LAB(60,X,0)),U) W !?5,Y

 W !!

 K DIR S DIR(0)="E",DIR("A")="Press enter to continue" D ^DIR K DIR

DISPX ;

 D BACK

 Q

LAB ;

 ;;DM AUDIT CREATININE TAX;;CREATININE Lab tests

 ;;DM AUDIT HGB A1C TAX;;HGB A1C Lab Tests

 ;;DM AUDIT LIPID PROFILE TAX;;Lipid Profile Lab Tests

 ;;DM AUDIT LDL CHOLESTEROL TAX;;LDL Cholesterol Lab Tests

 ;;DM AUDIT TRIGLYCERIDE TAX;;Triglyceride Lab Tests

 ;;DM AUDIT HDL TAX;;HDL Lab Tests

 ;;DM AUDIT URINE PROTEIN TAX;;Urine Protein Lab Tests

 ;;DM AUDIT MICROALBUMINURIA TAX;;Microalbuminuia Lab Tests

 ;;DM AUDIT CHOLESTEROL TAX;;Cholesterol Tests

 ;;BGP GPRA ESTIMATED GFR TAX;;Estimated GFR Tests

 ;;BGP PAP SMEAR TAX;;Pap Smear tests

 ;;BGP GPRA FOB TESTS;;Fecal Occult Blood Tests

 ;;BGP HIV TEST TAX;;HIV lab tests

 ;;BGP CD4 TAX

 ;;BGP HIV VIRAL LOAD TAX

 ;;BGP CHLAMYDIA TESTS TAX;;Chlamydia lab taxonomy

 ;;

BGP8XTS   ; IHS/CMI/LAB - DISPLAY IND LISTS ;

 +1       ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66

 +2       ;; ;

EP        ;EP - CALLED FROM OPTION

 +1        DO EN

 +2        QUIT 

EOJ       ;EP

 +1        DO EN^XBVK("BGP")

 +2        QUIT 

 +3       ;; ;

EN        ;EP -- main entry point for 

 +1        DO EN^VALM("BGP 18 TAXONOMY UPDATE")

 +2        DO CLEAR^VALM1

 +3        DO FULL^VALM1

 +4        IF $DATA(IOF)

               WRITE @IOF

 +5        DO EOJ

 +6        QUIT 

 +7       ;

HDR       ; -- header code

 +1        SET VALMHDR(1)="TAXONOMIES TO SUPPORT CRS REPORTING"

 +2        SET VALMHDR(2)="* Update Taxonomies"

 +3        QUIT 

 +4       ;

INIT      ; -- init variables and list array

 +1        KILL BGPTAX

           SET BGPHIGH=""

           SET C=0

 +2        SET T="LAB"

           FOR J=1:1

               SET Z=$TEXT(@T+J)

               SET BGPX=$PIECE(Z,";;",2)

               SET Y=$PIECE(Z,";;",3)

               IF BGPX=""

                   QUIT 

               Begin DoDot:1

 +3                SET BGPTAX(J,0)=J_")  "_BGPX

                   SET $EXTRACT(BGPTAX(J,0),40)=Y

 +4                SET I=$ORDER(^ATXLAB("B",BGPX,0))

 +5                SET BGPTAX("IDX",J,J)=I

 +6                SET C=C+1

 +7                QUIT 

               End DoDot:1

 +8        SET (VALMCNT,BGPHIGH)=C

 +9        QUIT 

 +10      ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        QUIT 

 +2       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

BACK      ;go back to listman

 +1        DO TERM^VALM0

 +2        SET VALMBCK="R"

 +3        DO INIT

 +4        DO HDR

 +5        KILL DIR

 +6        KILL X,Y,Z,I

 +7        QUIT 

 +8       ;

ADD       ;EP - add an item to the selected list - called from a protocol

 +1        DO FULL^VALM1

 +2        WRITE !

 +3        IF '$DATA(^XUSEC("BGPZ TAXONOMY EDIT",DUZ))

               WRITE !!,"You do not have the security access to edit taxonomies.",!,"Please see your supervisor or program manager if you feel you should have",!,"the BGPZ TAXONOMY EDIT security key.",!

               Begin DoDot:1

 +4                KILL DIR

                   SET DIR(0)="E"

                   SET DIR("A")="Press enter to continue"

                   DO ^DIR

                   KILL DIR

               End DoDot:1

               QUIT 

 +5        SET DIR(0)="NO^1:"_BGPHIGH

           SET DIR("A")="Which Taxonomy"

 +6        DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +7        IF Y=""

               WRITE !,"No taxonomy selected."

               GOTO ADDX

 +8        IF $DATA(DIRUT)

               WRITE !,"No taxonomy selected."

               GOTO ADDX

 +9        DO FULL^VALM1

           IF $DATA(IOF)

               WRITE @IOF

 +10       SET BGPTAXI=BGPTAX("IDX",Y,Y)

 +11       DO EP^BGP8XTL(BGPTAXI)

ADDX      ;

 +1        DO BACK

 +2        QUIT 

DISP      ;EP - add an item to the selected list - called from a protocol

 +1        WRITE !

 +2        SET DIR(0)="NO^1:"_BGPHIGH

           SET DIR("A")="Which Taxonomy"

 +3        DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF Y=""

               WRITE !,"No taxonomy selected."

               GOTO ADDX

 +5        IF $DATA(DIRUT)

               WRITE !,"No taxonomy selected."

               GOTO ADDX

 +6        DO FULL^VALM1

           IF $DATA(IOF)

               WRITE @IOF

 +7        SET BGPTAXI=BGPTAX("IDX",Y,Y)

 +8        WRITE !!!,$PIECE(^ATXLAB(BGPTAXI,0),U)

 +9        WRITE !!,"Tests currently defined in this taxonomy:"

 +10       SET X=0

           FOR 

               SET X=$ORDER(^ATXLAB(BGPTAXI,21,"B",X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +11               SET Y=$PIECE($GET(^LAB(60,X,0)),U)

                   WRITE !?5,Y

               End DoDot:1

 +12       WRITE !!

 +13       KILL DIR

           SET DIR(0)="E"

           SET DIR("A")="Press enter to continue"

           DO ^DIR

           KILL DIR

DISPX     ;

 +1        DO BACK

 +2        QUIT 

LAB       ;

 +1       ;;DM AUDIT CREATININE TAX;;CREATININE Lab tests

 +2       ;;DM AUDIT HGB A1C TAX;;HGB A1C Lab Tests

 +3       ;;DM AUDIT LIPID PROFILE TAX;;Lipid Profile Lab Tests

 +4       ;;DM AUDIT LDL CHOLESTEROL TAX;;LDL Cholesterol Lab Tests

 +5       ;;DM AUDIT TRIGLYCERIDE TAX;;Triglyceride Lab Tests

 +6       ;;DM AUDIT HDL TAX;;HDL Lab Tests

 +7       ;;DM AUDIT URINE PROTEIN TAX;;Urine Protein Lab Tests

 +8       ;;DM AUDIT MICROALBUMINURIA TAX;;Microalbuminuia Lab Tests

 +9       ;;DM AUDIT CHOLESTEROL TAX;;Cholesterol Tests

 +10      ;;BGP GPRA ESTIMATED GFR TAX;;Estimated GFR Tests

 +11      ;;BGP PAP SMEAR TAX;;Pap Smear tests

 +12      ;;BGP GPRA FOB TESTS;;Fecal Occult Blood Tests

 +13      ;;BGP HIV TEST TAX;;HIV lab tests

 +14      ;;BGP CD4 TAX

 +15      ;;BGP HIV VIRAL LOAD TAX

 +16      ;;BGP CHLAMYDIA TESTS TAX;;Chlamydia lab taxonomy

 +17      ;;