Routine: BGP4DESL

BGP4DESL ; IHS/CMI/LAB - FY 11 DISPLAY IND LISTS ;

 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114

 ;; ;

RT ;EP

 ;for each measure list, choose report type

 W !!,"Select List Type.",!,"NOTE:  If you select All Patients, your list may be",!,"hundreds of pages and take hours to print.",!

 S DIR(0)="S^R:Random Patient List;P:Patient List by Provider;A:All Patients",DIR("A")="Choose report type for the Lists",DIR("B")="R" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) S BGPQUIT="" K BGPLIST Q

 S BGPLIST=Y

 I BGPLIST="A" Q

 I BGPLIST="P" D  G:BGPLPROV="" RT Q

 .S BGPLPROV="",BGPLPRV=""

 .S DIR(0)="9000001,.14",DIR("A")="Enter Designated Provider Name" KILL DA D ^DIR KILL DIR

 .I $D(DIRUT) Q

 .I Y="" Q

 .S BGPLPRV=+Y,BGPLPROV=Y(0,0)

EP ;EP - CALLED FROM OPTION

 D EN

EOJ1 ;EP

 K BGPGLIST,BGPTIND,BGPHIGH,BGPANS,BGPC,BGPGANS,BGPGC,BGPGI,BGPI,BGPX

 ;; ;

EN ;EP -- main entry point for GPRA LIST DISPLAY

 D EN^VALM("BGP 14 ELDER LIST SELECTION")

 D CLEAR^VALM1

 D FULL^VALM1

 W:$D(IOF) @IOF

 D EOJ1

HDR ; -- header code

 S VALMHDR(1)="IHS FY 11 ELDER Performance Measure Lists of Patients"

 S VALMHDR(2)="* indicates the list has been selected"

INIT ; -- init variables and list array

 K BGPGLIST,BGPNOLI S BGPHIGH=""

 S (X,C,I)=0 F  S X=$O(BGPIND(X)) Q:X'=+X  D

 .I $P(^BGPELIJ(X,0),U,5)]"" S C=C+1 D  Q

 ..S BGPGLIST(C,0)=C_")",$E(BGPGLIST(C,0),5)=$P(^BGPELIJ(X,0),U,5),BGPGLIST("IDX",C,C)=X I $D(BGPLIST(X)) S BGPGLIST(C,0)="*"_BGPGLIST(C,0)

 .I $P(^BGPELIJ(X,0),U,5)="" S C=C+1 D

 ..S BGPGLIST(C,0)="NO patient list available for measure:  "_$P(^BGPELIJ(X,0),U,4),BGPGLIST("IDX",C,C)=X,BGPNOLI(X)="" I $D(BGPLIST(X)) S BGPGLIST(C,0)="*"_BGPGLIST(C,0)

 S (VALMCNT,BGPHIGH)=C

HELP ; -- help code

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

EXIT ; -- exit code

EXPND ; -- expand code

BACK ;go back to listman

 D TERM^VALM0

 S VALMBCK="R"

 D INIT

 D HDR

 K DIR

 K X,Y,Z,I

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)" 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 BGPGANS=Y,BGPGC="" F BGPGI=1:1 S BGPGC=$P(BGPGANS,",",BGPGI) Q:BGPGC=""  S BGPI=BGPGLIST("IDX",BGPGC,BGPGC) I $D(BGPIND(BGPI)),'$D(BGPNOLI(BGPI)) S BGPLIST(BGPI)=""

ADDX ;

 D BACK

ADDALL ;

 F X=1:1:BGPHIGH S I=$G(BGPGLIST("IDX",X,X)) I $D(BGPIND(I)),'$D(BGPNOLI(I)) S BGPLIST(I)=""

 D BACK

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 BGPGANS=Y,BGPGC="" F BGPGI=1:1 S BGPGC=$P(BGPGANS,",",BGPGI) Q:BGPGC=""  S I=BGPGLIST("IDX",BGPGC,BGPGC) K BGPLIST(I)

REMX ;

 D BACK

