BMCRL3 ; IHS/PHXAO/TMJ - MORE LISTER ;
;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
;LAB added help text to dir call
;IHS/ITSC/FCJ ADDED DTTST SUB FOR CANNED REPORTS ;ADDED ABILITY
; TO SAVE TOT/SUBTOT RPTS ;ADDED ABILITY TO SAVE CUSTOM TITLE
; Save type of referral: Prim, Sec or both
;
TITLE ;EP
Q:BMCCTYP="T" ;--- don't ask for title if total count only
K DIR,X,Y S DIR(0)="Y",DIR("A")="Would you like a custom title for this report",DIR("B")="N"
I $D(BMCCAND),$D(^BMCRTMP(BMCRPT,1)) D
.S BMCTITL=$P(^BMCRTMP(BMCRPT,1),U)
.W !,"Previous Custom Report Title: ",BMCTITL
.S DIR("A")="Would you like to change custom title for this report"
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) S BMCQUIT=1 Q
Q:Y=0
S BMCLENG=$S(BMCTCW:BMCTCW-8,1:60)
I Y=1 K DIR,X,Y S DIR(0)="F^3:"_BMCLENG,DIR("A")="Enter custom title",DIR("?")=" Enter from 3 to "_BMCLENG_" characters" D ^DIR K DIR
G:$D(DIRUT) TITLE
S BMCTITL=Y
I $D(BMCCAND) S $P(^BMCRTMP(BMCRPT,1),U)=BMCTITL
Q
SAVE ;EP
Q:$D(BMCCAND) ;--- don't ask if already a pre-defined rpt
I BMCCTYP="N",BMCCTYP="R" Q
S BMCSAVE=""
K DIR,X,Y S DIR(0)="Y",DIR("A")="Do you wish to SAVE this "_$S('$D(BMCEP1):"SEARCH/",1:"")_"PRINT/SORT logic for future use",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
Q:'Y
K DIR,X,Y S DIR(0)="90001.82,.03",DIR("A")="Enter NAME for this REPORT DEFINITION" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) SAVE
S BMCNAME=Y
S DIE="^BMCRTMP(",DA=BMCRPT,DR=".02////1;.03///"_BMCNAME_";.06///"_BMCPTVS_";.05///"_BMCCTYP
S:$D(BMCEP1) DR=DR_";.09///"_BMCPACK
;4.0 IHS/ITSC/FCJ ADDED REF TYPE: PRIM SEC BOTH
S DR=DR_";.14///"_BMCTYPR
S:$D(BMCTITL) DR=DR_";1///"_BMCTITL D ^DIE K DIE,DA,DR
Q
COUNT ;EP
W !! S DIR(0)="S^T:Total Count Only;S:Sub-counts and Total Count;D:Detailed Referral Listing;N:Numeric Item Basic Statistics;R:Referral Record Display",DIR("A")=" Choose Type of Report",DIR("B")="D" D ^DIR K DIR W !!
S:$D(DUOUT) DIRUT=1
I $D(DIRUT) S BMCQUIT=1 Q
S BMCCTYP=Y
I BMCCTYP="T" S $P(^BMCRTMP(BMCRPT,0),U,5)=1 S:BMCPTVS="R" BMCSORT=6,BMCSORV="Referral Date" S:BMCPTVS="P" BMCSORT=1,BMCSORV="Patient Name" Q
I BMCCTYP="R" S $P(^BMCRTMP(BMCRPT,0),U,5)=1 S:BMCPTVS="R" BMCSORT=6,BMCSORV="Referral Date" S:BMCPTVS="P" BMCSORT=1,BMCSORV="Patient Name" Q
I BMCCTYP="D" D PRINT Q:$D(BMCQUIT) D SORT Q
I BMCCTYP="N" D NUMERIC Q
D SORT
Q
PRINT ;
S BMCCNTL="P" D ^BMCRL4 K BMCCNTL
Q
SORT ;
K BMCSORT,BMCSORV,BMCQUIT
I BMCCTYP="D",'$D(^BMCRTMP(BMCRPT,12)) W !!,"NO PRINT FIELDS SELECTED!!",$C(7),$C(7) S BMCQUIT=1 Q
S BMCSORT=""
D SHOWR^BMCRLS
S BMCCNTL="R" D ^BMCRL4 K BMCCNTL
I '$D(BMCSORV) S BMCQUIT=1 Q
Q:BMCCTYP'="D"
PAGE ;
K BMCSPAG
Q:BMCCTYP'="D"
S DIR(0)="Y",DIR("A")="Do you want a separate page for each "_BMCSORV,DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G SORT
S BMCSPAG=Y,DIE="^BMCRTMP(",DA=BMCRPT,DR=".04///"_BMCSPAG D ^DIE K DA,DR,DIE
Q
NUMERIC ;
D ^XBCLS
W !!,?20,"***NUMERIC ITEM BASIC STATISTICS**",!!
W !!,"This print option will provide basic statistics (sum, count, mean, max, min)",!,"on any one of the 'Numeric Items' listed below.",!!,"Upon selection of a 'Numeric Item' a list of 'Sort' Choices will also be",!,"displayed. "
W "This 'Sort' Choice is provided for the purpose of Totaling and/or",!,"Sub-totaling all records selected.",!!,"For example, choosing 'Actual Cost' as the Numeric Item and, then, choosing"
W !,"Primary Vendor as the 'Sort' Choice would produce a report of Actual Cost",!,"statistics (Sub-totaled by Vendor).",!!
W "If you choose NOT to select a 'Sort' Item, the report would produce only",!,"one Grand Total (sum, count, mean, max, and min, etc.) for all",!,"'Actual Cost' statistics.",!!
K BMCDISP,BMCSEL,BMCHIGH
S BMCLHDR="NUMERIC ITEM Selection Menu" W ?((80-$L(BMCLHDR))/2),BMCLHDR,!
S BMCHIGH=0,X=0 F S X=$O(^BMCTSORT("C",X)) Q:X'=+X S Y=$O(^BMCTSORT("C",X,"")) I $P(^BMCTSORT(Y,0),U,5)["S",$P(^BMCTSORT(Y,0),U,2)="N" S BMCHIGH=BMCHIGH+1,BMCSEL(BMCHIGH)=Y
S BMCCUT=((BMCHIGH/2)+1)\1
S I=0,J=1,K=1 F S I=$O(BMCSEL(I)) Q:I'=+I!($D(BMCDISP(I))) W !?5,I,") ",$P(^BMCTSORT(BMCSEL(I),0),U) S BMCDISP(I)="",J=I+BMCCUT I $D(BMCSEL(J)),'$D(BMCDISP(J)) W ?40,J,") ",$P(^BMCTSORT(BMCSEL(J),0),U) S BMCDISP(J)=""
W ! S DIR(0)="NO^1:"_BMCHIGH_":0",DIR("A")="Produce statistics for which of the above" D ^DIR K DIR
I $D(DIRUT) G COUNT
S BMCNSRT=BMCSEL(+Y)
D SORT
Q
DTTST ;CANNED REPORTS
;TEST DATE RANGE FIELDS FOR CANNED REPORTS
S BMCQT=""
S I=0 F S I=$O(^BMCRTMP(BMCRPT,11,I)) Q:I'?1N.N D
.I $P($G(^BMCTSORT(I,0)),U,2)="D" S BMCR("CR",I)=""
I $D(BMCR("CR")) D
.W !,"There are date range(s) in this report..."
.S I="" F S I=$O(BMCR("CR",I)) Q:I'?1.N D Q:$D(DIRUT)
..S BMCTEXT=$P(^BMCTSORT(I,0),U)
..S Y=$P(^BMCRTMP(BMCRPT,11,I,11,1,0),U) D DD^%DT S BMCBD=Y
..S Y=$P(^BMCRTMP(BMCRPT,11,I,11,1,0),U,2) D DD^%DT S BMCED=Y
..W !,BMCTEXT," Previous Date Range: ",BMCBD," TO ",BMCED
..S DIR(0)="Y",DIR("A")="Would you like to update these dates"
..D ^DIR
..Q:(Y="^")!(Y=0)
..D D^BMCRL0 Q:$D(DIRUT)
..S ^BMCRTMP(BMCRPT,11,I,11,1,0)=BMCBD_U_BMCED
..K ^BMCRTMP(BMCRPT,11,I,11,"B")
..S ^BMCRTMP(BMCRPT,11,I,11,"B",BMCBD,1)=""
S BMCTYPR=$P(^BMCRTMP(BMCRPT,0),U,14) S:BMCTYPR="" BMCTYPR="P"
W !,"The Report contains ",$S(BMCTYPR="P":"Only PRIMARY",BMCTYPR="S":"Only SECONDARY",1:"Primary and Secondary")," Referrals"
S DIR(0)="Y",DIR("A")="Would you like to update the Referral type",DIR("B")="N"
D ^DIR Q:(Y="^")!(Y=0)
D RTYP^BMCRL Q:$D(DIRUT)
S $P(^BMCRTMP(BMCRPT,0),U,14)=BMCTYPR
Q
BMCRL3 ; IHS/PHXAO/TMJ - MORE LISTER ;
+1 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
+2 ;LAB added help text to dir call
+3 ;IHS/ITSC/FCJ ADDED DTTST SUB FOR CANNED REPORTS ;ADDED ABILITY
+4 ; TO SAVE TOT/SUBTOT RPTS ;ADDED ABILITY TO SAVE CUSTOM TITLE
+5 ; Save type of referral: Prim, Sec or both
+6 ;
TITLE ;EP
+1 ;--- don't ask for title if total count only
IF BMCCTYP="T"
QUIT
+2 KILL DIR,X,Y
SET DIR(0)="Y"
SET DIR("A")="Would you like a custom title for this report"
SET DIR("B")="N"
+3 IF $DATA(BMCCAND)
IF $DATA(^BMCRTMP(BMCRPT,1))
Begin DoDot:1
+4 SET BMCTITL=$PIECE(^BMCRTMP(BMCRPT,1),U)
+5 WRITE !,"Previous Custom Report Title: ",BMCTITL
+6 SET DIR("A")="Would you like to change custom title for this report"
End DoDot:1
+7 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+8 IF $DATA(DIRUT)
SET BMCQUIT=1
QUIT
+9 IF Y=0
QUIT
+10 SET BMCLENG=$SELECT(BMCTCW:BMCTCW-8,1:60)
+11 IF Y=1
KILL DIR,X,Y
SET DIR(0)="F^3:"_BMCLENG
SET DIR("A")="Enter custom title"
SET DIR("?")=" Enter from 3 to "_BMCLENG_" characters"
DO ^DIR
KILL DIR
+12 IF $DATA(DIRUT)
GOTO TITLE
+13 SET BMCTITL=Y
+14 IF $DATA(BMCCAND)
SET $PIECE(^BMCRTMP(BMCRPT,1),U)=BMCTITL
+15 QUIT
SAVE ;EP
+1 ;--- don't ask if already a pre-defined rpt
IF $DATA(BMCCAND)
QUIT
+2 IF BMCCTYP="N"
IF BMCCTYP="R"
QUIT
+3 SET BMCSAVE=""
+4 KILL DIR,X,Y
SET DIR(0)="Y"
SET DIR("A")="Do you wish to SAVE this "_$SELECT('$DATA(BMCEP1):"SEARCH/",1:"")_"PRINT/SORT logic for future use"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF $DATA(DIRUT)
QUIT
+6 IF 'Y
QUIT
+7 KILL DIR,X,Y
SET DIR(0)="90001.82,.03"
SET DIR("A")="Enter NAME for this REPORT DEFINITION"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+8 IF $DATA(DIRUT)
GOTO SAVE
+9 SET BMCNAME=Y
+10 SET DIE="^BMCRTMP("
SET DA=BMCRPT
SET DR=".02////1;.03///"_BMCNAME_";.06///"_BMCPTVS_";.05///"_BMCCTYP
+11 IF $DATA(BMCEP1)
SET DR=DR_";.09///"_BMCPACK
+12 ;4.0 IHS/ITSC/FCJ ADDED REF TYPE: PRIM SEC BOTH
+13 SET DR=DR_";.14///"_BMCTYPR
+14 IF $DATA(BMCTITL)
SET DR=DR_";1///"_BMCTITL
DO ^DIE
KILL DIE,DA,DR
+15 QUIT
COUNT ;EP
+1 WRITE !!
SET DIR(0)="S^T:Total Count Only;S:Sub-counts and Total Count;D:Detailed Referral Listing;N:Numeric Item Basic Statistics;R:Referral Record Display"
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 BMCQUIT=1
QUIT
+4 SET BMCCTYP=Y
+5 IF BMCCTYP="T"
SET $PIECE(^BMCRTMP(BMCRPT,0),U,5)=1
IF BMCPTVS="R"
SET BMCSORT=6
SET BMCSORV="Referral Date"
IF BMCPTVS="P"
SET BMCSORT=1
SET BMCSORV="Patient Name"
QUIT
+6 IF BMCCTYP="R"
SET $PIECE(^BMCRTMP(BMCRPT,0),U,5)=1
IF BMCPTVS="R"
SET BMCSORT=6
SET BMCSORV="Referral Date"
IF BMCPTVS="P"
SET BMCSORT=1
SET BMCSORV="Patient Name"
QUIT
+7 IF BMCCTYP="D"
DO PRINT
IF $DATA(BMCQUIT)
QUIT
DO SORT
QUIT
+8 IF BMCCTYP="N"
DO NUMERIC
QUIT
+9 DO SORT
+10 QUIT
PRINT ;
+1 SET BMCCNTL="P"
DO ^BMCRL4
KILL BMCCNTL
+2 QUIT
SORT ;
+1 KILL BMCSORT,BMCSORV,BMCQUIT
+2 IF BMCCTYP="D"
IF '$DATA(^BMCRTMP(BMCRPT,12))
WRITE !!,"NO PRINT FIELDS SELECTED!!",$CHAR(7),$CHAR(7)
SET BMCQUIT=1
QUIT
+3 SET BMCSORT=""
+4 DO SHOWR^BMCRLS
+5 SET BMCCNTL="R"
DO ^BMCRL4
KILL BMCCNTL
+6 IF '$DATA(BMCSORV)
SET BMCQUIT=1
QUIT
+7 IF BMCCTYP'="D"
QUIT
PAGE ;
+1 KILL BMCSPAG
+2 IF BMCCTYP'="D"
QUIT
+3 SET DIR(0)="Y"
SET DIR("A")="Do you want a separate page for each "_BMCSORV
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
GOTO SORT
+5 SET BMCSPAG=Y
SET DIE="^BMCRTMP("
SET DA=BMCRPT
SET DR=".04///"_BMCSPAG
DO ^DIE
KILL DA,DR,DIE
+6 QUIT
NUMERIC ;
+1 DO ^XBCLS
+2 WRITE !!,?20,"***NUMERIC ITEM BASIC STATISTICS**",!!
+3 WRITE !!,"This print option will provide basic statistics (sum, count, mean, max, min)",!,"on any one of the 'Numeric Items' listed below.",!!,"Upon selection of a 'Numeric Item' a list of 'Sort' Choices will also be",!,"displayed. "
+4 WRITE "This 'Sort' Choice is provided for the purpose of Totaling and/or",!,"Sub-totaling all records selected.",!!,"For example, choosing 'Actual Cost' as the Numeric Item and, then, choosing"
+5 WRITE !,"Primary Vendor as the 'Sort' Choice would produce a report of Actual Cost",!,"statistics (Sub-totaled by Vendor).",!!
+6 WRITE "If you choose NOT to select a 'Sort' Item, the report would produce only",!,"one Grand Total (sum, count, mean, max, and min, etc.) for all",!,"'Actual Cost' statistics.",!!
+7 KILL BMCDISP,BMCSEL,BMCHIGH
+8 SET BMCLHDR="NUMERIC ITEM Selection Menu"
WRITE ?((80-$LENGTH(BMCLHDR))/2),BMCLHDR,!
+9 SET BMCHIGH=0
SET X=0
FOR
SET X=$ORDER(^BMCTSORT("C",X))
IF X'=+X
QUIT
SET Y=$ORDER(^BMCTSORT("C",X,""))
IF $PIECE(^BMCTSORT(Y,0),U,5)["S"
IF $PIECE(^BMCTSORT(Y,0),U,2)="N"
SET BMCHIGH=BMCHIGH+1
SET BMCSEL(BMCHIGH)=Y
+10 SET BMCCUT=((BMCHIGH/2)+1)\1
+11 SET I=0
SET J=1
SET K=1
FOR
SET I=$ORDER(BMCSEL(I))
IF I'=+I!($DATA(BMCDISP(I)))
QUIT
WRITE !?5,I,") ",$PIECE(^BMCTSORT(BMCSEL(I),0),U)
SET BMCDISP(I)=""
SET J=I+BMCCUT
IF $DATA(BMCSEL(J))
IF '$DATA(BMCDISP(J))
WRITE ?40,J,") ",$PIECE(^BMCTSORT(BMCSEL(J),0),U)
SET BMCDISP(J)=""
+12 WRITE !
SET DIR(0)="NO^1:"_BMCHIGH_":0"
SET DIR("A")="Produce statistics for which of the above"
DO ^DIR
KILL DIR
+13 IF $DATA(DIRUT)
GOTO COUNT
+14 SET BMCNSRT=BMCSEL(+Y)
+15 DO SORT
+16 QUIT
DTTST ;CANNED REPORTS
+1 ;TEST DATE RANGE FIELDS FOR CANNED REPORTS
+2 SET BMCQT=""
+3 SET I=0
FOR
SET I=$ORDER(^BMCRTMP(BMCRPT,11,I))
IF I'?1N.N
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^BMCTSORT(I,0)),U,2)="D"
SET BMCR("CR",I)=""
End DoDot:1
+5 IF $DATA(BMCR("CR"))
Begin DoDot:1
+6 WRITE !,"There are date range(s) in this report..."
+7 SET I=""
FOR
SET I=$ORDER(BMCR("CR",I))
IF I'?1.N
QUIT
Begin DoDot:2
+8 SET BMCTEXT=$PIECE(^BMCTSORT(I,0),U)
+9 SET Y=$PIECE(^BMCRTMP(BMCRPT,11,I,11,1,0),U)
DO DD^%DT
SET BMCBD=Y
+10 SET Y=$PIECE(^BMCRTMP(BMCRPT,11,I,11,1,0),U,2)
DO DD^%DT
SET BMCED=Y
+11 WRITE !,BMCTEXT," Previous Date Range: ",BMCBD," TO ",BMCED
+12 SET DIR(0)="Y"
SET DIR("A")="Would you like to update these dates"
+13 DO ^DIR
+14 IF (Y="^")!(Y=0)
QUIT
+15 DO D^BMCRL0
IF $DATA(DIRUT)
QUIT
+16 SET ^BMCRTMP(BMCRPT,11,I,11,1,0)=BMCBD_U_BMCED
+17 KILL ^BMCRTMP(BMCRPT,11,I,11,"B")
+18 SET ^BMCRTMP(BMCRPT,11,I,11,"B",BMCBD,1)=""
End DoDot:2
IF $DATA(DIRUT)
QUIT
End DoDot:1
+19 SET BMCTYPR=$PIECE(^BMCRTMP(BMCRPT,0),U,14)
IF BMCTYPR=""
SET BMCTYPR="P"
+20 WRITE !,"The Report contains ",$SELECT(BMCTYPR="P":"Only PRIMARY",BMCTYPR="S":"Only SECONDARY",1:"Primary and Secondary")," Referrals"
+21 SET DIR(0)="Y"
SET DIR("A")="Would you like to update the Referral type"
SET DIR("B")="N"
+22 DO ^DIR
IF (Y="^")!(Y=0)
QUIT
+23 DO RTYP^BMCRL
IF $DATA(DIRUT)
QUIT
+24 SET $PIECE(^BMCRTMP(BMCRPT,0),U,14)=BMCTYPR
+25 QUIT
