BGP9XTS ; IHS/CMI/LAB - DISPLAY IND LISTS ;
;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
;; ;
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 09 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^BGP9XTL(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
;;
BGP9XTS ; IHS/CMI/LAB - DISPLAY IND LISTS ;
+1 ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009
+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 09 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^BGP9XTL(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 ;;