PT ;EP

 S (BGPROT,BGPDELT,BGPDELF)=""

 W !!,"Please choose an output type.  For an explanation of the delimited",!,"file please see the user manual.",!

 S DIR(0)="S^P:Print Report on Printer or Screen;D:Create Delimited output file (for use in Excel);B:Both a Printed Report and Delimited File",DIR("A")="Select an Output Option",DIR("B")="P" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) Q

 S BGPROT=Y

 Q:BGPROT="P"

 S BGPDELF="",BGPDELT=""

 W !!,"You have selected to create a delimited output file.  You can have this",!,"output file created as a text file in the pub directory, ",!,"OR you can have the delimited output display on your screen so that"

 W !,"you can do a file capture.  Keep in mind that if you choose to",!,"do a screen capture you CANNOT Queue your report to run in the background!!",!!

 S DIR(0)="S^S:SCREEN - delimited output will display on screen for capture;F:FILE - delimited output will be written to a file in pub",DIR("A")="Select output type",DIR("B")="S" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G PT

 S BGPDELT=Y

 Q:BGPDELT="S"

 S DIR(0)="F^1:40",DIR("A")="Enter a filename for the delimited output (no more than 40 characters)" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G PT

 S BGPDELF=Y

 W !!,"When the report is finished your delimited output will be found in the",!,$P($G(^AUTTSITE(1,1)),U,2)," directory.  The filename will be ",BGPDELF,".txt",!

BGP4DESL  ; IHS/CMI/LAB - FY 11 DISPLAY IND LISTS ;

 +1       ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114

 +2       ;; ;

RT        ;EP

 +1       ;for each measure list, choose report type

 +2        WRITE !!,"Select List Type.",!,"NOTE:  If you select All Patients, your list may be",!,"hundreds of pages and take hours to print.",!

 +3        SET DIR(0)="S^R:Random Patient List;P:Patient List by Provider;A:All Patients"

           SET DIR("A")="Choose report type for the Lists"

           SET DIR("B")="R"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               SET BGPQUIT=""

               KILL BGPLIST

               QUIT

 +5        SET BGPLIST=Y

 +6        IF BGPLIST="A"

               QUIT

 +7        IF BGPLIST="P"

               Begin DoDot:1

 +8                SET BGPLPROV=""

                   SET BGPLPRV=""

 +9                SET DIR(0)="9000001,.14"

                   SET DIR("A")="Enter Designated Provider Name"

                   KILL DA

                   DO ^DIR

                   KILL DIR

 +10               IF $DATA(DIRUT)

                       QUIT

 +11               IF Y=""

                       QUIT

 +12               SET BGPLPRV=+Y

                   SET BGPLPROV=Y(0,0)

               End DoDot:1

               IF BGPLPROV=""

                   GOTO RT

               QUIT

 +13       QUIT

EP        ;EP - CALLED FROM OPTION

 +1        DO EN

 +2        QUIT

EOJ1      ;EP

 +1        KILL BGPGLIST,BGPTIND,BGPHIGH,BGPANS,BGPC,BGPGANS,BGPGC,BGPGI,BGPI,BGPX

 +2        QUIT

 +3       ;; ;

EN        ;EP -- main entry point for GPRA LIST DISPLAY

 +1        DO EN^VALM("BGP 14 ELDER LIST SELECTION")

 +2        DO CLEAR^VALM1

 +3        DO FULL^VALM1

 +4        IF $DATA(IOF)

               WRITE @IOF

 +5        DO EOJ1

 +6        QUIT

 +7       ;

HDR       ; -- header code

 +1        SET VALMHDR(1)="IHS FY 11 ELDER Performance Measure Lists of Patients"

 +2        SET VALMHDR(2)="* indicates the list has been selected"

 +3        QUIT

 +4       ;

INIT      ; -- init variables and list array

 +1        KILL BGPGLIST,BGPNOLI

           SET BGPHIGH=""

 +2        SET (X,C,I)=0

