BGP3DSI ; IHS/CMI/LAB - DISPLAY IND LISTS ;
;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
;; ;
EP ;EP - CALLED FROM OPTION
D EN
Q
EOJ ;EP
K BGPTIND,BGPHIGH,BGPANS,BGPC,BGPGANS,BGPGC,BGPGI,BGPI,BGPX
Q
;; ;
EN ;EP -- main entry point for APCH HMR DISPLAY
D EN^VALM("BGP 13 INDICATOR SELECTION")
D CLEAR^VALM1
D FULL^VALM1
W:$D(IOF) @IOF
D EOJ
Q
;
HDR ; -- header code
I BGPRTYPE'=1 S VALMHDR(1)="IHS Clinical Performance Measures"
I BGPRTYPE=1 S VALMHDR(1)="IHS GPRA/GPRAMA Clinical Performance Measures (incl developmental measures)"
S VALMHDR(2)="* indicates the performance measure has been selected"
Q
;
INIT ; -- init variables and list array
;I BGPRTYPE=1,$G(BGPNPL) G INITPL
K BGPTIND S BGPHIGH=""
S (X,Y,Z,C)=0 F S X=$O(^BGPINDH("AOI",X)) Q:X'=+X S Y=0 F S Y=$O(^BGPINDH("AOI",X,Y)) Q:Y'=+Y D
.I $G(BGPRTYPE)=1,$P(^BGPINDH(Y,0),U,7)'=1 Q
.I $G(BGPRTYPE)=7,$P($G(^BGPINDH(Y,12)),U,1)'=1 Q
.I $G(BGPRTYPE)=4,$P($G(^BGPINDH(Y,13)),U,1)=1 Q
.I $G(BGPNPL),'$D(^BGPNPLH("AR",Y,$S(BGPRTYPE=1:"N",1:"O"))) Q
.S C=C+1,BGPTIND(C,0)=C_")",$E(BGPTIND(C,0),5)=$P(^BGPINDH(Y,0),U,3),BGPTIND(C,C)=Y I $D(BGPIND(Y)) S BGPTIND(C,0)="*"_BGPTIND(C,0)
.Q
S (VALMCNT,BGPHIGH)=C
Q
INITPL ;
;K BGPTIND S BGPHIGH=""
;get dev measures first and put (GPRA Dev.) on end
;S (X,Y,Z,C)=0 F S X=$O(^BGPINDH("ADEVO",X)) Q:X'=+X S Y=0 F S Y=$O(^BGPINDH("ADEVO",X,Y)) Q:Y'=+Y D
;.I $D(^BGPNPLH("AR",Y,"N")) Q
;.S C=C+1,BGPTIND(C,0)=C_")",$E(BGPTIND(C,0),5)=$P(^BGPINDH(Y,0),U,3)_" (GPRA Dev.)",BGPTIND(C,C)=Y I $D(BGPIND(Y)) S BGP
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
NEW BGPMCNT
S BGPMCNT=0
W !
I $G(BGPYNPLT)=1 S DIR(0)="NO^1:"_BGPHIGH,DIR("A")="Select Only One Measure" G ADD1
I $G(BGPRTYPE)'=1 S DIR(0)="LO^1:"_BGPHIGH,DIR("A")="Which item(s)"
I $G(BGPRTYPE)=1 S DIR(0)="LO^1:"_BGPHIGH,DIR("A")="Which Measure Topic"
ADD1 ;
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No items selected." G ADDX
I $D(DIRUT) W !,"No items selected." G ADDX
D FULL^VALM1 W:$D(IOF) @IOF
S BGPANS=Y,BGPC="" F BGPI=1:1 S BGPC=$P(BGPANS,",",BGPI) Q:BGPC="" S BGPIND(BGPTIND(BGPC,BGPC))=""
I BGPYRPTH="A" D I BGPMCNT>15 W !!,"You can only select up to 15 Topics, please choose command 'S' again",!,"and reselect your topics." K BGPIND D PAUSE^BGP3DU
.S X=0 F S X=$O(BGPIND(X)) Q:X'=+X S BGPMCNT=BGPMCNT+1
ADDX ;
D BACK
Q
ADDALL ;
I $G(BGPYRPTH)="A" W !!,"Sorry, this option isn't available when running for ALL Communities." D PAUSE^BGP3DU,BACK Q
F X=1:1:BGPHIGH S BGPIND(X)=""
D BACK
Q
;
REM ;
W ! S DIR(0)="LO^1:"_BGPHIGH,DIR("A")="Which item(s)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No items selected." G ADDX
I $D(DIRUT) W !,"No items selected." G ADDX
D FULL^VALM1 W:$D(IOF) @IOF
S BGPANS=Y,BGPC="" F BGPI=1:1 S BGPC=$P(BGPANS,",",BGPI) Q:BGPC="" K BGPIND(BGPTIND(BGPC,BGPC))
REMX ;
D BACK
Q
BGP3DSI ; IHS/CMI/LAB - DISPLAY IND LISTS ;
+1 ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
+2 ;; ;
EP ;EP - CALLED FROM OPTION
+1 DO EN
+2 QUIT
EOJ ;EP
+1 KILL BGPTIND,BGPHIGH,BGPANS,BGPC,BGPGANS,BGPGC,BGPGI,BGPI,BGPX
+2 QUIT
+3 ;; ;
EN ;EP -- main entry point for APCH HMR DISPLAY
+1 DO EN^VALM("BGP 13 INDICATOR SELECTION")
+2 DO CLEAR^VALM1
+3 DO FULL^VALM1
+4 IF $DATA(IOF)
WRITE @IOF
+5 DO EOJ
+6 QUIT
+7 ;
HDR ; -- header code
+1 IF BGPRTYPE'=1
SET VALMHDR(1)="IHS Clinical Performance Measures"
+2 IF BGPRTYPE=1
SET VALMHDR(1)="IHS GPRA/GPRAMA Clinical Performance Measures (incl developmental measures)"
+3 SET VALMHDR(2)="* indicates the performance measure has been selected"
+4 QUIT
+5 ;
INIT ; -- init variables and list array
+1 ;I BGPRTYPE=1,$G(BGPNPL) G INITPL
+2 KILL BGPTIND
SET BGPHIGH=""
+3 SET (X,Y,Z,C)=0
FOR
SET X=$ORDER(^BGPINDH("AOI",X))
IF X'=+X
QUIT
SET Y=0
FOR
SET Y=$ORDER(^BGPINDH("AOI",X,Y))
IF Y'=+Y
QUIT
Begin DoDot:1
+4 IF $GET(BGPRTYPE)=1
IF $PIECE(^BGPINDH(Y,0),U,7)'=1
QUIT
+5 IF $GET(BGPRTYPE)=7
IF $PIECE($GET(^BGPINDH(Y,12)),U,1)'=1
QUIT
+6 IF $GET(BGPRTYPE)=4
IF $PIECE($GET(^BGPINDH(Y,13)),U,1)=1
QUIT
+7 IF $GET(BGPNPL)
IF '$DATA(^BGPNPLH("AR",Y,$SELECT(BGPRTYPE=1:"N",1:"O")))
QUIT
+8 SET C=C+1
SET BGPTIND(C,0)=C_")"
SET $EXTRACT(BGPTIND(C,0),5)=$PIECE(^BGPINDH(Y,0),U,3)
SET BGPTIND(C,C)=Y
IF $DATA(BGPIND(Y))
SET BGPTIND(C,0)="*"_BGPTIND(C,0)
+9 QUIT
End DoDot:1
+10 SET (VALMCNT,BGPHIGH)=C
+11 QUIT
INITPL ;
+1 ;K BGPTIND S BGPHIGH=""
+2 ;get dev measures first and put (GPRA Dev.) on end
+3 ;S (X,Y,Z,C)=0 F S X=$O(^BGPINDH("ADEVO",X)) Q:X'=+X S Y=0 F S Y=$O(^BGPINDH("ADEVO",X,Y)) Q:Y'=+Y D
+4 ;.I $D(^BGPNPLH("AR",Y,"N")) Q
+5 ;.S C=C+1,BGPTIND(C,0)=C_")",$E(BGPTIND(C,0),5)=$P(^BGPINDH(Y,0),U,3)_" (GPRA Dev.)",BGPTIND(C,C)=Y I $D(BGPIND(Y)) S BGP
+6 QUIT
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 NEW BGPMCNT
+2 SET BGPMCNT=0
+3 WRITE !
+4 IF $GET(BGPYNPLT)=1
SET DIR(0)="NO^1:"_BGPHIGH
SET DIR("A")="Select Only One Measure"
GOTO ADD1
+5 IF $GET(BGPRTYPE)'=1
SET DIR(0)="LO^1:"_BGPHIGH
SET DIR("A")="Which item(s)"
+6 IF $GET(BGPRTYPE)=1
SET DIR(0)="LO^1:"_BGPHIGH
SET DIR("A")="Which Measure Topic"
ADD1 ;
+1 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF Y=""
WRITE !,"No items selected."
GOTO ADDX
+3 IF $DATA(DIRUT)
WRITE !,"No items selected."
GOTO ADDX
+4 DO FULL^VALM1
IF $DATA(IOF)
WRITE @IOF
+5 SET BGPANS=Y
SET BGPC=""
FOR BGPI=1:1
SET BGPC=$PIECE(BGPANS,",",BGPI)
IF BGPC=""
QUIT
SET BGPIND(BGPTIND(BGPC,BGPC))=""
+6 IF BGPYRPTH="A"
Begin DoDot:1
+7 SET X=0
FOR
SET X=$ORDER(BGPIND(X))
IF X'=+X
QUIT
SET BGPMCNT=BGPMCNT+1
End DoDot:1
IF BGPMCNT>15
WRITE !!,"You can only select up to 15 Topics, please choose command 'S' again",!,"and reselect your topics."
KILL BGPIND
DO PAUSE^BGP3DU
ADDX ;
+1 DO BACK
+2 QUIT
ADDALL ;
+1 IF $GET(BGPYRPTH)="A"
WRITE !!,"Sorry, this option isn't available when running for ALL Communities."
DO PAUSE^BGP3DU
DO BACK
QUIT
+2 FOR X=1:1:BGPHIGH
SET BGPIND(X)=""
+3 DO BACK
+4 QUIT
+5 ;
REM ;
+1 WRITE !
SET DIR(0)="LO^1:"_BGPHIGH
SET DIR("A")="Which item(s)"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF Y=""
WRITE !,"No items selected."
GOTO ADDX
+3 IF $DATA(DIRUT)
WRITE !,"No items selected."
GOTO ADDX
+4 DO FULL^VALM1
IF $DATA(IOF)
WRITE @IOF
+5 SET BGPANS=Y
SET BGPC=""
FOR BGPI=1:1
SET BGPC=$PIECE(BGPANS,",",BGPI)
IF BGPC=""
QUIT
KILL BGPIND(BGPTIND(BGPC,BGPC))
REMX ;
+1 DO BACK
+2 QUIT
