BGP2PESL.m

BGP2PESL ; IHS/CMI/LAB - FY 06 DISPLAY IND LISTS ;

 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66

 ;; ;

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"_$S($G(BGPEDPP):";O:One Education Provider;E:Patient List by Education Provider",1:"")_";A:All Patients",DIR("A")="Choose report type for the Lists"

 S 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="E" D  Q

 .W !!,"Please Note:  The education provider is obtained from the V Patient Ed File"

 .W !,"and is recorded with each topic.  If the provider is not documented with the"

 .W !,"topic the provider listed in the report will be 'Unknown'.",!

 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)

 I BGPLIST="O" D  G:BGPEPROV="" RT Q

 .S BGPEPROV="",BGPEPRV=""

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

 .I $D(DIRUT) Q

 .I Y="" Q

 .S BGPEPRV=+Y,BGPEPROV=Y(0,0)

 .W !!,"Please Note:  The education provider is obtained from the V Patient Ed File"

 .W !,"and is recorded with each topic.  If the provider is not documented with the"

 .W !,"topic the topic/patient will not be listed on the patient list.",!

 Q

EP ;EP - CALLED FROM OPTION

 D EN

 Q

EOJ1 ;EP

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

 Q

 ;; ;

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

 D EN^VALM("BGP 12 PATED LIST SELECTION")

 D CLEAR^VALM1

 D FULL^VALM1

 W:$D(IOF) @IOF

 D EOJ1

 Q

 ;

HDR ; -- header code

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

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

 Q

 ;

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(^BGPPEIW(X,0),U,4)]"" S C=C+1 D  Q

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

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

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

 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

 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=$O(BGPGLIST("IDX",BGPGC,0)),BGPI=BGPGLIST("IDX",BGPGC,BGPI) I $D(BGPIND(BGPI)),'$D(BGPNOLI(BGPI)) S BGPLIST(BGPI)=""

ADDX ;

 D BACK

 Q

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

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

REMX ;

 D BACK

 Q

 ;

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",!,$$GETDEDIR^BGP2UTL2()," directory.  The filename will be ",BGPDELF,".txt",!

 Q

BGP2PESL  ; IHS/CMI/LAB - FY 06 DISPLAY IND LISTS ;

 +1       ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66

 +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"_$SELECT($GET(BGPEDPP):";O:One Education Provider;E:Patient List by Education Provider",1:"")_";A:All Patients"

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

 +4        SET DIR("B")="R"

           KILL DA

           DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               SET BGPQUIT=""

               KILL BGPLIST

               QUIT 

 +6        SET BGPLIST=Y

 +7        IF BGPLIST="A"

               QUIT 

 +8        IF BGPLIST="E"

               Begin DoDot:1

 +9                WRITE !!,"Please Note:  The education provider is obtained from the V Patient Ed File"

 +10               WRITE !,"and is recorded with each topic.  If the provider is not documented with the"

 +11               WRITE !,"topic the provider listed in the report will be 'Unknown'.",!

               End DoDot:1

               QUIT 

 +12       IF BGPLIST="P"

               Begin DoDot:1

 +13               SET BGPLPROV=""

                   SET BGPLPRV=""

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

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

                   KILL DA

                   DO ^DIR

                   KILL DIR

 +15               IF $DATA(DIRUT)

                       QUIT 

 +16               IF Y=""

                       QUIT 

 +17               SET BGPLPRV=+Y

                   SET BGPLPROV=Y(0,0)

               End DoDot:1

               IF BGPLPROV=""

                   GOTO RT

               QUIT 

 +18       IF BGPLIST="O"

               Begin DoDot:1

 +19               SET BGPEPROV=""

                   SET BGPEPRV=""

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

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

                   KILL DA

                   DO ^DIR

                   KILL DIR

 +21               IF $DATA(DIRUT)

                       QUIT 

 +22               IF Y=""

                       QUIT 

 +23               SET BGPEPRV=+Y

                   SET BGPEPROV=Y(0,0)

 +24               WRITE !!,"Please Note:  The education provider is obtained from the V Patient Ed File"

 +25               WRITE !,"and is recorded with each topic.  If the provider is not documented with the"

 +26               WRITE !,"topic the topic/patient will not be listed on the patient list.",!

               End DoDot:1

               IF BGPEPROV=""

                   GOTO RT

               QUIT 

 +27       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 12 PATED 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 Patient Education 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(^BGPPEIW(X,0),U,4)]""

                       SET C=C+1

                       Begin DoDot:2

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

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

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

                           IF $DATA(BGPLIST(X))

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

                       End DoDot:2

                       QUIT 

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

                       SET C=C+1

                       Begin DoDot:2

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

                           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=$ORDER(BGPGLIST("IDX",BGPGC,0))

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

               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 

               KILL BGPLIST(BGPGC)

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",!,$$GETDEDIR^BGP2UTL2()," directory.  The filename will be ",BGPDELF,".txt",!

 +18       QUIT