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