FOR

               SET X=$ORDER(BGPIND(X))

               IF X'=+X

                   QUIT

               Begin DoDot:1

 +3                IF $PIECE(^BGPELIJ(X,0),U,5)]""

                       SET C=C+1

                       Begin DoDot:2

 +4                        SET BGPGLIST(C,0)=C_")"

                           SET $EXTRACT(BGPGLIST(C,0),5)=$PIECE(^BGPELIJ(X,0),U,5)

                           SET BGPGLIST("IDX",C,C)=X

                           IF $DATA(BGPLIST(X))

                               SET BGPGLIST(C,0)="*"_BGPGLIST(C,0)

                       End DoDot:2

                       QUIT

 +5                IF $PIECE(^BGPELIJ(X,0),U,5)=""

                       SET C=C+1

                       Begin DoDot:2

 +6                        SET BGPGLIST(C,0)="NO patient list available for measure:  "_$PIECE(^BGPELIJ(X,0),U,4)

                           SET BGPGLIST("IDX",C,C)=X

                           SET BGPNOLI(X)=""

                           IF $DATA(BGPLIST(X))

                               SET BGPGLIST(C,0)="*"_BGPGLIST(C,0)

                       End DoDot:2

               End DoDot:1

 +7        SET (VALMCNT,BGPHIGH)=C

 +8        QUIT

 +9       ;

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        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 BGPGANS=Y

           SET BGPGC=""

           FOR BGPGI=1:1

               SET BGPGC=$PIECE(BGPGANS,",",BGPGI)

               IF BGPGC=""

                   QUIT

               SET BGPI=BGPGLIST("IDX",BGPGC,BGPGC)

               IF $DATA(BGPIND(BGPI))

                   IF '$DATA(BGPNOLI(BGPI))

                       SET BGPLIST(BGPI)=""

ADDX      ;

 +1        DO BACK

 +2        QUIT

ADDALL    ;

 +1        FOR X=1:1:BGPHIGH

               SET I=$GET(BGPGLIST("IDX",X,X))

               IF $DATA(BGPIND(I))

                   IF '$DATA(BGPNOLI(I))

                       SET BGPLIST(I)=""

 +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 BGPGANS=Y

           SET BGPGC=""

           FOR BGPGI=1:1

               SET BGPGC=$PIECE(BGPGANS,",",BGPGI)

               IF BGPGC=""

                   QUIT

               SET I=BGPGLIST("IDX",BGPGC,BGPGC)

               KILL BGPLIST(I)

REMX      ;

 +1        DO BACK

 +2        QUIT

 +3       ;

PT        ;EP

 +1        SET (BGPROT,BGPDELT,BGPDELF)=""

 +2        WRITE !!,"Please choose an output type.  For an explanation of the delimited",!,"file please see the user manual.",!

 +3        SET DIR(0)="S^P:Print Report on Printer or Screen;D:Create Delimited output file (for use in Excel);B:Both a Printed Report and Delimited File"

           SET DIR("A")="Select an Output Option"

           SET DIR("B")="P"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               QUIT

 +5        SET BGPROT=Y

 +6        IF BGPROT="P"

               QUIT

 +7        SET BGPDELF=""

           SET BGPDELT=""

 +8        WRITE !!,"You have selected to create a delimited output file.  You can have this",!,"output file created as a text file in the pub directory, ",!,"OR you can have the delimited output display on your screen so that"

 +9        WRITE !,"you can do a file capture.  Keep in mind that if you choose to",!,"do a screen capture you CANNOT Queue your report to run in the background!!",!!

 +10       SET DIR(0)="S^S:SCREEN - delimited output will display on screen for capture;F:FILE - delimited output will be written to a file in pub"

           SET DIR("A")="Select output type"

           SET DIR("B")="S"

           KILL DA

           DO ^DIR

           KILL DIR

 +11       IF $DATA(DIRUT)

               GOTO PT

 +12       SET BGPDELT=Y

 +13       IF BGPDELT="S"

               QUIT

 +14       SET DIR(0)="F^1:40"

           SET DIR("A")="Enter a filename for the delimited output (no more than 40 characters)"

           KILL DA

           DO ^DIR

           KILL DIR

 +15       IF $DATA(DIRUT)

               GOTO PT

 +16       SET BGPDELF=Y

 +17       WRITE !!,"When the report is finished your delimited output will be found in the",!,$PIECE($GET(^AUTTSITE(1,1)),U,2)," directory.  The filename will be ",BGPDELF,".txt",!

 +18       QUIT

BGP4DESL.m