BCHRL3.m

BCHRL3 ; IHS/CMI/LAB - LISTER ; 

 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 ;

 ;

SCREEN ;EP

 D SMENU^BCHRL2

 W ! S DIR(0)="LO^1:"_BCHHIGH,DIR("A")="Select "_$S(BCHPTVS="P":"Patients",1:"visits")_" based on which of the above" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:Y=""

 I $D(DIRUT) S BCHQUIT=1 Q

 ;process all items in Y

 D SELECT^BCHRL0

 D SHOW^BCHRLS

 W !! S DIR(0)="Y",DIR("A")="      Would you like to select additional "_$S(BCHPTVS="P":"PATIENT",1:"CHR RECORD")_" criteria",DIR("B")="NO" D ^DIR K DIR

 S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) S BCHQUIT=1 Q

 Q:Y=0

 G SCREEN

 ;

COUNT ;EP

 W !! S DIR(0)="S^T:Total Count Only;S:Sub-counts and Total Count;D:Detailed "_$S(BCHPTVS="V":"Record",1:"Patient")_" Listing",DIR("A")="Choose Type of Report",DIR("B")="D" D ^DIR K DIR W !!

 S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) S BCHQUIT=1 Q

 S BCHCTYP=Y

 I BCHCTYP="T" S $P(^BCHTRPT(BCHRPT,0),U,5)=1 S:BCHPTVS="V" BCHSORT=132,BCHSORV="Date of Encounter" S:BCHPTVS="P" BCHSORT=1,BCHSORV="Patient Name" Q

 I BCHCTYP="D" D PRINT Q:$D(BCHQUIT)  D SORT Q

 D SORT

 Q

PRINT ;

 D PMENU^BCHRL2

 S DIR(0)="LO^1:"_BCHHIGH,DIR("A")="Select print item(s)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:Y=""

 I $D(DIRUT) S BCHQUIT=1 Q

 W !!?15,"Total Report width (including column margins - 2 spaces):  ",BCHTCW

 D PSELECT^BCHRL0

 D SHOWP^BCHRLS

 W !! S DIR(0)="Y",DIR("A")="      Would you like to select additional PRINT criteria",DIR("B")="NO" D ^DIR K DIR

 S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) S BCHQUIT=1 Q

 Q:Y=0

 G PRINT

SORT ;

 K BCHSORT,BCHSORV,BCHQUIT

 I BCHCTYP="D",'$D(^BCHTRPT(BCHRPT,12)) W !!,"NO PRINT FIELDS SELECTED!!",$C(7),$C(7) S BCHQUIT=1 Q

 S BCHSORT=""

 D SHOWR^BCHRLS

 D RMENU^BCHRL2

 W ! S DIR(0)="NO^1:"_BCHHIGH_":0",DIR("A")=$S(BCHCTYP="S":"Sub-total ",1:"Sort ")_$S(BCHPTVS="P":"Patients",1:"visits")_" by which of the above" D ^DIR K DIR

 I $D(DUOUT) K ^BCHTRPT(BCHRPT,12) S BCHTCW=0 G PRINT

 I Y="",BCHCTYP="D" W !!,"No sort criteria selected ... will sort by "_$S(BCHPTVS="P":"Patient Name",1:"Date of Encounter")_"." S:BCHPTVS="V" BCHSORT=132,BCHSORV="Date of Encounter" S:BCHPTVS="P" BCHSORT=70,BCHSORV="Patient Name" H 2 D   Q

 .S DA=BCHRPT,DIE="^BCHTRPT(",DR=".07////"_BCHSORT D CALLDIE^BCHUTIL

 I Y="",BCHCTYP'="D" W !!,"No sub-totalling will be done.",!! H 2 S BCHCTYP="T",$P(^BCHTRPT(BCHRPT,0),U,5)=1 S:BCHPTVS="V" BCHSORT=132,BCHSORV="Date of Encounter" S:BCHPTVS="P" BCHSORT=1,BCHSORV="Patient Name" Q

 S BCHSORT=BCHSEL(+Y),BCHSORV=$P(^BCHSORT(BCHSORT,0),U),DA=BCHRPT,DIE="^BCHTRPT(",DR=".07////"_BCHSORT D CALLDIE^BCHUTIL

 Q:BCHCTYP'="D"

PAGE ;

 K BCHSPAG

 Q:BCHCTYP'="D"

 S DIR(0)="Y",DIR("A")="Do you want a separate page for each "_BCHSORV,DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G SORT

 S BCHSPAG=Y,DIE="^BCHTRPT(",DA=BCHRPT,DR=".04///"_BCHSPAG D CALLDIE^BCHUTIL

 Q

BCHRL3    ; IHS/CMI/LAB - LISTER ; 

 +1       ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 +2       ;

 +3       ;

SCREEN    ;EP

 +1        DO SMENU^BCHRL2

 +2        WRITE !

           SET DIR(0)="LO^1:"_BCHHIGH

           SET DIR("A")="Select "_$SELECT(BCHPTVS="P":"Patients",1:"visits")_" based on which of the above"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF Y=""

               QUIT 

 +4        IF $DATA(DIRUT)

               SET BCHQUIT=1

               QUIT 

 +5       ;process all items in Y

 +6        DO SELECT^BCHRL0

 +7        DO SHOW^BCHRLS

 +8        WRITE !!

           SET DIR(0)="Y"

           SET DIR("A")="      Would you like to select additional "_$SELECT(BCHPTVS="P":"PATIENT",1:"CHR RECORD")_" criteria"

           SET DIR("B")="NO"

           DO ^DIR

           KILL DIR

 +9        IF $DATA(DUOUT)

               SET DIRUT=1

 +10       IF $DATA(DIRUT)

               SET BCHQUIT=1

               QUIT 

 +11       IF Y=0

               QUIT 

 +12       GOTO SCREEN

 +13      ;

