BGPMUDSI ; IHS/MSC/MMT - DISPLAY MEASURE LISTS ;02-Mar-2011 16:50;MGH
;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
;; ;
EP ;EP - CALLED FROM OPTION
D EN
Q
EOJ ;EP
K BGPMUMEA,BGPHIGH,BGPANS,BGPC,BGPGANS,BGPGC,BGPGI,BGPI,BGPX,BGPLSEL
Q
;; ;
EN ;EP -- main entry point
S BGPLSEL="A"
D EN^VALM("BGPMU 11 MEASURE SELECTION")
D CLEAR^VALM1
D FULL^VALM1
W:$D(IOF) @IOF
D EOJ
Q
;
ENH ;EP -- main entry point for Hospital measures
S BGPLSEL="H"
D EN^VALM("BGPMU 11 HOSPITAL MEASURE SEL")
D CLEAR^VALM1
D FULL^VALM1
W:$D(IOF) @IOF
D EOJ
Q
;
ENM ;EP -- main entry point for Menu Set measure selection
S BGPLSEL="M"
D EN^VALM("BGPMU 11 EP MENU MEASURE SEL")
D CLEAR^VALM1
D FULL^VALM1
W:$D(IOF) @IOF
D EOJ
Q
;
HDR ; -- header code
S VALMHDR(1)="IHS Meaningful Use Clinical Quality Measures"
S VALMHDR(2)="* indicates the clinical quality measure has been selected"
Q
;
INIT ; ALL EP Measures -- init variables and list array
N X,Y,X,C
K BGPMUMEA S BGPHIGH=""
S (X,Y,Z,C)=0 F S X=$O(^BGPMUIND(BGPMUYF,"ADO",X)) Q:X'=+X S Y=0 F S Y=$O(^BGPMUIND(BGPMUYF,"ADO",X,Y)) Q:Y'=+Y I $D(^BGPMUIND(BGPMUYF,Y)),$P($G(^BGPMUIND(BGPMUYF,Y,0)),U,4)'="H" D
.S BGPMUDAT=^BGPMUIND(BGPMUYF,Y,0),C=C+1,BGPMUMEA(C,0)=C_")",$E(BGPMUMEA(C,0),5)="("_$P(BGPMUDAT,U,4)_") "_$P(BGPMUDAT,U,3),BGPMUMEA(C,C)=Y I $D(BGPIND(Y)) S BGPMUMEA(C,0)="*"_BGPMUMEA(C,0)
.Q
S (VALMCNT,BGPHIGH)=C
Q
INITM ;EP - Only Menu Set Measures -- init variables and list array
K BGPMUMEA S BGPHIGH=""
N X,Y,Z,C
S (X,Y,Z,C)=0 F S X=$O(^BGPMUIND(BGPMUYF,"ADO",X)) Q:X'=+X S Y=0 F S Y=$O(^BGPMUIND(BGPMUYF,"ADO",X,Y)) Q:Y'=+Y I $D(^BGPMUIND(BGPMUYF,"AMS","M",Y)) D
.S C=C+1,BGPMUMEA(C,0)=C_")",$E(BGPMUMEA(C,0),5)=$P(^BGPMUIND(BGPMUYF,Y,0),U,3),BGPMUMEA(C,C)=Y I $D(BGPIND(Y)) S BGPMUMEA(C,0)="*"_BGPMUMEA(C,0)
.Q
S (VALMCNT,BGPHIGH)=C
Q
INITH ;EP - ALL Hospital Measures -- init variables and list array
K BGPMUMEA S BGPHIGH=""
N X,Y,Z,C
S (X,Y,Z,C)=0 F S X=$O(^BGPMUIND(BGPMUYF,"ADO",X)) Q:X'=+X S Y=0 F S Y=$O(^BGPMUIND(BGPMUYF,"ADO",X,Y)) Q:Y'=+Y I $D(^BGPMUIND(BGPMUYF,Y)),$P($G(^BGPMUIND(BGPMUYF,Y,0)),U,4)="H" D
.S C=C+1,BGPMUMEA(C,0)=C_")",$E(BGPMUMEA(C,0),5)=$P(^BGPMUIND(BGPMUYF,Y,0),U,3),BGPMUMEA(C,C)=Y I $D(BGPIND(Y)) S BGPMUMEA(C,0)="*"_BGPMUMEA(C,0)
.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"
I BGPLSEL="A" D INIT
I BGPLSEL="M" D INITM
I BGPLSEL="H" D INITH
D HDR
K DIR
K X,Y,Z,I
Q
;
ADD ;EP - add an item to the selected list - called from a protocol
W !
S DIR(0)="LO^1:"_BGPHIGH,DIR("A")="Which item(s)"
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(BGPMUMEA(BGPC,BGPC))=""
ADDX ;
D BACK
Q
ADDALL ;
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(BGPMUMEA(BGPC,BGPC))
REMX ;
D BACK
Q
BGPMUDSI ; IHS/MSC/MMT - DISPLAY MEASURE LISTS ;02-Mar-2011 16:50;MGH
+1 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
+2 ;; ;
EP ;EP - CALLED FROM OPTION
+1 DO EN
+2 QUIT
EOJ ;EP
+1 KILL BGPMUMEA,BGPHIGH,BGPANS,BGPC,BGPGANS,BGPGC,BGPGI,BGPI,BGPX,BGPLSEL
+2 QUIT
+3 ;; ;
EN ;EP -- main entry point
+1 SET BGPLSEL="A"
+2 DO EN^VALM("BGPMU 11 MEASURE SELECTION")
+3 DO CLEAR^VALM1
+4 DO FULL^VALM1
+5 IF $DATA(IOF)
WRITE @IOF
+6 DO EOJ
+7 QUIT
+8 ;
ENH ;EP -- main entry point for Hospital measures
+1 SET BGPLSEL="H"
+2 DO EN^VALM("BGPMU 11 HOSPITAL MEASURE SEL")
+3 DO CLEAR^VALM1
+4 DO FULL^VALM1
+5 IF $DATA(IOF)
WRITE @IOF
+6 DO EOJ
+7 QUIT
+8 ;
ENM ;EP -- main entry point for Menu Set measure selection
+1 SET BGPLSEL="M"
+2 DO EN^VALM("BGPMU 11 EP MENU MEASURE SEL")
+3 DO CLEAR^VALM1
+4 DO FULL^VALM1
+5 IF $DATA(IOF)
WRITE @IOF
+6 DO EOJ
+7 QUIT
+8 ;
HDR ; -- header code
+1 SET VALMHDR(1)="IHS Meaningful Use Clinical Quality Measures"
+2 SET VALMHDR(2)="* indicates the clinical quality measure has been selected"
+3 QUIT
+4 ;
INIT ; ALL EP Measures -- init variables and list array
+1 NEW X,Y,X,C
+2 KILL BGPMUMEA
SET BGPHIGH=""
+3 SET (X,Y,Z,C)=0
FOR
SET X=$ORDER(^BGPMUIND(BGPMUYF,"ADO",X))
IF X'=+X
QUIT
SET Y=0
FOR
SET Y=$ORDER(^BGPMUIND(BGPMUYF,"ADO",X,Y))
IF Y'=+Y
QUIT
IF $DATA(^BGPMUIND(BGPMUYF,Y))
IF $PIECE($GET(^BGPMUIND(BGPMUYF,Y,0)),U,4)'="H"
Begin DoDot:1
+4 SET BGPMUDAT=^BGPMUIND(BGPMUYF,Y,0)
SET C=C+1
SET BGPMUMEA(C,0)=C_")"
SET $EXTRACT(BGPMUMEA(C,0),5)="("_$PIECE(BGPMUDAT,U,4)_") "_$PIECE(BGPMUDAT,U,3)
SET BGPMUMEA(C,C)=Y
IF $DATA(BGPIND(Y))
SET BGPMUMEA(C,0)="*"_BGPMUMEA(C,0)
+5 QUIT
End DoDot:1
+6 SET (VALMCNT,BGPHIGH)=C
+7 QUIT
INITM ;EP - Only Menu Set Measures -- init variables and list array
+1 KILL BGPMUMEA
SET BGPHIGH=""
+2 NEW X,Y,Z,C
+3 SET (X,Y,Z,C)=0
FOR
SET X=$ORDER(^BGPMUIND(BGPMUYF,"ADO",X))
IF X'=+X
QUIT
SET Y=0
FOR
SET Y=$ORDER(^BGPMUIND(BGPMUYF,"ADO",X,Y))
IF Y'=+Y
QUIT
IF $DATA(^BGPMUIND(BGPMUYF,"AMS","M",Y))
Begin DoDot:1
+4 SET C=C+1
SET BGPMUMEA(C,0)=C_")"
SET $EXTRACT(BGPMUMEA(C,0),5)=$PIECE(^BGPMUIND(BGPMUYF,Y,0),U,3)
SET BGPMUMEA(C,C)=Y
IF $DATA(BGPIND(Y))
SET BGPMUMEA(C,0)="*"_BGPMUMEA(C,0)
+5 QUIT
End DoDot:1
+6 SET (VALMCNT,BGPHIGH)=C
+7 QUIT
INITH ;EP - ALL Hospital Measures -- init variables and list array
+1 KILL BGPMUMEA
SET BGPHIGH=""
+2 NEW X,Y,Z,C
+3 SET (X,Y,Z,C)=0
FOR
SET X=$ORDER(^BGPMUIND(BGPMUYF,"ADO",X))
IF X'=+X
QUIT
SET Y=0
FOR
SET Y=$ORDER(^BGPMUIND(BGPMUYF,"ADO",X,Y))
IF Y'=+Y
QUIT
IF $DATA(^BGPMUIND(BGPMUYF,Y))
IF $PIECE($GET(^BGPMUIND(BGPMUYF,Y,0)),U,4)="H"
Begin DoDot:1
+4 SET C=C+1
SET BGPMUMEA(C,0)=C_")"
SET $EXTRACT(BGPMUMEA(C,0),5)=$PIECE(^BGPMUIND(BGPMUYF,Y,0),U,3)
SET BGPMUMEA(C,C)=Y
IF $DATA(BGPIND(Y))
SET BGPMUMEA(C,0)="*"_BGPMUMEA(C,0)
+5 QUIT
End DoDot:1
+6 SET (VALMCNT,BGPHIGH)=C
+7 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 IF BGPLSEL="A"
DO INIT
+4 IF BGPLSEL="M"
DO INITM
+5 IF BGPLSEL="H"
DO INITH
+6 DO HDR
+7 KILL DIR
+8 KILL X,Y,Z,I
+9 QUIT
+10 ;
ADD ;EP - add an item to the selected list - called from a protocol
+1 WRITE !
+2 SET DIR(0)="LO^1:"_BGPHIGH
SET DIR("A")="Which item(s)"
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(BGPMUMEA(BGPC,BGPC))=""
ADDX ;
+1 DO BACK
+2 QUIT
ADDALL ;
+1 FOR X=1:1:BGPHIGH
SET BGPIND(X)=""
+2 DO BACK
+3 QUIT
+4 ;
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(BGPMUMEA(BGPC,BGPC))
REMX ;
+1 DO BACK
+2 QUIT
