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