COUNT     ;EP

 +1        WRITE !!

           SET DIR(0)="S^T:Total Count Only;S:Sub-counts and Total Count;D:Detailed "_$SELECT(BCHPTVS="V":"Record",1:"Patient")_" Listing"

           SET DIR("A")="Choose Type of Report"

           SET DIR("B")="D"

           DO ^DIR

           KILL DIR

           WRITE !!

 +2        IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               SET BCHQUIT=1

               QUIT 

 +4        SET BCHCTYP=Y

 +5        IF BCHCTYP="T"

               SET $PIECE(^BCHTRPT(BCHRPT,0),U,5)=1

               IF BCHPTVS="V"

                   SET BCHSORT=132

                   SET BCHSORV="Date of Encounter"

               IF BCHPTVS="P"

                   SET BCHSORT=1

                   SET BCHSORV="Patient Name"

               QUIT 

 +6        IF BCHCTYP="D"

               DO PRINT

               IF $DATA(BCHQUIT)

                   QUIT 

               DO SORT

               QUIT 

 +7        DO SORT

 +8        QUIT 

PRINT     ;

 +1        DO PMENU^BCHRL2

 +2        SET DIR(0)="LO^1:"_BCHHIGH

           SET DIR("A")="Select print item(s)"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF Y=""

               QUIT 

 +4        IF $DATA(DIRUT)

               SET BCHQUIT=1

               QUIT 

 +5        WRITE !!?15,"Total Report width (including column margins - 2 spaces):  ",BCHTCW

 +6        DO PSELECT^BCHRL0

 +7        DO SHOWP^BCHRLS

 +8        WRITE !!

           SET DIR(0)="Y"

           SET DIR("A")="      Would you like to select additional PRINT criteria"

           SET DIR("B")="NO"

           DO ^DIR

           KILL DIR

 +9        IF $DATA(DUOUT)

               SET DIRUT=1

 +10       IF $DATA(DIRUT)

               SET BCHQUIT=1

               QUIT 

 +11       IF Y=0

               QUIT 

 +12       GOTO PRINT

SORT      ;

 +1        KILL BCHSORT,BCHSORV,BCHQUIT

 +2        IF BCHCTYP="D"

               IF '$DATA(^BCHTRPT(BCHRPT,12))

                   WRITE !!,"NO PRINT FIELDS SELECTED!!",$CHAR(7),$CHAR(7)

                   SET BCHQUIT=1

                   QUIT 

 +3        SET BCHSORT=""

 +4        DO SHOWR^BCHRLS

 +5        DO RMENU^BCHRL2

 +6        WRITE !

           SET DIR(0)="NO^1:"_BCHHIGH_":0"

           SET DIR("A")=$SELECT(BCHCTYP="S":"Sub-total ",1:"Sort ")_$SELECT(BCHPTVS="P":"Patients",1:"visits")_" by which of the above"

           DO ^DIR

           KILL DIR

 +7        IF $DATA(DUOUT)

               KILL ^BCHTRPT(BCHRPT,12)

               SET BCHTCW=0

               GOTO PRINT

 +8        IF Y=""

               IF BCHCTYP="D"

                   WRITE !!,"No sort criteria selected ... will sort by "_$SELECT(BCHPTVS="P":"Patient Name",1:"Date of Encounter")_"."

                   IF BCHPTVS="V"

                       SET BCHSORT=132

                       SET BCHSORV="Date of Encounter"

                   IF BCHPTVS="P"

                       SET BCHSORT=70

                       SET BCHSORV="Patient Name"

                   HANG 2

                   Begin DoDot:1

 +9                    SET DA=BCHRPT

                       SET DIE="^BCHTRPT("

                       SET DR=".07////"_BCHSORT

                       DO CALLDIE^BCHUTIL

                   End DoDot:1

                   QUIT 

 +10       IF Y=""

               IF BCHCTYP'="D"

                   WRITE !!,"No sub-totalling will be done.",!!

                   HANG 2

                   SET BCHCTYP="T"

                   SET $PIECE(^BCHTRPT(BCHRPT,0),U,5)=1

                   IF BCHPTVS="V"

                       SET BCHSORT=132

                       SET BCHSORV="Date of Encounter"

                   IF BCHPTVS="P"

                       SET BCHSORT=1

                       SET BCHSORV="Patient Name"

                   QUIT 

 +11       SET BCHSORT=BCHSEL(+Y)

           SET BCHSORV=$PIECE(^BCHSORT(BCHSORT,0),U)

           SET DA=BCHRPT

           SET DIE="^BCHTRPT("

           SET DR=".07////"_BCHSORT

           DO CALLDIE^BCHUTIL

 +12       IF BCHCTYP'="D"

               QUIT 

PAGE      ;

 +1        KILL BCHSPAG

 +2        IF BCHCTYP'="D"

               QUIT 

 +3        SET DIR(0)="Y"

           SET DIR("A")="Do you want a separate page for each "_BCHSORV

           SET DIR("B")="N"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF $DATA(DIRUT)

               GOTO SORT

 +5        SET BCHSPAG=Y

           SET DIE="^BCHTRPT("

           SET DA=BCHRPT

           SET DR=".04///"_BCHSPAG

           DO CALLDIE^BCHUTIL

 +6        QUIT